110 return (clID, serverInfo, clients, rooms) |
110 return (clID, serverInfo, clients, rooms) |
111 |
111 |
112 |
112 |
113 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do |
113 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do |
114 (_, _, newClients, newRooms) <- |
114 (_, _, newClients, newRooms) <- |
115 processAction (clID, serverInfo, clients, rooms) |
115 if roomID client /= 0 then |
|
116 processAction (clID, serverInfo, clients, rooms) |
116 (if isMaster client then RemoveRoom else RemoveClientTeams clID) |
117 (if isMaster client then RemoveRoom else RemoveClientTeams clID) |
|
118 else |
|
119 return (clID, serverInfo, clients, rooms) |
117 |
120 |
118 mapM_ (processAction (clID, serverInfo, newClients, newRooms)) $ answerOthersQuit ++ answerInformRoom |
121 mapM_ (processAction (clID, serverInfo, newClients, newRooms)) $ answerOthersQuit ++ answerInformRoom |
119 writeChan (sendChan $ clients ! clID) ["BYE", msg] |
122 writeChan (sendChan $ clients ! clID) ["BYE", msg] |
120 return ( |
123 return ( |
121 0, |
124 0, |
123 delete clID newClients, |
126 delete clID newClients, |
124 adjust (\r -> r{ |
127 adjust (\r -> r{ |
125 playersIDs = IntSet.delete clID (playersIDs r), |
128 playersIDs = IntSet.delete clID (playersIDs r), |
126 playersIn = (playersIn r) - 1, |
129 playersIn = (playersIn r) - 1, |
127 readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r |
130 readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r |
128 }) rID newRooms |
131 }) (roomID $ newClients ! clID) newRooms |
129 ) |
132 ) |
130 where |
133 where |
131 client = clients ! clID |
134 client = clients ! clID |
132 rID = roomID client |
|
133 clientNick = nick client |
135 clientNick = nick client |
134 answerInformRoom = |
136 answerInformRoom = |
135 if roomID client /= 0 then |
137 if roomID client /= 0 then |
136 if not $ Prelude.null msg then |
138 if not $ Prelude.null msg then |
137 [AnswerThisRoom ["LEFT", clientNick, msg]] |
139 [AnswerThisRoom ["LEFT", clientNick, msg]] |
338 infoM "Clients" ((show $ clientUID client) ++ ": New client. Time: " ++ (show $ connectTime client)) |
340 infoM "Clients" ((show $ clientUID client) ++ ": New client. Time: " ++ (show $ connectTime client)) |
339 writeChan (sendChan $ client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
341 writeChan (sendChan $ client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
340 |
342 |
341 let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 20) $ lastLogins serverInfo |
343 let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 20) $ lastLogins serverInfo |
342 |
344 |
343 if isJust $ host client `Prelude.lookup` newLogins then |
345 -- if isJust $ host client `Prelude.lookup` newLogins then |
344 processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast" |
346 -- processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast" |
345 else |
347 -- else |
346 return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms) |
348 return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms) |
347 |
349 |
348 |
350 |
349 processAction (clID, serverInfo, clients, rooms) PingAll = do |
351 processAction (clID, serverInfo, clients, rooms) PingAll = do |
350 (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, clients, rooms) $ elems clients |
352 (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, clients, rooms) $ elems clients |
351 processAction (clID, |
353 processAction (clID, |