63 return (clID, serverInfo, clients, rooms) |
63 return (clID, serverInfo, clients, rooms) |
64 |
64 |
65 |
65 |
66 processAction (clID, serverInfo, clients, rooms) (AnswerAllOthers msg) = do |
66 processAction (clID, serverInfo, clients, rooms) (AnswerAllOthers msg) = do |
67 mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) $ |
67 mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) $ |
68 Prelude.filter (\id' -> (id' /= clID) && (logonPassed $ clients ! id')) (keys clients) |
68 Prelude.filter (\id' -> (id' /= clID) && logonPassed (clients ! id')) (keys clients) |
69 return (clID, serverInfo, clients, rooms) |
69 return (clID, serverInfo, clients, rooms) |
70 |
70 |
71 |
71 |
72 processAction (clID, serverInfo, clients, rooms) (AnswerThisRoom msg) = do |
72 processAction (clID, serverInfo, clients, rooms) (AnswerThisRoom msg) = do |
73 mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) roomClients |
73 mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) roomClients |
117 writeChan (sendChan $ clients ! clID) ["WARNING", msg] |
117 writeChan (sendChan $ clients ! clID) ["WARNING", msg] |
118 return (clID, serverInfo, clients, rooms) |
118 return (clID, serverInfo, clients, rooms) |
119 |
119 |
120 |
120 |
121 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do |
121 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do |
122 infoM "Clients" ((show $ clientUID client) ++ " quits: " ++ msg) |
122 infoM "Clients" (show (clientUID client) ++ " quits: " ++ msg) |
123 (_, _, newClients, newRooms) <- |
123 (_, _, newClients, newRooms) <- |
124 if roomID client /= 0 then |
124 if roomID client /= 0 then |
125 processAction (clID, serverInfo, clients, rooms) $ RoomRemoveThisClient "quit" |
125 processAction (clID, serverInfo, clients, rooms) $ RoomRemoveThisClient "quit" |
126 else |
126 else |
127 return (clID, serverInfo, clients, rooms) |
127 return (clID, serverInfo, clients, rooms) |
157 [AnswerAll ["LOBBY:LEFT", clientNick]] |
157 [AnswerAll ["LOBBY:LEFT", clientNick]] |
158 else |
158 else |
159 [] |
159 [] |
160 |
160 |
161 |
161 |
162 processAction (clID, serverInfo, clients, rooms) (ModifyClient func) = do |
162 processAction (clID, serverInfo, clients, rooms) (ModifyClient func) = |
163 return (clID, serverInfo, adjust func clID clients, rooms) |
163 return (clID, serverInfo, adjust func clID clients, rooms) |
164 |
164 |
165 |
165 |
166 processAction (clID, serverInfo, clients, rooms) (ModifyRoom func) = do |
166 processAction (clID, serverInfo, clients, rooms) (ModifyRoom func) = |
167 return (clID, serverInfo, clients, adjust func rID rooms) |
167 return (clID, serverInfo, clients, adjust func rID rooms) |
168 where |
168 where |
169 rID = roomID $ clients ! clID |
169 rID = roomID $ clients ! clID |
170 |
170 |
171 |
171 |
172 processAction (clID, serverInfo, clients, rooms) (ModifyServerInfo func) = do |
172 processAction (clID, serverInfo, clients, rooms) (ModifyServerInfo func) = |
173 return (clID, func serverInfo, clients, rooms) |
173 return (clID, func serverInfo, clients, rooms) |
174 |
174 |
175 |
175 |
176 processAction (clID, serverInfo, clients, rooms) (RoomAddThisClient rID) = do |
176 processAction (clID, serverInfo, clients, rooms) (RoomAddThisClient rID) = |
177 processAction ( |
177 processAction ( |
178 clID, |
178 clID, |
179 serverInfo, |
179 serverInfo, |
180 adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients, |
180 adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients, |
181 adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $ |
181 adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $ |
319 where |
319 where |
320 client = clients ! clID |
320 client = clients ! clID |
321 |
321 |
322 |
322 |
323 processAction (clID, serverInfo, clients, rooms) (ClearAccountsCache) = do |
323 processAction (clID, serverInfo, clients, rooms) (ClearAccountsCache) = do |
324 writeChan (dbQueries serverInfo) $ ClearCache |
324 writeChan (dbQueries serverInfo) ClearCache |
325 return (clID, serverInfo, clients, rooms) |
325 return (clID, serverInfo, clients, rooms) |
326 where |
326 where |
327 client = clients ! clID |
327 client = clients ! clID |
328 |
328 |
329 |
329 |
330 processAction (clID, serverInfo, clients, rooms) (Dump) = do |
330 processAction (clID, serverInfo, clients, rooms) (Dump) = do |
331 writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms] |
331 writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms] |
332 return (clID, serverInfo, clients, rooms) |
332 return (clID, serverInfo, clients, rooms) |
333 |
333 |
334 |
334 |
335 processAction (clID, serverInfo, clients, rooms) (ProcessAccountInfo info) = do |
335 processAction (clID, serverInfo, clients, rooms) (ProcessAccountInfo info) = |
336 case info of |
336 case info of |
337 HasAccount passwd isAdmin -> do |
337 HasAccount passwd isAdmin -> do |
338 infoM "Clients" $ show clID ++ " has account" |
338 infoM "Clients" $ show clID ++ " has account" |
339 writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"] |
339 writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"] |
340 return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd, isAdministrator = isAdmin}) clID clients, rooms) |
340 return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd, isAdministrator = isAdmin}) clID clients, rooms) |
344 Admin -> do |
344 Admin -> do |
345 infoM "Clients" $ show clID ++ " is admin" |
345 infoM "Clients" $ show clID ++ " is admin" |
346 foldM processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True, isAdministrator = True}) clID clients, rooms) [MoveToLobby, AnswerThisClient ["ADMIN_ACCESS"]] |
346 foldM processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True, isAdministrator = True}) clID clients, rooms) [MoveToLobby, AnswerThisClient ["ADMIN_ACCESS"]] |
347 |
347 |
348 |
348 |
349 processAction (clID, serverInfo, clients, rooms) (MoveToLobby) = do |
349 processAction (clID, serverInfo, clients, rooms) (MoveToLobby) = |
350 foldM processAction (clID, serverInfo, clients, rooms) $ |
350 foldM processAction (clID, serverInfo, clients, rooms) $ |
351 (RoomAddThisClient 0) |
351 (RoomAddThisClient 0) |
352 : answerLobbyNicks |
352 : answerLobbyNicks |
353 ++ [SendServerMessage] |
353 ++ [SendServerMessage] |
354 |
354 |
355 -- ++ (answerServerMessage client clients) |
355 -- ++ (answerServerMessage client clients) |
356 where |
356 where |
357 lobbyNicks = Prelude.map nick $ Prelude.filter logonPassed $ elems clients |
357 lobbyNicks = Prelude.map nick $ Prelude.filter logonPassed $ elems clients |
358 answerLobbyNicks = if not $ Prelude.null lobbyNicks then |
358 answerLobbyNicks = [AnswerThisClient ("LOBBY:JOINED": lobbyNicks) | not $ Prelude.null lobbyNicks] |
359 [AnswerThisClient (["LOBBY:JOINED"] ++ lobbyNicks)] |
359 |
360 else |
360 |
361 [] |
361 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = |
362 |
|
363 |
|
364 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = do |
|
365 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked") |
362 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked") |
366 |
363 |
367 |
364 |
368 processAction (clID, serverInfo, clients, rooms) (BanClient banNick) = do |
365 processAction (clID, serverInfo, clients, rooms) (BanClient banNick) = |
369 return (clID, serverInfo, clients, rooms) |
366 return (clID, serverInfo, clients, rooms) |
370 |
367 |
371 |
368 |
372 processAction (clID, serverInfo, clients, rooms) (KickRoomClient kickID) = do |
369 processAction (clID, serverInfo, clients, rooms) (KickRoomClient kickID) = do |
373 writeChan (sendChan $ clients ! kickID) ["KICKED"] |
370 writeChan (sendChan $ clients ! kickID) ["KICKED"] |
374 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ RoomRemoveThisClient "kicked") |
371 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ RoomRemoveThisClient "kicked") |
375 |
372 |
376 |
373 |
377 processAction (clID, serverInfo, clients, rooms) (RemoveClientTeams teamsClID) = do |
374 processAction (clID, serverInfo, clients, rooms) (RemoveClientTeams teamsClID) = |
378 liftM2 replaceID (return clID) $ |
375 liftM2 replaceID (return clID) $ |
379 foldM processAction (teamsClID, serverInfo, clients, rooms) $ removeTeamsActions |
376 foldM processAction (teamsClID, serverInfo, clients, rooms) removeTeamsActions |
380 where |
377 where |
381 client = clients ! teamsClID |
378 client = clients ! teamsClID |
382 room = rooms ! (roomID client) |
379 room = rooms ! (roomID client) |
383 teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room |
380 teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room |
384 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
381 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
385 |
382 |
386 |
383 |
387 processAction (clID, serverInfo, clients, rooms) (AddClient client) = do |
384 processAction (clID, serverInfo, clients, rooms) (AddClient client) = do |
388 let updatedClients = insert (clientUID client) client clients |
385 let updatedClients = insert (clientUID client) client clients |
389 infoM "Clients" ((show $ clientUID client) ++ ": New client. Time: " ++ (show $ connectTime client)) |
386 infoM "Clients" (show (clientUID client) ++ ": New client. Time: " ++ show (connectTime client)) |
390 writeChan (sendChan $ client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
387 writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
391 |
388 |
392 let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo |
389 let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo |
393 |
390 |
394 if isJust $ host client `Prelude.lookup` newLogins then |
391 if isJust $ host client `Prelude.lookup` newLogins then |
395 processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast" |
392 processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast" |