# HG changeset patch
# User unc0rr
# Date 1273167548 0
# Node ID 4e4f88a7bdf20b51f59c1c6001a025fc966be0b0
# Parent  6af73e7f24385489631546e25432ebb590d10254
Some more steps in refactoring

diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/Actions.hs	Thu May 06 17:39:08 2010 +0000
@@ -1,7 +1,6 @@
 module Actions where
 
 import Control.Concurrent
-import Control.Concurrent.STM
 import Control.Concurrent.Chan
 import qualified Data.IntSet as IntSet
 import qualified Data.Sequence as Seq
@@ -9,6 +8,7 @@
 import Monad
 import Data.Time
 import Maybe
+import Control.Monad.Reader
 
 -----------------------------
 import CoreTypes
@@ -17,7 +17,7 @@
 import RoomsAndClients
 
 data Action =
-    AnswerClients [Chan [String]] [String]
+    AnswerClients [ClientChan] [String]
     | SendServerMessage
     | SendServerVars
     | RoomAddThisClient Int -- roomID
@@ -46,7 +46,7 @@
     | PingAll
     | StatsAction
 
-type CmdHandler = Int -> MRnC -> [String] -> [Action]
+type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action]
 
 replaceID a (b, c, d, e) = (a, c, d, e)
 
@@ -89,17 +89,16 @@
 processAction (clID, serverInfo, rnc) (Warning msg) = do
     writeChan (sendChan $ clients ! clID) ["WARNING", msg]
     return (clID, serverInfo, rnc)
+-}
 
+processAction (ci, serverInfo, rnc) (ByeClient msg) = do
+    infoM "Clients" (show ci ++ " quits: " ++ msg)
 
-processAction (clID, serverInfo, rnc) (ByeClient msg) = do
-    infoM "Clients" (show (clientUID client) ++ " quits: " ++ msg)
-    (_, _, newClients, newRooms) <-
-            if roomID client /= 0 then
-                processAction  (clID, serverInfo, rnc) $ RoomRemoveThisClient "quit"
-                else
-                    return (clID, serverInfo, rnc)
+    ri <- clientRoomM rnc ci
+    when (ri /= lobbyId)
+        processAction (ci, serverInfo, rnc) $ RoomRemoveThisClient ("quit: " ++ msg)
 
-    mapM_ (processAction (clID, serverInfo, newClients, newRooms)) $ answerOthersQuit ++ answerInformRoom
+    mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
     writeChan (sendChan $ clients ! clID) ["BYE", msg]
     return (
             0,
@@ -130,7 +129,7 @@
                     [AnswerAll ["LOBBY:LEFT", clientNick]]
             else
                 []
-
+{-
 
 processAction (clID, serverInfo, rnc) (ModifyClient func) =
     return (clID, serverInfo, adjust func clID rnc)
@@ -357,24 +356,24 @@
         room = rooms ! (roomID client)
         teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room
         removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove
-
+-}
 
-processAction (clID, serverInfo, rnc) (AddClient client) = do
-    forkIO $ clientRecvLoop (clientHandle client) (coreChan serverInfo) (clientUID client)
-    forkIO $ clientSendLoop (clientHandle client) (coreChan serverInfo) (sendChan client) (clientUID client)
+processAction (_, serverInfo, rnc) (AddClient client) = do
+    ci <- addClient rnc client
+    forkIO $ clientRecvLoop (clientHandle client) (coreChan serverInfo) ci
+    forkIO $ clientSendLoop (clientHandle client) (coreChan serverInfo) (sendChan client) ci
 
-    let updatedClients = insert (clientUID client) client clients
-    infoM "Clients" (show (clientUID client) ++ ": New client. Time: " ++ show (connectTime client))
+    infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
     writeChan (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 (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast"
+        processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast"
         else
-        return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms)
+        return (ci, serverInfo)
 
-
+{-
 processAction (clID, serverInfo, rnc) PingAll = do
     (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, rnc) $ elems clients
     processAction (clID,
@@ -393,4 +392,4 @@
     writeChan (dbQueries serverInfo) $ SendStats (size clients) (size rooms - 1)
     return (clID, serverInfo, rnc)
 
--}
\ No newline at end of file
+-}
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/ClientIO.hs
--- a/gameServer/ClientIO.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/ClientIO.hs	Thu May 06 17:39:08 2010 +0000
@@ -10,8 +10,9 @@
 import qualified Data.ByteString as B
 ----------------
 import CoreTypes
+import RoomsAndClients
 
-listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()
+listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> ClientIndex -> IO ()
 listenLoop handle linesNumber buf chan clientID = do
     str <- liftM BUTF8.toString $ B.hGetLine handle
     if (linesNumber > 50) || (length str > 450) then
@@ -24,13 +25,13 @@
             else
             listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID
 
-clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO ()
+clientRecvLoop :: Handle -> Chan CoreMessage -> ClientIndex -> IO ()
 clientRecvLoop handle chan clientID =
     listenLoop handle 0 [] chan clientID
         `catch` (\e -> clientOff (show e) >> return ())
     where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
 
-clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()
+clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> ClientIndex -> IO()
 clientSendLoop handle coreChan chan clientID = do
     answer <- readChan chan
     doClose <- Exception.handle
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/CoreTypes.hs	Thu May 06 17:39:08 2010 +0000
@@ -5,7 +5,6 @@
 import Control.Concurrent.STM
 import Data.Word
 import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import Data.Sequence(Seq, empty)
 import Data.Time
@@ -14,11 +13,12 @@
 
 import RoomsAndClients
 
+type ClientChan = Chan [String]
+
 data ClientInfo =
     ClientInfo
     {
-        clientUID :: !Int,
-        sendChan :: Chan [String],
+        sendChan :: ClientChan,
         clientHandle :: Handle,
         host :: String,
         connectTime :: UTCTime,
@@ -36,9 +36,7 @@
     }
 
 instance Show ClientInfo where
-    show ci = show (clientUID ci)
-            ++ " nick: " ++ (nick ci)
-            ++ " host: " ++ (host ci)
+    show ci = " nick: " ++ (nick ci) ++ " host: " ++ (host ci)
 
 instance Eq ClientInfo where
     (==) = (==) `on` clientHandle
@@ -70,7 +68,6 @@
 data RoomInfo =
     RoomInfo
     {
-        roomUID :: !Int,
         masterID :: !Int,
         name :: String,
         password :: String,
@@ -89,19 +86,15 @@
     }
 
 instance Show RoomInfo where
-    show ri = show (roomUID ri)
-            ++ ", players ids: " ++ show (IntSet.size $ playersIDs ri)
+    show ri = ", players ids: " ++ show (IntSet.size $ playersIDs ri)
             ++ ", players: " ++ show (playersIn ri)
             ++ ", ready: " ++ show (readyPlayers ri)
             ++ ", teams: " ++ show (teams ri)
 
-instance Eq RoomInfo where
-    (==) = (==) `on` roomUID
-
+newRoom :: RoomInfo
 newRoom = (
     RoomInfo
         0
-        0
         ""
         ""
         0
@@ -144,8 +137,9 @@
     }
 
 instance Show ServerInfo where
-    show si = "Server Info"
+    show _ = "Server Info"
 
+newServerInfo :: TMVar StatisticsInfo -> Chan CoreMessage -> Chan DBQuery -> ServerInfo
 newServerInfo = (
     ServerInfo
         True
@@ -167,23 +161,17 @@
     deriving (Show, Read)
 
 data DBQuery =
-    CheckAccount Int String String
+    CheckAccount ClientIndex String String
     | ClearCache
     | SendStats Int Int
     deriving (Show, Read)
 
 data CoreMessage =
     Accept ClientInfo
-    | ClientMessage (Int, [String])
-    | ClientAccountInfo (Int, AccountInfo)
+    | ClientMessage (ClientIndex, [String])
+    | ClientAccountInfo (ClientIndex, AccountInfo)
     | TimerAction Int
 
 type MRnC = MRoomsAndClients RoomInfo ClientInfo
 type IRnC = IRoomsAndClients RoomInfo ClientInfo
 
---type ClientsTransform = [ClientInfo] -> [ClientInfo]
---type RoomsTransform = [RoomInfo] -> [RoomInfo]
---type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo]
---type Answer = ServerInfo -> (HandlesSelector, [String])
-
---type ClientsSelector = Clients -> Rooms -> [Int]
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/HWProtoCore.hs
--- a/gameServer/HWProtoCore.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/HWProtoCore.hs	Thu May 06 17:39:08 2010 +0000
@@ -3,6 +3,7 @@
 import qualified Data.IntMap as IntMap
 import Data.Foldable
 import Maybe
+import Control.Monad.Reader
 --------------------------------------
 import CoreTypes
 import Actions
@@ -10,17 +11,20 @@
 import HWProtoNEState
 import HWProtoLobbyState
 import HWProtoInRoomState
+import HandlerUtils
+import RoomsAndClients
 
 handleCmd, handleCmd_loggedin :: CmdHandler
 
-handleCmd clID _ _ ["PING"] = [AnswerThisClient ["PONG"]]
+
+handleCmd ["PING"] = answerClient ["PONG"]
 
-handleCmd clID clients rooms ("QUIT" : xs) =
-    [ByeClient msg]
+
+handleCmd ("QUIT" : xs) = return [ByeClient msg]
     where
         msg = if not $ null xs then head xs else ""
 
-
+{-
 handleCmd clID clients _ ["PONG"] =
     if pingsQueue client == 0 then
         [ProtocolError "Protocol violation"]
@@ -28,17 +32,16 @@
         [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
     where
         client = clients IntMap.! clID
-
+-}
 
-handleCmd clID clients rooms cmd =
-    if not $ logonPassed client then
-        handleCmd_NotEntered clID clients rooms cmd
-    else
-        handleCmd_loggedin clID clients rooms cmd
-    where
-        client = clients IntMap.! clID
+handleCmd cmd = do
+    (ci, irnc) <- ask
+    if logonPassed (irnc `client` ci) then
+        handleCmd_NotEntered cmd
+        else
+        handleCmd_loggedin cmd
 
-
+{-
 handleCmd_loggedin clID clients rooms ["INFO", asknick] =
     if noSuchClient then
         []
@@ -62,11 +65,12 @@
             then if teamsInGame client > 0 then "(playing)" else "(spectating)"
             else ""
 
+-}
 
-handleCmd_loggedin clID clients rooms cmd =
-    if roomID client == 0 then
-        handleCmd_lobby clID clients rooms cmd
-    else
-        handleCmd_inRoom clID clients rooms cmd
-    where
-        client = clients IntMap.! clID
+
+handleCmd_loggedin cmd = do
+    (ci, rnc) <- ask
+    if clientRoom rnc ci == lobbyId then
+        handleCmd_lobby cmd
+        else
+        handleCmd_inRoom cmd
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/HWProtoInRoomState.hs
--- a/gameServer/HWProtoInRoomState.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/HWProtoInRoomState.hs	Thu May 06 17:39:08 2010 +0000
@@ -1,7 +1,6 @@
 module HWProtoInRoomState where
 
 import qualified Data.Foldable as Foldable
-import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map
 import Data.Sequence(Seq, (|>), (><), fromList, empty)
 import Data.List
@@ -10,15 +9,17 @@
 import CoreTypes
 import Actions
 import Utils
+import HandlerUtils
 
 
 handleCmd_inRoom :: CmdHandler
 
-handleCmd_inRoom clID clients _ ["CHAT", msg] =
-    [AnswerOthersInRoom ["CHAT", clientNick, msg]]
-    where
-        clientNick = nick $ clients IntMap.! clID
+handleCmd_inRoom ["CHAT", msg] = do
+    n <- clientNick
+    s <- roomOthersChans
+    return [AnswerClients s ["CHAT", n, msg]]
 
+{-
 handleCmd_inRoom clID clients rooms ["PART"] =
     [RoomRemoveThisClient "part"]
     where
@@ -194,3 +195,4 @@
         engineMsg = toEngineMsg $ 'b' : ((nick client) ++ "(team): " ++ msg ++ "\x20\x20")
 
 handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]
+-}
\ No newline at end of file
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/HWProtoLobbyState.hs	Thu May 06 17:39:08 2010 +0000
@@ -11,16 +11,18 @@
 import CoreTypes
 import Actions
 import Utils
+import HandlerUtils
 
-answerAllTeams protocol teams = concatMap toAnswer teams
+{-answerAllTeams protocol teams = concatMap toAnswer teams
     where
         toAnswer team =
             [AnswerThisClient $ teamToNet protocol team,
             AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team],
             AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]]
-
+-}
 handleCmd_lobby :: CmdHandler
 
+{-
 handleCmd_lobby clID clients rooms ["LIST"] =
     [AnswerThisClient ("ROOMS" : roomsInfoList)]
     where
@@ -45,13 +47,14 @@
                 head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
                 head (Map.findWithDefault ["Default"] "AMMO" (params room))
                 ]
+-}
 
-handleCmd_lobby clID clients _ ["CHAT", msg] =
-    [AnswerOthersInRoom ["CHAT", clientNick, msg]]
-    where
-        clientNick = nick $ clients IntMap.! clID
+handleCmd_lobby ["CHAT", msg] = do
+    n <- clientNick
+    s <- roomOthersChans
+    return [AnswerClients s ["CHAT", n, msg]]
 
-
+{-
 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword]
     | haveSameRoom = [Warning "Room exists"]
     | illegalName newRoom = [Warning "Illegal room name"]
@@ -183,3 +186,4 @@
 
 
 handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"]
+-}
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/HWProtoNEState.hs
--- a/gameServer/HWProtoNEState.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/HWProtoNEState.hs	Thu May 06 17:39:08 2010 +0000
@@ -11,6 +11,7 @@
 
 handleCmd_NotEntered :: CmdHandler
 
+{-
 handleCmd_NotEntered clID clients _ ["NICK", newNick]
     | not . null $ nick client = [ProtocolError "Nickname already chosen"]
     | haveSameNick = [AnswerThisClient ["WARNING", "Nickname already in use"], ByeClient ""]
@@ -49,6 +50,6 @@
 
 handleCmd_NotEntered clID clients _ ["DUMP"] =
     if isAdministrator (clients IntMap.! clID) then [Dump] else []
-
+-}
 
-handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"]
+handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"]
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/HandlerUtils.hs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/HandlerUtils.hs	Thu May 06 17:39:08 2010 +0000
@@ -0,0 +1,29 @@
+module HandlerUtils where
+
+import Control.Monad.Reader
+
+import RoomsAndClients
+import CoreTypes
+import Actions
+
+thisClient :: Reader (ClientIndex, IRnC) ClientInfo
+thisClient = do
+    (ci, rnc) <- ask
+    return $ rnc `client` ci
+
+clientNick :: Reader (ClientIndex, IRnC) String
+clientNick = liftM nick thisClient
+
+roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan]
+roomOthersChans = do
+    (ci, rnc) <- ask
+    let ri = clientRoom rnc ci
+    return $ map (sendChan . client rnc) (roomClients rnc ri)
+
+thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]
+thisClientChans = do
+    (ci, rnc) <- ask
+    return $ [sendChan (rnc `client` ci)]
+
+answerClient :: [String] -> Reader (ClientIndex, IRnC) [Action]
+answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/NetRoutines.hs
--- a/gameServer/NetRoutines.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/NetRoutines.hs	Thu May 06 17:39:08 2010 +0000
@@ -1,38 +1,34 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module NetRoutines where
 
-import Network
 import Network.Socket
 import System.IO
-import Control.Concurrent
 import Control.Concurrent.Chan
-import Control.Concurrent.STM
 import qualified Control.Exception as Exception
 import Data.Time
+import Control.Monad
 -----------------------------
 import CoreTypes
-import ClientIO
 import Utils
 
-acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
-acceptLoop servSock coreChan clientCounter = do
+acceptLoop :: Socket -> Chan CoreMessage -> IO ()
+acceptLoop servSock chan = forever $ do
     Exception.handle
         (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
         do
-        (socket, sockAddr) <- Network.Socket.accept servSock
+        (sock, sockAddr) <- Network.Socket.accept servSock
 
-        cHandle <- socketToHandle socket ReadWriteMode
+        cHandle <- socketToHandle sock ReadWriteMode
         hSetBuffering cHandle LineBuffering
         clientHost <- sockAddr2String sockAddr
 
         currentTime <- getCurrentTime
 
-        sendChan <- newChan
+        sendChan' <- newChan
 
         let newClient =
                 (ClientInfo
-                    nextID
-                    sendChan
+                    sendChan'
                     cHandle
                     clientHost
                     currentTime
@@ -49,9 +45,5 @@
                     undefined
                     )
 
-        writeChan coreChan $ Accept newClient
+        writeChan chan $ Accept newClient
         return ()
-
-    acceptLoop servSock coreChan nextID
-    where
-        nextID = clientCounter + 1
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/RoomsAndClients.hs
--- a/gameServer/RoomsAndClients.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/RoomsAndClients.hs	Thu May 06 17:39:08 2010 +0000
@@ -15,7 +15,8 @@
     client,
     allClients,
     withRoomsAndClients,
-    showRooms
+    showRooms,
+    roomClients
     ) where
 
 
@@ -38,12 +39,10 @@
 newtype RoomIndex = RoomIndex ElemIndex
     deriving (Eq)
 newtype ClientIndex = ClientIndex ElemIndex
-    deriving (Eq)
+    deriving (Eq, Show, Read)
 
 instance Show RoomIndex where
     show (RoomIndex i) = 'r' : show i
-instance Show ClientIndex where
-    show (ClientIndex i) = 'c' : show i
 
 unRoomIndex :: RoomIndex -> ElemIndex
 unRoomIndex (RoomIndex r) = r
@@ -76,7 +75,7 @@
 roomRemoveClient :: ClientIndex -> Room r -> Room r
 roomRemoveClient cl room = room{roomClients' = filter (/= cl) $ roomClients' room}
 
-    
+
 addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex
 addRoom (MRoomsAndClients (rooms, _)) room = do
     i <- addElem rooms (Room  [] room)
@@ -149,8 +148,11 @@
 allClients (IRoomsAndClients (_, clients)) = map ClientIndex $ indices clients
 
 
-clientRoom :: ClientIndex -> IRoomsAndClients r c -> RoomIndex
-clientRoom (ClientIndex ci) (IRoomsAndClients (_, clients)) = clientRoom' (clients ! ci)
+clientRoom :: IRoomsAndClients r c -> ClientIndex -> RoomIndex
+clientRoom (IRoomsAndClients (_, clients)) (ClientIndex ci) = clientRoom' (clients ! ci)
 
 client :: IRoomsAndClients r c -> ClientIndex -> c
 client (IRoomsAndClients (_, clients)) (ClientIndex ci) = client' (clients ! ci)
+
+roomClients :: IRoomsAndClients r c -> RoomIndex -> [ClientIndex]
+roomClients (IRoomsAndClients (rooms, _)) (RoomIndex ri) = roomClients' $ (rooms ! ri)
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/ServerCore.hs	Thu May 06 17:39:08 2010 +0000
@@ -6,58 +6,61 @@
 import Control.Monad
 import qualified Data.IntMap as IntMap
 import System.Log.Logger
+import Control.Monad.Reader
 --------------------------------------
 import CoreTypes
 import NetRoutines
 import HWProtoCore
 import Actions
 import OfficialServer.DBInteraction
+import RoomsAndClients
 
 
 timerLoop :: Int -> Chan CoreMessage -> IO()
 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
-firstAway (_, a, b, c) = (a, b, c)
 
-reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
-reactCmd serverInfo clID cmd clients rooms =
-    liftM firstAway $ foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd
+reactCmd :: ServerInfo -> ClientIndex -> [String] -> MRnC -> IO ()
+reactCmd sInfo ci cmd rnc = do
+    actions <- withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
+    forM_ actions (processAction (ci, sInfo, rnc))
 
-mainLoop :: ServerInfo -> Clients -> Rooms -> IO ()
-mainLoop serverInfo clients rooms = do
+mainLoop :: ServerInfo -> MRnC -> IO ()
+mainLoop serverInfo rnc = forever $ do
     r <- readChan $ coreChan serverInfo
 
-    (newServerInfo, mClients, mRooms) <-
-        case r of
-            Accept ci ->
-                liftM firstAway $ processAction
-                    (clientUID ci, serverInfo, clients, rooms) (AddClient ci)
+    case r of
+        Accept ci -> do
+            processAction
+                (undefined, serverInfo, rnc) (AddClient ci)
+            return ()
 
-            ClientMessage (clID, cmd) -> do
-                debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
-                if clID `IntMap.member` clients then
-                    reactCmd serverInfo clID cmd clients rooms
-                    else
-                    do
-                    debugM "Clients" "Message from dead client"
-                    return (serverInfo, clients, rooms)
+        ClientMessage (clID, cmd) -> do
+            debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
+            --if clID `IntMap.member` clients then
+            reactCmd serverInfo clID cmd rnc
+            return ()
+                --else
+                --do
+                --debugM "Clients" "Message from dead client"
+                --return (serverInfo, rnc)
 
-            ClientAccountInfo (clID, info) ->
-                if clID `IntMap.member` clients then
-                    liftM firstAway $ processAction
-                        (clID, serverInfo, clients, rooms)
-                        (ProcessAccountInfo info)
-                    else
-                    do
-                    debugM "Clients" "Got info for dead client"
-                    return (serverInfo, clients, rooms)
+        ClientAccountInfo (clID, info) -> do
+            --if clID `IntMap.member` clients then
+            processAction
+                (clID, serverInfo, rnc)
+                (ProcessAccountInfo info)
+            return ()
+                --else
+                --do
+                --debugM "Clients" "Got info for dead client"
+                --return (serverInfo, rnc)
 
-            TimerAction tick ->
-                liftM firstAway $
-                    foldM processAction (0, serverInfo, clients, rooms) $
-                        PingAll : [StatsAction | even tick]
-
-    mainLoop newServerInfo mClients mRooms
+        TimerAction tick ->
+            return ()
+            --liftM snd $
+            --    foldM processAction (0, serverInfo, rnc) $
+            --        PingAll : [StatsAction | even tick]
 
 startServer :: ServerInfo -> Socket -> IO ()
 startServer serverInfo serverSocket = do
@@ -67,14 +70,15 @@
         acceptLoop
             serverSocket
             (coreChan serverInfo)
-            0
 
     return ()
-    
+
     forkIO $ timerLoop 0 $ coreChan serverInfo
 
     startDBConnection serverInfo
 
-    forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
+    rnc <- newRoomsAndClients newRoom
+
+    forkIO $ mainLoop serverInfo rnc
 
     forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/Store.hs
--- a/gameServer/Store.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/Store.hs	Thu May 06 17:39:08 2010 +0000
@@ -23,12 +23,10 @@
 
 
 newtype ElemIndex = ElemIndex Int
-    deriving (Eq)
+    deriving (Eq, Show, Read)
 newtype MStore e = MStore (IORef (IntSet.IntSet, IntSet.IntSet, IOA.IOArray Int e))
 newtype IStore e = IStore (IntSet.IntSet, IA.Array Int e)
 
-instance Show ElemIndex where
-    show (ElemIndex i) = 'i' : show i
 
 firstIndex :: ElemIndex
 firstIndex = ElemIndex 0
diff -r 6af73e7f2438 -r 4e4f88a7bdf2 gameServer/hedgewars-server.hs
--- a/gameServer/hedgewars-server.hs	Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/hedgewars-server.hs	Thu May 06 17:39:08 2010 +0000
@@ -22,10 +22,12 @@
 #endif
 
 
+setupLoggers :: IO ()
 setupLoggers =
     updateGlobalLogger "Clients"
         (setLevel DEBUG)
 
+main :: IO ()
 main = withSocketsDo $ do
 #if !defined(mingw32_HOST_OS)
     installHandler sigPIPE Ignore Nothing;
@@ -38,7 +40,7 @@
     dbQueriesChan <- newChan
     coreChan' <- newChan
     serverInfo' <- getOpts $ newServerInfo stats' coreChan' dbQueriesChan
-    
+
 #if defined(OFFICIAL_SERVER)
     dbHost' <- askFromConsole "DB host: "
     dbLogin' <- askFromConsole "login: "