equal
deleted
inserted
replaced
5 import Data.IntMap |
5 import Data.IntMap |
6 import qualified Data.IntSet as IntSet |
6 import qualified Data.IntSet as IntSet |
7 import qualified Data.Sequence as Seq |
7 import qualified Data.Sequence as Seq |
8 import System.Log.Logger |
8 import System.Log.Logger |
9 import Monad |
9 import Monad |
|
10 import Data.Time |
|
11 import Maybe |
10 ----------------------------- |
12 ----------------------------- |
11 import CoreTypes |
13 import CoreTypes |
12 import Utils |
14 import Utils |
13 |
15 |
14 data Action = |
16 data Action = |
37 | ModifyServerInfo (ServerInfo -> ServerInfo) |
39 | ModifyServerInfo (ServerInfo -> ServerInfo) |
38 | AddRoom String String |
40 | AddRoom String String |
39 | CheckRegistered |
41 | CheckRegistered |
40 | ProcessAccountInfo AccountInfo |
42 | ProcessAccountInfo AccountInfo |
41 | Dump |
43 | Dump |
|
44 | AddClient ClientInfo |
42 |
45 |
43 type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action] |
46 type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action] |
44 |
47 |
45 replaceID a (b, c, d, e) = (a, c, d, e) |
48 replaceID a (b, c, d, e) = (a, c, d, e) |
46 |
49 |
106 return (clID, serverInfo, clients, rooms) |
109 return (clID, serverInfo, clients, rooms) |
107 |
110 |
108 |
111 |
109 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do |
112 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do |
110 mapM_ (processAction (clID, serverInfo, clients, rooms)) $ answerOthersQuit ++ answerInformRoom |
113 mapM_ (processAction (clID, serverInfo, clients, rooms)) $ answerOthersQuit ++ answerInformRoom |
111 writeChan (sendChan $ clients ! clID) ["BYE"] |
114 writeChan (sendChan $ clients ! clID) ["BYE", msg] |
112 return ( |
115 return ( |
113 0, |
116 0, |
114 serverInfo, |
117 serverInfo, |
115 delete clID clients, |
118 delete clID clients, |
116 adjust (\r -> r{ |
119 adjust (\r -> r{ |
303 |
306 |
304 |
307 |
305 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = do |
308 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = do |
306 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked") |
309 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked") |
307 |
310 |
|
311 |
308 processAction (clID, serverInfo, clients, rooms) (BanClient banNick) = do |
312 processAction (clID, serverInfo, clients, rooms) (BanClient banNick) = do |
309 return (clID, serverInfo, clients, rooms) |
313 return (clID, serverInfo, clients, rooms) |
310 |
314 |
311 |
315 |
312 processAction (clID, serverInfo, clients, rooms) (KickRoomClient kickID) = do |
316 processAction (clID, serverInfo, clients, rooms) (KickRoomClient kickID) = do |
320 where |
324 where |
321 client = clients ! teamsClID |
325 client = clients ! teamsClID |
322 room = rooms ! (roomID client) |
326 room = rooms ! (roomID client) |
323 teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room |
327 teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room |
324 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
328 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
|
329 |
|
330 |
|
331 processAction (clID, serverInfo, clients, rooms) (AddClient client) = do |
|
332 let updatedClients = insert (clientUID client) client clients |
|
333 infoM "Clients" ((show $ clientUID client) ++ ": new client. Time: " ++ (show $ connectTime client)) |
|
334 writeChan (sendChan $ client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
|
335 |
|
336 let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 20) $ lastLogins serverInfo |
|
337 |
|
338 if isJust $ host client `Prelude.lookup` newLogins then |
|
339 processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast" |
|
340 else |
|
341 return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms) |