40 | AddRoom String String |
40 | AddRoom String String |
41 | CheckRegistered |
41 | CheckRegistered |
42 | ProcessAccountInfo AccountInfo |
42 | ProcessAccountInfo AccountInfo |
43 | Dump |
43 | Dump |
44 | AddClient ClientInfo |
44 | AddClient ClientInfo |
|
45 | PingAll |
45 |
46 |
46 type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action] |
47 type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action] |
47 |
48 |
48 replaceID a (b, c, d, e) = (a, c, d, e) |
49 replaceID a (b, c, d, e) = (a, c, d, e) |
49 |
50 |
54 writeChan (sendChan $ clients ! clID) msg |
55 writeChan (sendChan $ clients ! clID) msg |
55 return (clID, serverInfo, clients, rooms) |
56 return (clID, serverInfo, clients, rooms) |
56 |
57 |
57 |
58 |
58 processAction (clID, serverInfo, clients, rooms) (AnswerAll msg) = do |
59 processAction (clID, serverInfo, clients, rooms) (AnswerAll msg) = do |
59 mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) (keys clients) |
60 mapM_ (\cl -> writeChan (sendChan cl) msg) (elems clients) |
60 return (clID, serverInfo, clients, rooms) |
61 return (clID, serverInfo, clients, rooms) |
61 |
62 |
62 |
63 |
63 processAction (clID, serverInfo, clients, rooms) (AnswerAllOthers msg) = do |
64 processAction (clID, serverInfo, clients, rooms) (AnswerAllOthers msg) = do |
64 mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) $ |
65 mapM_ (\id -> writeChan (sendChan $ clients ! id) msg) $ |
328 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
329 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
329 |
330 |
330 |
331 |
331 processAction (clID, serverInfo, clients, rooms) (AddClient client) = do |
332 processAction (clID, serverInfo, clients, rooms) (AddClient client) = do |
332 let updatedClients = insert (clientUID client) client clients |
333 let updatedClients = insert (clientUID client) client clients |
333 infoM "Clients" ((show $ clientUID client) ++ ": new client. Time: " ++ (show $ connectTime client)) |
334 infoM "Clients" ((show $ clientUID client) ++ ": New client. Time: " ++ (show $ connectTime client)) |
334 writeChan (sendChan $ client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
335 writeChan (sendChan $ client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
335 |
336 |
336 let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 20) $ lastLogins serverInfo |
337 let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 20) $ lastLogins serverInfo |
337 |
338 |
338 if isJust $ host client `Prelude.lookup` newLogins then |
339 if isJust $ host client `Prelude.lookup` newLogins then |
339 processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast" |
340 processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast" |
340 else |
341 else |
341 return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms) |
342 return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms) |
|
343 |
|
344 |
|
345 processAction (clID, serverInfo, clients, rooms) PingAll = do |
|
346 processAction (clID, |
|
347 serverInfo, |
|
348 map (\cl -> cl{pingsQueue = pingsQueue cl + 1}) clients, |
|
349 rooms) $ AnswerAll ["PING"] |
|
350 |