equal
deleted
inserted
replaced
19 import CoreTypes |
19 import CoreTypes |
20 import Utils |
20 import Utils |
21 import ClientIO |
21 import ClientIO |
22 import ServerState |
22 import ServerState |
23 import Consts |
23 import Consts |
24 |
24 import ConfigFile |
25 data Action c = |
25 |
|
26 data Action = |
26 AnswerClients ![ClientChan] ![B.ByteString] |
27 AnswerClients ![ClientChan] ![B.ByteString] |
27 | SendServerMessage |
28 | SendServerMessage |
28 | SendServerVars |
29 | SendServerVars |
29 | MoveToRoom RoomIndex |
30 | MoveToRoom RoomIndex |
30 | MoveToLobby B.ByteString |
31 | MoveToLobby B.ByteString |
42 | ChangeMaster |
43 | ChangeMaster |
43 | RemoveClientTeams ClientIndex |
44 | RemoveClientTeams ClientIndex |
44 | ModifyClient (ClientInfo -> ClientInfo) |
45 | ModifyClient (ClientInfo -> ClientInfo) |
45 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
46 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
46 | ModifyRoom (RoomInfo -> RoomInfo) |
47 | ModifyRoom (RoomInfo -> RoomInfo) |
47 | ModifyServerInfo (ServerInfo c -> ServerInfo c) |
48 | ModifyServerInfo (ServerInfo -> ServerInfo) |
48 | AddRoom B.ByteString B.ByteString |
49 | AddRoom B.ByteString B.ByteString |
49 | CheckRegistered |
50 | CheckRegistered |
50 | ClearAccountsCache |
51 | ClearAccountsCache |
51 | ProcessAccountInfo AccountInfo |
52 | ProcessAccountInfo AccountInfo |
52 | AddClient ClientInfo |
53 | AddClient ClientInfo |
54 | PingAll |
55 | PingAll |
55 | StatsAction |
56 | StatsAction |
56 | RestartServer Bool |
57 | RestartServer Bool |
57 |
58 |
58 |
59 |
59 type CmdHandler c = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action c] |
60 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
60 |
61 |
61 instance NFData (Action c) where |
62 instance NFData Action where |
62 rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` () |
63 rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` () |
63 rnf a = a `seq` () |
64 rnf a = a `seq` () |
64 |
65 |
65 instance NFData B.ByteString |
66 instance NFData B.ByteString |
66 instance NFData (Chan a) |
67 instance NFData (Chan a) |
67 |
68 |
68 |
69 |
69 othersChans :: StateT (ServerState c) IO [ClientChan] |
70 othersChans :: StateT ServerState IO [ClientChan] |
70 othersChans = do |
71 othersChans = do |
71 cl <- client's id |
72 cl <- client's id |
72 ri <- clientRoomA |
73 ri <- clientRoomA |
73 liftM (map sendChan . filter (/= cl)) $ roomClientsS ri |
74 liftM (map sendChan . filter (/= cl)) $ roomClientsS ri |
74 |
75 |
75 processAction :: Action c -> StateT (ServerState c) IO () |
76 processAction :: Action -> StateT ServerState IO () |
76 |
77 |
77 |
78 |
78 processAction (AnswerClients chans msg) = |
79 processAction (AnswerClients chans msg) = |
79 io $ mapM_ (`writeChan` (msg `deepseq` msg)) (chans `deepseq` chans) |
80 io $ mapM_ (`writeChan` (msg `deepseq` msg)) (chans `deepseq` chans) |
80 |
81 |
160 ri <- clientRoomA |
161 ri <- clientRoomA |
161 io $ modifyRoom rnc f ri |
162 io $ modifyRoom rnc f ri |
162 return () |
163 return () |
163 |
164 |
164 |
165 |
165 processAction (ModifyServerInfo f) = |
166 processAction (ModifyServerInfo f) = do |
166 modify (\s -> s{serverInfo = f $ serverInfo s}) |
167 modify (\s -> s{serverInfo = f $ serverInfo s}) |
|
168 si <- gets serverInfo |
|
169 io $ writeServerConfig si |
167 |
170 |
168 |
171 |
169 processAction (MoveToRoom ri) = do |
172 processAction (MoveToRoom ri) = do |
170 (Just ci) <- gets clientIndex |
173 (Just ci) <- gets clientIndex |
171 rnc <- gets roomsClients |
174 rnc <- gets roomsClients |