gameServer/Actions.hs
changeset 4907 8bf14795a528
parent 4905 7842d085acf4
child 4909 dc6482438674
--- a/gameServer/Actions.hs	Wed Feb 02 21:23:47 2011 +0300
+++ b/gameServer/Actions.hs	Wed Feb 02 21:53:19 2011 +0300
@@ -1,414 +1,424 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Actions where
-
-import Control.Concurrent
-import Control.Concurrent.Chan
-import qualified Data.IntSet as IntSet
-import qualified Data.Set as Set
-import qualified Data.Sequence as Seq
-import System.Log.Logger
-import Control.Monad
-import Data.Time
-import Data.Maybe
-import Control.Monad.Reader
-import Control.Monad.State.Strict
-import qualified Data.ByteString.Char8 as B
-import Control.DeepSeq
------------------------------
-import CoreTypes
-import Utils
-import ClientIO
-import ServerState
-
-data Action =
-    AnswerClients ![ClientChan] ![B.ByteString]
-    | SendServerMessage
-    | SendServerVars
-    | MoveToRoom RoomIndex
-    | MoveToLobby B.ByteString
-    | RemoveTeam B.ByteString
-    | RemoveRoom
-    | UnreadyRoomClients
-    | JoinLobby
-    | ProtocolError B.ByteString
-    | Warning B.ByteString
-    | NoticeMessage Notice
-    | ByeClient B.ByteString
-    | KickClient ClientIndex
-    | KickRoomClient ClientIndex
-    | BanClient B.ByteString
-    | ChangeMaster
-    | RemoveClientTeams ClientIndex
-    | ModifyClient (ClientInfo -> ClientInfo)
-    | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
-    | ModifyRoom (RoomInfo -> RoomInfo)
-    | ModifyServerInfo (ServerInfo -> ServerInfo)
-    | AddRoom B.ByteString B.ByteString
-    | CheckRegistered
-    | ClearAccountsCache
-    | ProcessAccountInfo AccountInfo
-    | AddClient ClientInfo
-    | DeleteClient ClientIndex
-    | PingAll
-    | StatsAction
-
-type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
-
-instance NFData Action where
-    rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
-    rnf a = a `seq` ()
-
-instance NFData B.ByteString
-instance NFData (Chan a)
-
-othersChans = do
-    cl <- client's id
-    ri <- clientRoomA
-    liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
-
-processAction :: Action -> StateT ServerState IO ()
-
-
-processAction (AnswerClients chans msg) = do
-    io $ mapM_ (flip writeChan (msg `deepseq` msg)) (chans `deepseq` chans)
-
-
-processAction SendServerMessage = do
-    chan <- client's sendChan
-    protonum <- client's clientProto
-    si <- liftM serverInfo get
-    let message = if protonum < latestReleaseVersion si then
-            serverMessageForOldVersions si
-            else
-            serverMessage si
-    processAction $ AnswerClients [chan] ["SERVER_MESSAGE", message]
-
-
-processAction SendServerVars = do
-    chan <- client's sendChan
-    si <- gets serverInfo
-    io $ writeChan chan ("SERVER_VARS" : vars si)
-    where
-        vars si = [
-            "MOTD_NEW", serverMessage si,
-            "MOTD_OLD", serverMessageForOldVersions si,
-            "LATEST_PROTO", B.pack . show $ latestReleaseVersion si
-            ]
-
-
-processAction (ProtocolError msg) = do
-    chan <- client's sendChan
-    processAction $ AnswerClients [chan] ["ERROR", msg]
-
-
-processAction (Warning msg) = do
-    chan <- client's sendChan
-    processAction $ AnswerClients [chan] ["WARNING", msg]
-
-processAction (NoticeMessage n) = do
-    chan <- client's sendChan
-    processAction $ AnswerClients [chan] ["NOTICE", B.pack . show . fromEnum $ n]
-
-processAction (ByeClient msg) = do
-    (Just ci) <- gets clientIndex
-    rnc <- gets roomsClients
-    ri <- clientRoomA
-
-    chan <- client's sendChan
-    clNick <- client's nick
-
-    when (ri /= lobbyId) $ do
-        processAction $ MoveToLobby ("quit: " `B.append` msg)
-        return ()
-
-    clientsChans <- liftM (Prelude.map sendChan . Prelude.filter logonPassed) $! allClientsS
-    io $ do
-        infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
-
-    processAction $ AnswerClients [chan] ["BYE", msg]
-    processAction $ AnswerClients clientsChans ["LOBBY:LEFT", clNick, msg]
-
-    s <- get
-    put $! s{removedClients = ci `Set.insert` removedClients s}
-
-processAction (DeleteClient ci) = do
-    rnc <- gets roomsClients
-    io $ removeClient rnc ci
-
-    s <- get
-    put $! s{removedClients = ci `Set.delete` removedClients s}
-
-processAction (ModifyClient f) = do
-    (Just ci) <- gets clientIndex
-    rnc <- gets roomsClients
-    io $ modifyClient rnc f ci
-    return ()
-
-processAction (ModifyClient2 ci f) = do
-    rnc <- gets roomsClients
-    io $ modifyClient rnc f ci
-    return ()
-
-
-processAction (ModifyRoom f) = do
-    rnc <- gets roomsClients
-    ri <- clientRoomA
-    io $ modifyRoom rnc f ri
-    return ()
-
-
-processAction (ModifyServerInfo f) =
-    modify (\s -> s{serverInfo = f $ serverInfo s})
-
-
-processAction (MoveToRoom ri) = do
-    (Just ci) <- gets clientIndex
-    rnc <- gets roomsClients
-
-    io $ do
-        modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False}) ci
-        modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri
-        moveClientToRoom rnc ri ci
-
-    chans <- liftM (map sendChan) $ roomClientsS ri
-    clNick <- client's nick
-
-    processAction $ AnswerClients chans ["JOINED", clNick]
-
-
-processAction (MoveToLobby msg) = do
-    (Just ci) <- gets clientIndex
-    ri <- clientRoomA
-    rnc <- gets roomsClients
-    (gameProgress, playersNum) <- io $ room'sM rnc (\r -> (gameinprogress r, playersIn r)) ri
-    ready <- client's isReady
-    master <- client's isMaster
---    client <- client's id
-    clNick <- client's nick
-    chans <- othersChans
-
-    if master then
-        if gameProgress && playersNum > 1 then
-            mapM_ processAction [ChangeMaster, AnswerClients chans ["LEFT", clNick, msg], NoticeMessage AdminLeft, RemoveClientTeams ci]
-            else
-            processAction RemoveRoom
-        else
-        mapM_ processAction [AnswerClients chans ["LEFT", clNick, msg], RemoveClientTeams ci]
-
-    io $ do
-            modifyRoom rnc (\r -> r{
-                    playersIn = (playersIn r) - 1,
-                    readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
-                    }) ri
-            moveClientToLobby rnc ci
-
-processAction ChangeMaster = do
-    ri <- clientRoomA
-    rnc <- gets roomsClients
-    newMasterId <- liftM head . io $ roomClientsIndicesM rnc ri
-    newMaster <- io $ client'sM rnc id newMasterId
-    let newRoomName = nick newMaster
-    mapM_ processAction [
-        ModifyRoom (\r -> r{masterID = newMasterId, name = newRoomName}),
-        ModifyClient2 newMasterId (\c -> c{isMaster = True}),
-        AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
-        ]
-
-processAction (AddRoom roomName roomPassword) = do
-    Just clId <- gets clientIndex
-    rnc <- gets roomsClients
-    proto <- io $ client'sM rnc clientProto clId
-
-    let room = newRoom{
-            masterID = clId,
-            name = roomName,
-            password = roomPassword,
-            roomProto = proto
-            }
-
-    rId <- io $ addRoom rnc room
-
-    processAction $ MoveToRoom rId
-
-    chans <- liftM (map sendChan) $! roomClientsS lobbyId
-
-    mapM_ processAction [
-        AnswerClients chans ["ROOM", "ADD", roomName]
-        , ModifyClient (\cl -> cl{isMaster = True})
-        ]
-
-
-processAction RemoveRoom = do
-    Just clId <- gets clientIndex
-    rnc <- gets roomsClients
-    ri <- io $ clientRoomM rnc clId
-    roomName <- io $ room'sM rnc name ri
-    others <- othersChans
-    lobbyChans <- liftM (map sendChan) $! roomClientsS lobbyId
-
-    mapM_ processAction [
-            AnswerClients lobbyChans ["ROOM", "DEL", roomName],
-            AnswerClients others ["ROOMABANDONED", roomName]
-        ]
-
-    io $ removeRoom rnc ri
-
-
-processAction (UnreadyRoomClients) = do
-    rnc <- gets roomsClients
-    ri <- clientRoomA
-    roomPlayers <- roomClientsS ri
-    roomClIDs <- io $ roomClientsIndicesM rnc ri
-    processAction $ AnswerClients (map sendChan roomPlayers) ("NOT_READY" : map nick roomPlayers)
-    io $ mapM_ (modifyClient rnc (\cl -> cl{isReady = False})) roomClIDs
-    processAction $ ModifyRoom (\r -> r{readyPlayers = 0})
-
-
-processAction (RemoveTeam teamName) = do
-    rnc <- gets roomsClients
-    cl <- client's id
-    ri <- clientRoomA
-    inGame <- io $ room'sM rnc gameinprogress ri
-    chans <- othersChans
-    if inGame then
-            mapM_ processAction [
-                AnswerClients chans ["REMOVE_TEAM", teamName],
-                ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r})
-                ]
-        else
-            mapM_ processAction [
-                AnswerClients chans ["EM", rmTeamMsg],
-                ModifyRoom (\r -> r{
-                    teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
-                    leftTeams = teamName : leftTeams r,
-                    roundMsgs = roundMsgs r Seq.|> rmTeamMsg
-                    })
-                ]
-    where
-        rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName
-
-
-processAction (RemoveClientTeams clId) = do
-    rnc <- gets roomsClients
-
-    removeTeamActions <- io $ do
-        clNick <- client'sM rnc nick clId
-        rId <- clientRoomM rnc clId
-        roomTeams <- room'sM rnc teams rId
-        return . Prelude.map (RemoveTeam . teamname) . Prelude.filter (\t -> teamowner t == clNick) $ roomTeams
-
-    mapM_ processAction removeTeamActions
-
-
-
-processAction CheckRegistered = do
-    (Just ci) <- gets clientIndex
-    n <- client's nick
-    h <- client's host
-    db <- gets (dbQueries . serverInfo)
-    io $ writeChan db $ CheckAccount ci n h
-    return ()
-
-
-processAction ClearAccountsCache = do
-    dbq <- gets (dbQueries . serverInfo)
-    io $ writeChan dbq ClearCache
-    return ()
-
-
-processAction (ProcessAccountInfo info) =
-    case info of
-        HasAccount passwd isAdmin -> do
-            chan <- client's sendChan
-            processAction $ AnswerClients [chan] ["ASKPASSWORD"]
-        Guest -> do
-            processAction JoinLobby
-        Admin -> do
-            mapM processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
-            chan <- client's sendChan
-            processAction $ AnswerClients [chan] ["ADMIN_ACCESS"]
-
-
-processAction JoinLobby = do
-    chan <- client's sendChan
-    clientNick <- client's nick
-    (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) $! allClientsS
-    mapM_ processAction $
-        (AnswerClients clientsChans ["LOBBY:JOINED", clientNick])
-        : [AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)]
-        ++ [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage]
-
-{-
-processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) =
-    processAction (
-        clID,
-        serverInfo,
-        adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients,
-        adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $
-            adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r)}) 0 rooms
-        ) joinMsg
-    where
-        client = clients ! clID
-        joinMsg = if rID == 0 then
-                AnswerAllOthers ["LOBBY:JOINED", nick client]
-            else
-                AnswerThisRoom ["JOINED", nick client]
-
-processAction (clID, serverInfo, rnc) (KickClient kickID) =
-    liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked")
-
-
-processAction (clID, serverInfo, rnc) (BanClient banNick) =
-    return (clID, serverInfo, rnc)
-
-
-processAction (clID, serverInfo, rnc) (KickRoomClient kickID) = do
-    writeChan (sendChan $ clients ! kickID) ["KICKED"]
-    liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ RoomRemoveThisClient "kicked")
-
--}
-
-processAction (AddClient client) = do
-    rnc <- gets roomsClients
-    si <- gets serverInfo
-    io $ do
-        ci <- addClient rnc client
-        t <- forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
-        forkIO $ clientSendLoop (clientSocket client) t (coreChan si) (sendChan client) ci
-
-        infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
-
-    processAction $ AnswerClients [sendChan client] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
-{-        let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo
-
-        if False && (isJust $ host client `Prelude.lookup` newLogins) then
-            processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast"
-            else
-            return (ci, serverInfo)
--}
-
-
-
-processAction PingAll = do
-    rnc <- gets roomsClients
-    io (allClientsM rnc) >>= mapM_ (kickTimeouted rnc)
-    cis <- io $ allClientsM rnc
-    chans <- io $ mapM (client'sM rnc sendChan) cis
-    io $ mapM_ (modifyClient rnc (\cl -> cl{pingsQueue = pingsQueue cl + 1})) cis
-    processAction $ AnswerClients chans ["PING"]
-    where
-        kickTimeouted rnc ci = do
-            pq <- io $ client'sM rnc pingsQueue ci
-            when (pq > 0) $
-                withStateT (\as -> as{clientIndex = Just ci}) $
-                    processAction (ByeClient "Ping timeout")
-
-
-processAction (StatsAction) = do
-    rnc <- gets roomsClients
-    si <- gets serverInfo
-    (roomsNum, clientsNum) <- io $ withRoomsAndClients rnc stats
-    io $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1)
-    where
-          stats irnc = (length $ allRooms irnc, length $ allClients irnc)
-
+{-# LANGUAGE OverloadedStrings #-}
+module Actions where
+
+import Control.Concurrent
+import Control.Concurrent.Chan
+import qualified Data.IntSet as IntSet
+import qualified Data.Set as Set
+import qualified Data.Sequence as Seq
+import System.Log.Logger
+import Control.Monad
+import Data.Time
+import Data.Maybe
+import Control.Monad.Reader
+import Control.Monad.State.Strict
+import qualified Data.ByteString.Char8 as B
+import Control.DeepSeq
+import Data.Time
+import Text.Printf
+-----------------------------
+import CoreTypes
+import Utils
+import ClientIO
+import ServerState
+
+data Action =
+    AnswerClients ![ClientChan] ![B.ByteString]
+    | SendServerMessage
+    | SendServerVars
+    | MoveToRoom RoomIndex
+    | MoveToLobby B.ByteString
+    | RemoveTeam B.ByteString
+    | RemoveRoom
+    | UnreadyRoomClients
+    | JoinLobby
+    | ProtocolError B.ByteString
+    | Warning B.ByteString
+    | NoticeMessage Notice
+    | ByeClient B.ByteString
+    | KickClient ClientIndex
+    | KickRoomClient ClientIndex
+    | BanClient NominalDiffTime B.ByteString ClientIndex
+    | ChangeMaster
+    | RemoveClientTeams ClientIndex
+    | ModifyClient (ClientInfo -> ClientInfo)
+    | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
+    | ModifyRoom (RoomInfo -> RoomInfo)
+    | ModifyServerInfo (ServerInfo -> ServerInfo)
+    | AddRoom B.ByteString B.ByteString
+    | CheckRegistered
+    | ClearAccountsCache
+    | ProcessAccountInfo AccountInfo
+    | AddClient ClientInfo
+    | DeleteClient ClientIndex
+    | PingAll
+    | StatsAction
+
+type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
+
+instance NFData Action where
+    rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
+    rnf a = a `seq` ()
+
+instance NFData B.ByteString
+instance NFData (Chan a)
+
+othersChans = do
+    cl <- client's id
+    ri <- clientRoomA
+    liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
+
+processAction :: Action -> StateT ServerState IO ()
+
+
+processAction (AnswerClients chans msg) = do
+    io $ mapM_ (flip writeChan (msg `deepseq` msg)) (chans `deepseq` chans)
+
+
+processAction SendServerMessage = do
+    chan <- client's sendChan
+    protonum <- client's clientProto
+    si <- liftM serverInfo get
+    let message = if protonum < latestReleaseVersion si then
+            serverMessageForOldVersions si
+            else
+            serverMessage si
+    processAction $ AnswerClients [chan] ["SERVER_MESSAGE", message]
+
+
+processAction SendServerVars = do
+    chan <- client's sendChan
+    si <- gets serverInfo
+    io $ writeChan chan ("SERVER_VARS" : vars si)
+    where
+        vars si = [
+            "MOTD_NEW", serverMessage si,
+            "MOTD_OLD", serverMessageForOldVersions si,
+            "LATEST_PROTO", B.pack . show $ latestReleaseVersion si
+            ]
+
+
+processAction (ProtocolError msg) = do
+    chan <- client's sendChan
+    processAction $ AnswerClients [chan] ["ERROR", msg]
+
+
+processAction (Warning msg) = do
+    chan <- client's sendChan
+    processAction $ AnswerClients [chan] ["WARNING", msg]
+
+processAction (NoticeMessage n) = do
+    chan <- client's sendChan
+    processAction $ AnswerClients [chan] ["NOTICE", B.pack . show . fromEnum $ n]
+
+processAction (ByeClient msg) = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+    ri <- clientRoomA
+
+    chan <- client's sendChan
+    clNick <- client's nick
+
+    when (ri /= lobbyId) $ do
+        processAction $ MoveToLobby ("quit: " `B.append` msg)
+        return ()
+
+    clientsChans <- liftM (Prelude.map sendChan . Prelude.filter logonPassed) $! allClientsS
+    io $ do
+        infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
+
+    processAction $ AnswerClients [chan] ["BYE", msg]
+    processAction $ AnswerClients clientsChans ["LOBBY:LEFT", clNick, msg]
+
+    s <- get
+    put $! s{removedClients = ci `Set.insert` removedClients s}
+
+processAction (DeleteClient ci) = do
+    rnc <- gets roomsClients
+    io $ removeClient rnc ci
+
+    s <- get
+    put $! s{removedClients = ci `Set.delete` removedClients s}
+
+processAction (ModifyClient f) = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+    io $ modifyClient rnc f ci
+    return ()
+
+processAction (ModifyClient2 ci f) = do
+    rnc <- gets roomsClients
+    io $ modifyClient rnc f ci
+    return ()
+
+
+processAction (ModifyRoom f) = do
+    rnc <- gets roomsClients
+    ri <- clientRoomA
+    io $ modifyRoom rnc f ri
+    return ()
+
+
+processAction (ModifyServerInfo f) =
+    modify (\s -> s{serverInfo = f $ serverInfo s})
+
+
+processAction (MoveToRoom ri) = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+
+    io $ do
+        modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False}) ci
+        modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri
+        moveClientToRoom rnc ri ci
+
+    chans <- liftM (map sendChan) $ roomClientsS ri
+    clNick <- client's nick
+
+    processAction $ AnswerClients chans ["JOINED", clNick]
+
+
+processAction (MoveToLobby msg) = do
+    (Just ci) <- gets clientIndex
+    ri <- clientRoomA
+    rnc <- gets roomsClients
+    (gameProgress, playersNum) <- io $ room'sM rnc (\r -> (gameinprogress r, playersIn r)) ri
+    ready <- client's isReady
+    master <- client's isMaster
+--    client <- client's id
+    clNick <- client's nick
+    chans <- othersChans
+
+    if master then
+        if gameProgress && playersNum > 1 then
+            mapM_ processAction [ChangeMaster, AnswerClients chans ["LEFT", clNick, msg], NoticeMessage AdminLeft, RemoveClientTeams ci]
+            else
+            processAction RemoveRoom
+        else
+        mapM_ processAction [AnswerClients chans ["LEFT", clNick, msg], RemoveClientTeams ci]
+
+    io $ do
+            modifyRoom rnc (\r -> r{
+                    playersIn = (playersIn r) - 1,
+                    readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
+                    }) ri
+            moveClientToLobby rnc ci
+
+processAction ChangeMaster = do
+    ri <- clientRoomA
+    rnc <- gets roomsClients
+    newMasterId <- liftM head . io $ roomClientsIndicesM rnc ri
+    newMaster <- io $ client'sM rnc id newMasterId
+    let newRoomName = nick newMaster
+    mapM_ processAction [
+        ModifyRoom (\r -> r{masterID = newMasterId, name = newRoomName}),
+        ModifyClient2 newMasterId (\c -> c{isMaster = True}),
+        AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
+        ]
+
+processAction (AddRoom roomName roomPassword) = do
+    Just clId <- gets clientIndex
+    rnc <- gets roomsClients
+    proto <- io $ client'sM rnc clientProto clId
+
+    let room = newRoom{
+            masterID = clId,
+            name = roomName,
+            password = roomPassword,
+            roomProto = proto
+            }
+
+    rId <- io $ addRoom rnc room
+
+    processAction $ MoveToRoom rId
+
+    chans <- liftM (map sendChan) $! roomClientsS lobbyId
+
+    mapM_ processAction [
+        AnswerClients chans ["ROOM", "ADD", roomName]
+        , ModifyClient (\cl -> cl{isMaster = True})
+        ]
+
+
+processAction RemoveRoom = do
+    Just clId <- gets clientIndex
+    rnc <- gets roomsClients
+    ri <- io $ clientRoomM rnc clId
+    roomName <- io $ room'sM rnc name ri
+    others <- othersChans
+    lobbyChans <- liftM (map sendChan) $! roomClientsS lobbyId
+
+    mapM_ processAction [
+            AnswerClients lobbyChans ["ROOM", "DEL", roomName],
+            AnswerClients others ["ROOMABANDONED", roomName]
+        ]
+
+    io $ removeRoom rnc ri
+
+
+processAction (UnreadyRoomClients) = do
+    rnc <- gets roomsClients
+    ri <- clientRoomA
+    roomPlayers <- roomClientsS ri
+    roomClIDs <- io $ roomClientsIndicesM rnc ri
+    processAction $ AnswerClients (map sendChan roomPlayers) ("NOT_READY" : map nick roomPlayers)
+    io $ mapM_ (modifyClient rnc (\cl -> cl{isReady = False})) roomClIDs
+    processAction $ ModifyRoom (\r -> r{readyPlayers = 0})
+
+
+processAction (RemoveTeam teamName) = do
+    rnc <- gets roomsClients
+    cl <- client's id
+    ri <- clientRoomA
+    inGame <- io $ room'sM rnc gameinprogress ri
+    chans <- othersChans
+    if inGame then
+            mapM_ processAction [
+                AnswerClients chans ["REMOVE_TEAM", teamName],
+                ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r})
+                ]
+        else
+            mapM_ processAction [
+                AnswerClients chans ["EM", rmTeamMsg],
+                ModifyRoom (\r -> r{
+                    teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
+                    leftTeams = teamName : leftTeams r,
+                    roundMsgs = roundMsgs r Seq.|> rmTeamMsg
+                    })
+                ]
+    where
+        rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName
+
+
+processAction (RemoveClientTeams clId) = do
+    rnc <- gets roomsClients
+
+    removeTeamActions <- io $ do
+        clNick <- client'sM rnc nick clId
+        rId <- clientRoomM rnc clId
+        roomTeams <- room'sM rnc teams rId
+        return . Prelude.map (RemoveTeam . teamname) . Prelude.filter (\t -> teamowner t == clNick) $ roomTeams
+
+    mapM_ processAction removeTeamActions
+
+
+
+processAction CheckRegistered = do
+    (Just ci) <- gets clientIndex
+    n <- client's nick
+    h <- client's host
+    db <- gets (dbQueries . serverInfo)
+    io $ writeChan db $ CheckAccount ci n h
+    return ()
+
+
+processAction ClearAccountsCache = do
+    dbq <- gets (dbQueries . serverInfo)
+    io $ writeChan dbq ClearCache
+    return ()
+
+
+processAction (ProcessAccountInfo info) =
+    case info of
+        HasAccount passwd isAdmin -> do
+            chan <- client's sendChan
+            processAction $ AnswerClients [chan] ["ASKPASSWORD"]
+        Guest -> do
+            processAction JoinLobby
+        Admin -> do
+            mapM processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
+            chan <- client's sendChan
+            processAction $ AnswerClients [chan] ["ADMIN_ACCESS"]
+
+
+processAction JoinLobby = do
+    chan <- client's sendChan
+    clientNick <- client's nick
+    (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) $! allClientsS
+    mapM_ processAction $
+        (AnswerClients clientsChans ["LOBBY:JOINED", clientNick])
+        : [AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)]
+        ++ [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage]
+
+{-
+processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) =
+    processAction (
+        clID,
+        serverInfo,
+        adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients,
+        adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $
+            adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r)}) 0 rooms
+        ) joinMsg
+    where
+        client = clients ! clID
+        joinMsg = if rID == 0 then
+                AnswerAllOthers ["LOBBY:JOINED", nick client]
+            else
+                AnswerThisRoom ["JOINED", nick client]
+                -}
+processAction (KickClient kickId) = do
+    modify (\s -> s{clientIndex = Just kickId})
+    processAction $ ByeClient "Kicked"
+
+
+processAction (BanClient seconds reason banId) = do
+    modify (\s -> s{clientIndex = Just banId})
+    clHost <- client's host
+    currentTime <- io $ getCurrentTime
+    let msg = "Ban for " `B.append` (B.pack . show $ seconds) `B.append` "seconds (" `B.append` msg` B.append` ")"
+    processAction $ ModifyServerInfo (\s -> s{lastLogins = (clHost, (addUTCTime seconds $ currentTime, msg)) : lastLogins s})
+
+
+processAction (KickRoomClient kickId) = do
+    modify (\s -> s{clientIndex = Just kickId})
+    ch <- client's sendChan
+    mapM_ processAction [AnswerClients [ch] ["KICKED"], MoveToLobby "kicked"]
+
+
+processAction (AddClient cl) = do
+    rnc <- gets roomsClients
+    si <- gets serverInfo
+    newClId <- io $ do
+        ci <- addClient rnc cl
+        t <- forkIO $ clientRecvLoop (clientSocket cl) (coreChan si) ci
+        forkIO $ clientSendLoop (clientSocket cl) t (coreChan si) (sendChan cl) ci
+
+        infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime cl))
+
+        return ci
+
+    modify (\s -> s{clientIndex = Just newClId})
+    processAction $ AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
+
+    si <- gets serverInfo
+    let newLogins = takeWhile (\(_ , (time, _)) -> (connectTime cl) `diffUTCTime` time <= 0) $ lastLogins si
+    let info = host cl `Prelude.lookup` newLogins
+    if isJust info then
+        mapM_ processAction [ModifyServerInfo (\s -> s{lastLogins = newLogins}), ByeClient (snd .  fromJust $ info)]
+        else
+        processAction $ ModifyServerInfo (\s -> s{lastLogins = (host cl, (addUTCTime 10 $ connectTime cl, "Reconnected too fast")) : newLogins})
+
+
+processAction PingAll = do
+    rnc <- gets roomsClients
+    io (allClientsM rnc) >>= mapM_ (kickTimeouted rnc)
+    cis <- io $ allClientsM rnc
+    chans <- io $ mapM (client'sM rnc sendChan) cis
+    io $ mapM_ (modifyClient rnc (\cl -> cl{pingsQueue = pingsQueue cl + 1})) cis
+    processAction $ AnswerClients chans ["PING"]
+    where
+        kickTimeouted rnc ci = do
+            pq <- io $ client'sM rnc pingsQueue ci
+            when (pq > 0) $
+                withStateT (\as -> as{clientIndex = Just ci}) $
+                    processAction (ByeClient "Ping timeout")
+
+
+processAction (StatsAction) = do
+    rnc <- gets roomsClients
+    si <- gets serverInfo
+    (roomsNum, clientsNum) <- io $ withRoomsAndClients rnc stats
+    io $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1)
+    where
+          stats irnc = (length $ allRooms irnc, length $ allClients irnc)
+