13 |
14 |
14 ----------------------------- |
15 ----------------------------- |
15 import CoreTypes |
16 import CoreTypes |
16 import Utils |
17 import Utils |
17 import ClientIO |
18 import ClientIO |
18 import RoomsAndClients |
19 import ServerState |
19 |
20 |
20 data Action = |
21 data Action = |
21 AnswerClients [ClientChan] [String] |
22 AnswerClients [ClientChan] [String] |
22 | SendServerMessage |
23 | SendServerMessage |
23 | SendServerVars |
24 | SendServerVars |
24 | RoomAddThisClient Int -- roomID |
25 | RoomAddThisClient RoomIndex -- roomID |
25 | RoomRemoveThisClient String |
26 | RoomRemoveThisClient String |
26 | RemoveTeam String |
27 | RemoveTeam String |
27 | RemoveRoom |
28 | RemoveRoom |
28 | UnreadyRoomClients |
29 | UnreadyRoomClients |
29 | MoveToLobby |
30 | MoveToLobby |
30 | ProtocolError String |
31 | ProtocolError String |
31 | Warning String |
32 | Warning String |
32 | ByeClient String |
33 | ByeClient String |
33 | KickClient Int -- clID |
34 | KickClient ClientIndex -- clID |
34 | KickRoomClient Int -- clID |
35 | KickRoomClient ClientIndex -- clID |
35 | BanClient String -- nick |
36 | BanClient String -- nick |
36 | RemoveClientTeams Int -- clID |
37 | RemoveClientTeams ClientIndex -- clID |
37 | ModifyClient (ClientInfo -> ClientInfo) |
38 | ModifyClient (ClientInfo -> ClientInfo) |
38 | ModifyClient2 Int (ClientInfo -> ClientInfo) |
39 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
39 | ModifyRoom (RoomInfo -> RoomInfo) |
40 | ModifyRoom (RoomInfo -> RoomInfo) |
40 | ModifyServerInfo (ServerInfo -> ServerInfo) |
41 | ModifyServerInfo (ServerInfo -> ServerInfo) |
41 | AddRoom String String |
42 | AddRoom String String |
42 | CheckRegistered |
43 | CheckRegistered |
43 | ClearAccountsCache |
44 | ClearAccountsCache |
47 | PingAll |
48 | PingAll |
48 | StatsAction |
49 | StatsAction |
49 |
50 |
50 type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action] |
51 type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action] |
51 |
52 |
52 data ActionsState = ActionsState { |
53 |
53 clientIndex :: Maybe ClientIndex, |
54 processAction :: Action -> StateT ServerState IO () |
54 serverInfo :: ServerInfo, |
|
55 roomsClients :: MRnC |
|
56 } |
|
57 |
|
58 clientRoomA :: StateT ActionsState IO RoomIndex |
|
59 clientRoomA = do |
|
60 (Just ci) <- gets clientIndex |
|
61 rnc <- gets roomsClients |
|
62 liftIO $ clientRoomM rnc ci |
|
63 |
|
64 replaceID a (b, c, d, e) = (a, c, d, e) |
|
65 |
|
66 processAction :: Action -> StateT ActionsState IO () |
|
67 |
55 |
68 |
56 |
69 processAction (AnswerClients chans msg) = |
57 processAction (AnswerClients chans msg) = |
70 liftIO $ mapM_ (flip writeChan msg) chans |
58 liftIO $ mapM_ (flip writeChan msg) chans |
71 |
59 |
109 ri <- clientRoomA |
97 ri <- clientRoomA |
110 when (ri /= lobbyId) $ do |
98 when (ri /= lobbyId) $ do |
111 processAction $ RoomRemoveThisClient ("quit: " ++ msg) |
99 processAction $ RoomRemoveThisClient ("quit: " ++ msg) |
112 return () |
100 return () |
113 |
101 |
|
102 chan <- clients sendChan |
|
103 |
114 liftIO $ do |
104 liftIO $ do |
115 infoM "Clients" (show ci ++ " quits: " ++ msg) |
105 infoM "Clients" (show ci ++ " quits: " ++ msg) |
116 |
106 |
117 chan <- withRoomsAndClients rnc (getChan ci) |
107 |
118 |
|
119 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom |
108 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom |
120 writeChan chan ["BYE", msg] |
109 writeChan chan ["BYE", msg] |
121 modifyRoom rnc (\r -> r{ |
110 modifyRoom rnc (\r -> r{ |
122 --playersIDs = IntSet.delete ci (playersIDs r) |
111 --playersIDs = IntSet.delete ci (playersIDs r) |
123 playersIn = (playersIn r) - 1 |
112 playersIn = (playersIn r) - 1 |
124 --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r |
113 --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r |
125 }) ri |
114 }) ri |
126 removeClient rnc ci |
|
127 where |
|
128 getChan ci irnc = let cl = irnc `client` ci in (sendChan cl) |
|
129 |
|
130 |
115 |
131 {- |
116 {- |
132 where |
117 where |
133 client = clients ! clID |
118 client = clients ! clID |
134 clientNick = nick client |
119 clientNick = nick client |
147 else |
132 else |
148 [AnswerAll ["LOBBY:LEFT", clientNick]] |
133 [AnswerAll ["LOBBY:LEFT", clientNick]] |
149 else |
134 else |
150 [] |
135 [] |
151 -} |
136 -} |
|
137 |
|
138 processAction (ModifyClient f) = do |
|
139 (Just ci) <- gets clientIndex |
|
140 rnc <- gets roomsClients |
|
141 liftIO $ modifyClient rnc f ci |
|
142 return () |
|
143 |
|
144 |
|
145 processAction (ModifyRoom f) = do |
|
146 rnc <- gets roomsClients |
|
147 ri <- clientRoomA |
|
148 liftIO $ modifyRoom rnc f ri |
|
149 return () |
|
150 |
152 {- |
151 {- |
153 |
|
154 processAction (clID, serverInfo, rnc) (ModifyClient func) = |
|
155 return (clID, serverInfo, adjust func clID rnc) |
|
156 |
|
157 |
|
158 processAction (clID, serverInfo, rnc) (ModifyClient2 cl2ID func) = |
|
159 return (clID, serverInfo, adjust func cl2ID rnc) |
|
160 |
|
161 |
|
162 processAction (clID, serverInfo, rnc) (ModifyRoom func) = |
|
163 return (clID, serverInfo, clients, adjust func rID rooms) |
|
164 where |
|
165 rID = roomID $ clients ! clID |
|
166 |
|
167 |
152 |
168 processAction (clID, serverInfo, rnc) (ModifyServerInfo func) = |
153 processAction (clID, serverInfo, rnc) (ModifyServerInfo func) = |
169 return (clID, func serverInfo, rnc) |
154 return (clID, func serverInfo, rnc) |
170 |
155 |
171 |
156 |
306 where |
291 where |
307 room = rooms ! rID |
292 room = rooms ! rID |
308 rID = roomID client |
293 rID = roomID client |
309 client = clients ! clID |
294 client = clients ! clID |
310 rmTeamMsg = toEngineMsg $ 'F' : teamName |
295 rmTeamMsg = toEngineMsg $ 'F' : teamName |
311 |
296 -} |
312 |
297 |
313 processAction (clID, serverInfo, rnc) (CheckRegistered) = do |
298 processAction CheckRegistered = do |
314 writeChan (dbQueries serverInfo) $ CheckAccount (clientUID client) (nick client) (host client) |
299 (Just ci) <- gets clientIndex |
315 return (clID, serverInfo, rnc) |
300 n <- clients nick |
316 where |
301 h <- clients host |
317 client = clients ! clID |
302 db <- gets (dbQueries . serverInfo) |
318 |
303 liftIO $ writeChan db $ CheckAccount ci n h |
319 |
304 return () |
|
305 |
|
306 {- |
320 processAction (clID, serverInfo, rnc) (ClearAccountsCache) = do |
307 processAction (clID, serverInfo, rnc) (ClearAccountsCache) = do |
321 writeChan (dbQueries serverInfo) ClearCache |
308 writeChan (dbQueries serverInfo) ClearCache |
322 return (clID, serverInfo, rnc) |
309 return (clID, serverInfo, rnc) |
323 where |
310 where |
324 client = clients ! clID |
311 client = clients ! clID |
395 processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast" |
382 processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast" |
396 else |
383 else |
397 return (ci, serverInfo) |
384 return (ci, serverInfo) |
398 -} |
385 -} |
399 |
386 |
400 |
387 |
401 |
388 |
402 |
389 |
403 {- |
390 {- |
404 processAction (clID, serverInfo, rnc) PingAll = do |
391 processAction (clID, serverInfo, rnc) PingAll = do |
405 (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, rnc) $ elems clients |
392 (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, rnc) $ elems clients |