6 import Control.Monad |
6 import Control.Monad |
7 import qualified Data.IntMap as IntMap |
7 import qualified Data.IntMap as IntMap |
8 import System.Log.Logger |
8 import System.Log.Logger |
9 import Control.Monad.Reader |
9 import Control.Monad.Reader |
10 import Control.Monad.State |
10 import Control.Monad.State |
|
11 import Data.Set as Set |
11 import qualified Data.ByteString.Char8 as B |
12 import qualified Data.ByteString.Char8 as B |
12 -------------------------------------- |
13 -------------------------------------- |
13 import CoreTypes |
14 import CoreTypes |
14 import NetRoutines |
15 import NetRoutines |
15 import HWProtoCore |
16 import HWProtoCore |
33 mainLoop = forever $ do |
34 mainLoop = forever $ do |
34 si <- gets serverInfo |
35 si <- gets serverInfo |
35 r <- liftIO $ readChan $ coreChan si |
36 r <- liftIO $ readChan $ coreChan si |
36 |
37 |
37 case r of |
38 case r of |
38 Accept ci -> do |
39 Accept ci -> processAction (AddClient ci) |
39 processAction (AddClient ci) |
|
40 return () |
|
41 |
40 |
42 ClientMessage (ci, cmd) -> do |
41 ClientMessage (ci, cmd) -> do |
43 liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd) |
42 liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd) |
44 modify (\as -> as{clientIndex = Just ci}) |
43 |
45 --if clID `IntMap.member` clients then |
44 removed <- gets removedClients |
46 reactCmd cmd |
45 when (not $ ci `Set.member` removed) $ do |
47 return () |
46 modify (\as -> as{clientIndex = Just ci}) |
|
47 reactCmd cmd |
|
48 |
|
49 Remove ci -> processAction (DeleteClient ci) |
|
50 |
48 --else |
51 --else |
49 --do |
52 --do |
50 --debugM "Clients" "Message from dead client" |
53 --debugM "Clients" "Message from dead client" |
51 --return (serverInfo, rnc) |
54 --return (serverInfo, rnc) |
52 |
55 |
53 ClientAccountInfo (clID, info) -> do |
56 ClientAccountInfo (ci, info) -> do |
54 --if clID `IntMap.member` clients then |
57 removed <- gets removedClients |
55 processAction (ProcessAccountInfo info) |
58 when (not $ ci `Set.member` removed) $ |
56 return () |
59 processAction (ProcessAccountInfo info) |
57 --else |
|
58 --do |
|
59 --debugM "Clients" "Got info for dead client" |
|
60 --return (serverInfo, rnc) |
|
61 |
60 |
62 TimerAction tick -> |
61 TimerAction tick -> |
63 return () |
62 return () |
64 --liftM snd $ |
63 --liftM snd $ |
65 -- foldM processAction (0, serverInfo, rnc) $ |
64 -- foldM processAction (0, serverInfo, rnc) $ |
66 -- PingAll : [StatsAction | even tick] |
65 -- PingAll : [StatsAction | even tick] |
67 |
|
68 FreeClient ci -> do |
|
69 rnc <- gets roomsClients |
|
70 liftIO $ removeClient rnc ci |
|
71 |
66 |
72 |
67 |
73 startServer :: ServerInfo -> Socket -> IO () |
68 startServer :: ServerInfo -> Socket -> IO () |
74 startServer serverInfo serverSocket = do |
69 startServer serverInfo serverSocket = do |
75 putStrLn $ "Listening on port " ++ show (listenPort serverInfo) |
70 putStrLn $ "Listening on port " ++ show (listenPort serverInfo) |