gameServer/Actions.hs
branch0.9.15
changeset 4779 53f7e964a338
parent 4771 6bb64d38003e
child 4904 0eab727d4717
equal deleted inserted replaced
4732:10f675aee907 4779:53f7e964a338
   389     where
   389     where
   390         lobbyNicks = Prelude.map nick $ Prelude.filter logonPassed $ elems clients
   390         lobbyNicks = Prelude.map nick $ Prelude.filter logonPassed $ elems clients
   391         answerLobbyNicks = [AnswerThisClient ("LOBBY:JOINED": lobbyNicks) | not $ Prelude.null lobbyNicks]
   391         answerLobbyNicks = [AnswerThisClient ("LOBBY:JOINED": lobbyNicks) | not $ Prelude.null lobbyNicks]
   392 
   392 
   393 
   393 
   394 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) =
   394 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = do
   395     liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked")
   395     let client = clients ! kickID
       
   396     currentTime <- getCurrentTime
       
   397     liftM2 replaceID (return clID) (processAction (kickID, serverInfo{lastLogins = (host client, (addUTCTime 60 $ currentTime, "60 seconds ban")) : lastLogins serverInfo}, clients, rooms) $ ByeClient "Kicked")
   396 
   398 
   397 
   399 
   398 processAction (clID, serverInfo, clients, rooms) (BanClient banNick) =
   400 processAction (clID, serverInfo, clients, rooms) (BanClient banNick) =
   399     return (clID, serverInfo, clients, rooms)
   401     return (clID, serverInfo, clients, rooms)
   400 
   402 
   417 processAction (clID, serverInfo, clients, rooms) (AddClient client) = do
   419 processAction (clID, serverInfo, clients, rooms) (AddClient client) = do
   418     let updatedClients = insert (clientUID client) client clients
   420     let updatedClients = insert (clientUID client) client clients
   419     infoM "Clients" (show (clientUID client) ++ ": New client. Time: " ++ show (connectTime client))
   421     infoM "Clients" (show (clientUID client) ++ ": New client. Time: " ++ show (connectTime client))
   420     writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
   422     writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
   421 
   423 
   422     let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo
   424     let newLogins = takeWhile (\(_ , (time, _)) -> (connectTime client) `diffUTCTime` time <= 0) $ lastLogins serverInfo
   423 
   425 
   424     if isJust $ host client `Prelude.lookup` newLogins then
   426     let info = host client `Prelude.lookup` newLogins
   425         processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast"
   427     if isJust info then
       
   428         processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient (snd .  fromJust $ info)
   426         else
   429         else
   427         return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms)
   430         return (clID, serverInfo{lastLogins = (host client, (addUTCTime 10 $ connectTime client, "Reconnected too fast")) : newLogins}, updatedClients, rooms)
   428 
   431 
   429 
   432 
   430 processAction (clID, serverInfo, clients, rooms) PingAll = do
   433 processAction (clID, serverInfo, clients, rooms) PingAll = do
   431     (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, clients, rooms) $ elems clients
   434     (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, clients, rooms) $ elems clients
   432     processAction (clID,
   435     processAction (clID,