--- a/gameServer/Actions.hs	Tue May 04 21:30:25 2010 +0000
+++ b/gameServer/Actions.hs	Wed May 05 08:01:37 2010 +0000
@@ -1,26 +1,23 @@
 module Actions where
 
+import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Concurrent.Chan
-import Data.IntMap
 import qualified Data.IntSet as IntSet
 import qualified Data.Sequence as Seq
 import System.Log.Logger
 import Monad
 import Data.Time
 import Maybe
+
 -----------------------------
 import CoreTypes
 import Utils
+import ClientIO
+import RoomsAndClients
 
 data Action =
-    AnswerThisClient [String]
-    | AnswerAll [String]
-    | AnswerAllOthers [String]
-    | AnswerThisRoom [String]
-    | AnswerOthersInRoom [String]
-    | AnswerSameClan [String]
-    | AnswerLobby [String]
+    AnswerClients [Chan [String]] [String]
     | SendServerMessage
     | SendServerVars
     | RoomAddThisClient Int -- roomID
@@ -49,74 +46,22 @@
     | PingAll
     | StatsAction
 
-type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action]
+type CmdHandler = Int -> MRnC -> [String] -> [Action]
 
 replaceID a (b, c, d, e) = (a, c, d, e)
 
-processAction :: (Int, ServerInfo, Clients, Rooms) -> Action -> IO (Int, ServerInfo, Clients, Rooms)
-
-
-processAction (clID, serverInfo, clients, rooms) (AnswerThisClient msg) = do
-    writeChan (sendChan $ clients ! clID) msg
-    return (clID, serverInfo, clients, rooms)
-
-
-processAction (clID, serverInfo, clients, rooms) (AnswerAll msg) = do
-    mapM_ (\cl -> writeChan (sendChan cl) msg) (elems clients)
-    return (clID, serverInfo, clients, rooms)
-
-
-processAction (clID, serverInfo, clients, rooms) (AnswerAllOthers msg) = do
-    mapM_ (\id' -> writeChan (sendChan $ clients ! id') msg) $
-        Prelude.filter (\id' -> (id' /= clID) && logonPassed (clients ! id')) (keys clients)
-    return (clID, serverInfo, clients, rooms)
-
-
-processAction (clID, serverInfo, clients, rooms) (AnswerThisRoom msg) = do
-    mapM_ (\id' -> writeChan (sendChan $ clients ! id') msg) roomClients
-    return (clID, serverInfo, clients, rooms)
-    where
-        roomClients = IntSet.elems $ playersIDs room
-        room = rooms ! rID
-        rID = roomID client
-        client = clients ! clID
+processAction :: (ClientIndex, ServerInfo, MRnC) -> Action -> IO (ClientIndex, ServerInfo)
 
 
-processAction (clID, serverInfo, clients, rooms) (AnswerOthersInRoom msg) = do
-    mapM_ (\id' -> writeChan (sendChan $ clients ! id') msg) $ Prelude.filter (/= clID) roomClients
-    return (clID, serverInfo, clients, rooms)
-    where
-        roomClients = IntSet.elems $ playersIDs room
-        room = rooms ! rID
-        rID = roomID client
-        client = clients ! clID
-
-
-processAction (clID, serverInfo, clients, rooms) (AnswerLobby msg) = do
-    mapM_ (\id' -> writeChan (sendChan $ clients ! id') msg) roomClients
-    return (clID, serverInfo, clients, rooms)
-    where
-        roomClients = IntSet.elems $ playersIDs room
-        room = rooms ! 0
+processAction (ci, serverInfo, rnc) (AnswerClients chans msg) = do
+    mapM_ (flip writeChan msg) chans
+    return (ci, serverInfo)
 
 
-processAction (clID, serverInfo, clients, rooms) (AnswerSameClan msg) = do
-    mapM_ (\cl -> writeChan (sendChan cl) msg) sameClanOrSpec
-    return (clID, serverInfo, clients, rooms)
-    where
-        otherRoomClients = Prelude.map ((!) clients) $ IntSet.elems $ clID `IntSet.delete` (playersIDs room)
-        sameClanOrSpec = if teamsInGame client > 0 then sameClanClients else spectators
-        spectators = Prelude.filter (\cl -> teamsInGame cl == 0) otherRoomClients
-        sameClanClients = Prelude.filter (\cl -> teamsInGame cl > 0 && clientClan cl == thisClan) otherRoomClients
-        thisClan = clientClan client
-        room = rooms ! rID
-        rID = roomID client
-        client = clients ! clID
-
-
-processAction (clID, serverInfo, clients, rooms) SendServerMessage = do
+{-
+processAction (clID, serverInfo, rnc) SendServerMessage = do
     writeChan (sendChan $ clients ! clID) ["SERVER_MESSAGE", message serverInfo]
-    return (clID, serverInfo, clients, rooms)
+    return (clID, serverInfo, rnc)
     where
         client = clients ! clID
         message si = if clientProto client < latestReleaseVersion si then
@@ -124,35 +69,35 @@
             else
             serverMessage si
 
-processAction (clID, serverInfo, clients, rooms) SendServerVars = do
+processAction (clID, serverInfo, rnc) SendServerVars = do
     writeChan (sendChan $ clients ! clID) ("SERVER_VARS" : vars)
-    return (clID, serverInfo, clients, rooms)
+    return (clID, serverInfo, rnc)
     where
         client = clients ! clID
         vars = [
-            "MOTD_NEW", serverMessage serverInfo, 
-            "MOTD_OLD", serverMessageForOldVersions serverInfo, 
+            "MOTD_NEW", serverMessage serverInfo,
+            "MOTD_OLD", serverMessageForOldVersions serverInfo,
             "LATEST_PROTO", show $ latestReleaseVersion serverInfo
             ]
 
 
-processAction (clID, serverInfo, clients, rooms) (ProtocolError msg) = do
+processAction (clID, serverInfo, rnc) (ProtocolError msg) = do
     writeChan (sendChan $ clients ! clID) ["ERROR", msg]
-    return (clID, serverInfo, clients, rooms)
+    return (clID, serverInfo, rnc)
 
 
-processAction (clID, serverInfo, clients, rooms) (Warning msg) = do
+processAction (clID, serverInfo, rnc) (Warning msg) = do
     writeChan (sendChan $ clients ! clID) ["WARNING", msg]
-    return (clID, serverInfo, clients, rooms)
+    return (clID, serverInfo, rnc)
 
 
-processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do
+processAction (clID, serverInfo, rnc) (ByeClient msg) = do
     infoM "Clients" (show (clientUID client) ++ " quits: " ++ msg)
     (_, _, newClients, newRooms) <-
             if roomID client /= 0 then
-                processAction  (clID, serverInfo, clients, rooms) $ RoomRemoveThisClient "quit"
+                processAction  (clID, serverInfo, rnc) $ RoomRemoveThisClient "quit"
                 else
-                    return (clID, serverInfo, clients, rooms)
+                    return (clID, serverInfo, rnc)
 
     mapM_ (processAction (clID, serverInfo, newClients, newRooms)) $ answerOthersQuit ++ answerInformRoom
     writeChan (sendChan $ clients ! clID) ["BYE", msg]
@@ -187,25 +132,25 @@
                 []
 
 
-processAction (clID, serverInfo, clients, rooms) (ModifyClient func) =
-    return (clID, serverInfo, adjust func clID clients, rooms)
+processAction (clID, serverInfo, rnc) (ModifyClient func) =
+    return (clID, serverInfo, adjust func clID rnc)
 
 
-processAction (clID, serverInfo, clients, rooms) (ModifyClient2 cl2ID func) =
-    return (clID, serverInfo, adjust func cl2ID clients, rooms)
+processAction (clID, serverInfo, rnc) (ModifyClient2 cl2ID func) =
+    return (clID, serverInfo, adjust func cl2ID rnc)
 
 
-processAction (clID, serverInfo, clients, rooms) (ModifyRoom func) =
+processAction (clID, serverInfo, rnc) (ModifyRoom func) =
     return (clID, serverInfo, clients, adjust func rID rooms)
     where
         rID = roomID $ clients ! clID
 
 
-processAction (clID, serverInfo, clients, rooms) (ModifyServerInfo func) =
-    return (clID, func serverInfo, clients, rooms)
+processAction (clID, serverInfo, rnc) (ModifyServerInfo func) =
+    return (clID, func serverInfo, rnc)
 
 
-processAction (clID, serverInfo, clients, rooms) (RoomAddThisClient rID) =
+processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) =
     processAction (
         clID,
         serverInfo,
@@ -221,7 +166,7 @@
                 AnswerThisRoom ["JOINED", nick client]
 
 
-processAction (clID, serverInfo, clients, rooms) (RoomRemoveThisClient msg) = do
+processAction (clID, serverInfo, rnc) (RoomRemoveThisClient msg) = do
     (_, _, newClients, newRooms) <-
         if roomID client /= 0 then
             if isMaster client then
@@ -231,16 +176,16 @@
                         AnswerOthersInRoom ["WARNING", "Admin left the room"],
                         RemoveClientTeams clID]))
                 else -- not in game
-                    processAction (clID, serverInfo, clients, rooms) RemoveRoom
+                    processAction (clID, serverInfo, rnc) RemoveRoom
             else -- not master
                 foldM
                     processAction
-                        (clID, serverInfo, clients, rooms)
+                        (clID, serverInfo, rnc)
                         [AnswerOthersInRoom ["LEFT", nick client, msg],
                         RemoveClientTeams clID]
         else -- in lobby
-            return (clID, serverInfo, clients, rooms)
-    
+            return (clID, serverInfo, rnc)
+
     return (
         clID,
         serverInfo,
@@ -259,7 +204,7 @@
                 }
         insertClientToRoom r = r{playersIDs = IntSet.insert clID (playersIDs r)}
         changeMaster = do
-            processAction (newMasterId, serverInfo, clients, rooms) $ AnswerThisClient ["ROOM_CONTROL_ACCESS", "1"]
+            processAction (newMasterId, serverInfo, rnc) $ AnswerThisClient ["ROOM_CONTROL_ACCESS", "1"]
             return (
                 clID,
                 serverInfo,
@@ -272,7 +217,7 @@
         newMasterClient = clients ! newMasterId
 
 
-processAction (clID, serverInfo, clients, rooms) (AddRoom roomName roomPassword) = do
+processAction (clID, serverInfo, rnc) (AddRoom roomName roomPassword) = do
     let newServerInfo = serverInfo {nextRoomID = newID}
     let room = newRoom{
             roomUID = newID,
@@ -282,7 +227,7 @@
             roomProto = (clientProto client)
             }
 
-    processAction (clID, serverInfo, clients, rooms) $ AnswerLobby ["ROOM", "ADD", roomName]
+    processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "ADD", roomName]
 
     processAction (
         clID,
@@ -295,9 +240,9 @@
         client = clients ! clID
 
 
-processAction (clID, serverInfo, clients, rooms) (RemoveRoom) = do
-    processAction (clID, serverInfo, clients, rooms) $ AnswerLobby ["ROOM", "DEL", name room]
-    processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["ROOMABANDONED", name room]
+processAction (clID, serverInfo, rnc) (RemoveRoom) = do
+    processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "DEL", name room]
+    processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["ROOMABANDONED", name room]
     return (clID,
         serverInfo,
         Data.IntMap.map (\cl -> if roomID cl == rID then cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined} else cl) clients,
@@ -309,8 +254,8 @@
         client = clients ! clID
 
 
-processAction (clID, serverInfo, clients, rooms) (UnreadyRoomClients) = do
-    processAction (clID, serverInfo, clients, rooms) $ AnswerThisRoom ("NOT_READY" : roomPlayers)
+processAction (clID, serverInfo, rnc) (UnreadyRoomClients) = do
+    processAction (clID, serverInfo, rnc) $ AnswerThisRoom ("NOT_READY" : roomPlayers)
     return (clID,
         serverInfo,
         Data.IntMap.map (\cl -> if roomID cl == rID then cl{isReady = False} else cl) clients,
@@ -323,15 +268,15 @@
         roomPlayersIDs = IntSet.elems $ playersIDs room
 
 
-processAction (clID, serverInfo, clients, rooms) (RemoveTeam teamName) = do
+processAction (clID, serverInfo, rnc) (RemoveTeam teamName) = do
     newRooms <- if not $ gameinprogress room then
             do
-            processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["REMOVE_TEAM", teamName]
+            processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["REMOVE_TEAM", teamName]
             return $
                 adjust (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) rID rooms
         else
             do
-            processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["EM", rmTeamMsg]
+            processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["EM", rmTeamMsg]
             return $
                 adjust (\r -> r{
                 teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
@@ -346,41 +291,41 @@
         rmTeamMsg = toEngineMsg $ 'F' : teamName
 
 
-processAction (clID, serverInfo, clients, rooms) (CheckRegistered) = do
+processAction (clID, serverInfo, rnc) (CheckRegistered) = do
     writeChan (dbQueries serverInfo) $ CheckAccount (clientUID client) (nick client) (host client)
-    return (clID, serverInfo, clients, rooms)
+    return (clID, serverInfo, rnc)
     where
         client = clients ! clID
 
 
-processAction (clID, serverInfo, clients, rooms) (ClearAccountsCache) = do
+processAction (clID, serverInfo, rnc) (ClearAccountsCache) = do
     writeChan (dbQueries serverInfo) ClearCache
-    return (clID, serverInfo, clients, rooms)
+    return (clID, serverInfo, rnc)
     where
         client = clients ! clID
 
 
-processAction (clID, serverInfo, clients, rooms) (Dump) = do
+processAction (clID, serverInfo, rnc) (Dump) = do
     writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms]
-    return (clID, serverInfo, clients, rooms)
+    return (clID, serverInfo, rnc)
 
 
-processAction (clID, serverInfo, clients, rooms) (ProcessAccountInfo info) =
+processAction (clID, serverInfo, rnc) (ProcessAccountInfo info) =
     case info of
         HasAccount passwd isAdmin -> do
             infoM "Clients" $ show clID ++ " has account"
             writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"]
-            return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd, isAdministrator = isAdmin}) clID clients, rooms)
+            return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd, isAdministrator = isAdmin}) clID rnc)
         Guest -> do
             infoM "Clients" $ show clID ++ " is guest"
-            processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True}) clID clients, rooms) MoveToLobby
+            processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True}) clID rnc) MoveToLobby
         Admin -> do
             infoM "Clients" $ show clID ++ " is admin"
-            foldM processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True, isAdministrator = True}) clID clients, rooms) [MoveToLobby, AnswerThisClient ["ADMIN_ACCESS"]]
+            foldM processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True, isAdministrator = True}) clID rnc) [MoveToLobby, AnswerThisClient ["ADMIN_ACCESS"]]
 
 
-processAction (clID, serverInfo, clients, rooms) (MoveToLobby) =
-    foldM processAction (clID, serverInfo, clients, rooms) $
+processAction (clID, serverInfo, rnc) (MoveToLobby) =
+    foldM processAction (clID, serverInfo, rnc) $
         (RoomAddThisClient 0)
         : answerLobbyNicks
         ++ [SendServerMessage]
@@ -391,22 +336,22 @@
         answerLobbyNicks = [AnswerThisClient ("LOBBY:JOINED": lobbyNicks) | not $ Prelude.null lobbyNicks]
 
 
-processAction (clID, serverInfo, clients, rooms) (KickClient kickID) =
-    liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked")
+processAction (clID, serverInfo, rnc) (KickClient kickID) =
+    liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked")
 
 
-processAction (clID, serverInfo, clients, rooms) (BanClient banNick) =
-    return (clID, serverInfo, clients, rooms)
+processAction (clID, serverInfo, rnc) (BanClient banNick) =
+    return (clID, serverInfo, rnc)
 
 
-processAction (clID, serverInfo, clients, rooms) (KickRoomClient kickID) = do
+processAction (clID, serverInfo, rnc) (KickRoomClient kickID) = do
     writeChan (sendChan $ clients ! kickID) ["KICKED"]
-    liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ RoomRemoveThisClient "kicked")
+    liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ RoomRemoveThisClient "kicked")
 
 
-processAction (clID, serverInfo, clients, rooms) (RemoveClientTeams teamsClID) =
+processAction (clID, serverInfo, rnc) (RemoveClientTeams teamsClID) =
     liftM2 replaceID (return clID) $
-        foldM processAction (teamsClID, serverInfo, clients, rooms) removeTeamsActions
+        foldM processAction (teamsClID, serverInfo, rnc) removeTeamsActions
     where
         client = clients ! teamsClID
         room = rooms ! (roomID client)
@@ -414,33 +359,38 @@
         removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove
 
 
-processAction (clID, serverInfo, clients, rooms) (AddClient client) = do
+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)
+
     let updatedClients = insert (clientUID client) client clients
     infoM "Clients" (show (clientUID client) ++ ": 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 isJust $ host client `Prelude.lookup` newLogins then
+    if False && (isJust $ host client `Prelude.lookup` newLogins) then
         processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast"
         else
         return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms)
 
 
-processAction (clID, serverInfo, clients, rooms) PingAll = do
-    (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, clients, rooms) $ elems clients
+processAction (clID, serverInfo, rnc) PingAll = do
+    (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, rnc) $ elems clients
     processAction (clID,
         serverInfo,
         Data.IntMap.map (\cl -> cl{pingsQueue = pingsQueue cl + 1}) newClients,
         newRooms) $ AnswerAll ["PING"]
     where
-        kickTimeouted (clID, serverInfo, clients, rooms) client =
+        kickTimeouted (clID, serverInfo, rnc) client =
             if pingsQueue client > 0 then
-                processAction (clientUID client, serverInfo, clients, rooms) $ ByeClient "Ping timeout"
+                processAction (clientUID client, serverInfo, rnc) $ ByeClient "Ping timeout"
                 else
-                return (clID, serverInfo, clients, rooms)
+                return (clID, serverInfo, rnc)
 
 
-processAction (clID, serverInfo, clients, rooms) (StatsAction) = do
+processAction (clID, serverInfo, rnc) (StatsAction) = do
     writeChan (dbQueries serverInfo) $ SendStats (size clients) (size rooms - 1)
-    return (clID, serverInfo, clients, rooms)
+    return (clID, serverInfo, rnc)
+
+-}
\ No newline at end of file

--- a/gameServer/CoreTypes.hs	Tue May 04 21:30:25 2010 +0000
+++ b/gameServer/CoreTypes.hs	Wed May 05 08:01:37 2010 +0000
@@ -12,6 +12,7 @@
 import Network
 import Data.Function
 
+import RoomsAndClients
 
 data ClientInfo =
     ClientInfo
@@ -177,12 +178,12 @@
     | ClientAccountInfo (Int, AccountInfo)
     | TimerAction Int
 
-type Clients = IntMap.IntMap ClientInfo
-type Rooms = IntMap.IntMap RoomInfo
+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]
+--type ClientsSelector = Clients -> Rooms -> [Int]

--- a/gameServer/HWProtoLobbyState.hs	Tue May 04 21:30:25 2010 +0000
+++ b/gameServer/HWProtoLobbyState.hs	Wed May 05 08:01:37 2010 +0000
@@ -100,7 +100,7 @@
             roomClientsIDs
 
         toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
-        
+
         answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
         (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
 
@@ -118,7 +118,7 @@
 
 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName] =
     handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""]
-    
+
 
 handleCmd_lobby clID clients rooms ["FOLLOW", asknick] =
     if noSuchClient || roomID followClient == 0 then

--- a/gameServer/NetRoutines.hs	Tue May 04 21:30:25 2010 +0000
+++ b/gameServer/NetRoutines.hs	Wed May 05 08:01:37 2010 +0000
@@ -26,7 +26,7 @@
         clientHost <- sockAddr2String sockAddr
 
         currentTime <- getCurrentTime
-        
+
         sendChan <- newChan
 
         let newClient =
@@ -50,9 +50,6 @@
                     )
 
         writeChan coreChan $ Accept newClient
-
-        forkIO $ clientRecvLoop cHandle coreChan nextID
-        forkIO $ clientSendLoop cHandle coreChan sendChan nextID
         return ()
 
     acceptLoop servSock coreChan nextID

--- a/gameServer/OfficialServer/DBInteraction.hs	Tue May 04 21:30:25 2010 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs	Wed May 05 08:01:37 2010 +0000
@@ -21,7 +21,7 @@
 
 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"]
 
-fakeDbConnection serverInfo = do
+fakeDbConnection serverInfo = forever $ do
     q <- readChan $ dbQueries serverInfo
     case q of
         CheckAccount clUid _ clHost -> do
@@ -30,8 +30,6 @@
         ClearCache -> return ()
         SendStats {} -> return ()
 
-    fakeDbConnection serverInfo
-
 
 #if defined(OFFICIAL_SERVER)
 pipeDbConnectionLoop queries coreChan hIn hOut accountsCache =

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/RoomsAndClients.hs	Wed May 05 08:01:37 2010 +0000
@@ -0,0 +1,156 @@
+module RoomsAndClients(
+    RoomIndex(),
+    ClientIndex(),
+    MRoomsAndClients(),
+    IRoomsAndClients(),
+    newRoomsAndClients,
+    addRoom,
+    addClient,
+    removeRoom,
+    removeClient,
+    lobbyId,
+    moveClientToLobby,
+    moveClientToRoom,
+    clientRoom,
+    client,
+    allClients,
+    withRoomsAndClients,
+    showRooms
+    ) where
+
+
+import Store
+import Control.Monad
+
+
+data Room r = Room {
+    roomClients' :: [ClientIndex],
+    room' :: r
+    }
+
+
+data Client c = Client {
+    clientRoom' :: RoomIndex,
+    client' :: c
+    }
+
+
+newtype RoomIndex = RoomIndex ElemIndex
+    deriving (Eq)
+newtype ClientIndex = ClientIndex ElemIndex
+    deriving (Eq)
+
+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
+
+unClientIndex :: ClientIndex -> ElemIndex
+unClientIndex (ClientIndex c) = c
+
+
+newtype MRoomsAndClients r c = MRoomsAndClients (MStore (Room r), MStore (Client c))
+newtype IRoomsAndClients r c = IRoomsAndClients (IStore (Room r), IStore (Client c))
+
+
+lobbyId :: RoomIndex
+lobbyId = RoomIndex firstIndex
+
+
+newRoomsAndClients :: r -> IO (MRoomsAndClients r c)
+newRoomsAndClients r = do
+    rooms <- newStore
+    clients <- newStore
+    let rnc = MRoomsAndClients (rooms, clients)
+    ri <- addRoom rnc r
+    when (ri /= lobbyId) $ error "Empty struct inserts not at firstIndex index"
+    return rnc
+
+
+roomAddClient :: ClientIndex -> Room r -> Room r
+roomAddClient cl room = room{roomClients' = cl : roomClients' room}
+
+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)
+    return $ RoomIndex i
+
+
+addClient :: MRoomsAndClients r c -> c -> IO ClientIndex
+addClient (MRoomsAndClients (rooms, clients)) client = do
+    i <- addElem clients (Client lobbyId client)
+    modifyElem rooms (roomAddClient (ClientIndex i)) rid
+    return $ ClientIndex i
+    where
+        rid = (\(RoomIndex i) -> i) lobbyId
+
+removeRoom :: MRoomsAndClients r c -> RoomIndex -> IO ()
+removeRoom rnc@(MRoomsAndClients (rooms, _)) room@(RoomIndex ri) 
+    | room == lobbyId = error "Cannot delete lobby"
+    | otherwise = do
+        clIds <- liftM roomClients' $ readElem rooms ri
+        forM_ clIds (moveClientToLobby rnc)
+        removeElem rooms ri
+
+
+removeClient :: MRoomsAndClients r c -> ClientIndex -> IO ()
+removeClient (MRoomsAndClients (rooms, clients)) cl@(ClientIndex ci) = do
+    RoomIndex ri <- liftM clientRoom' $ readElem clients ci
+    modifyElem rooms (roomRemoveClient cl) ri
+    removeElem clients ci
+
+
+moveClientInRooms :: MRoomsAndClients r c -> RoomIndex -> RoomIndex -> ClientIndex -> IO ()
+moveClientInRooms (MRoomsAndClients (rooms, clients)) (RoomIndex riFrom) rt@(RoomIndex riTo) cl@(ClientIndex ci) = do
+    modifyElem rooms (roomRemoveClient cl) riFrom
+    modifyElem rooms (roomAddClient cl) riTo
+    modifyElem clients (\c -> c{clientRoom' = rt}) ci
+
+
+moveClientToLobby :: MRoomsAndClients r c -> ClientIndex -> IO ()
+moveClientToLobby rnc ci = do
+    room <- clientRoomM rnc ci
+    moveClientInRooms rnc room lobbyId ci
+
+
+moveClientToRoom :: MRoomsAndClients r c -> RoomIndex -> ClientIndex -> IO ()
+moveClientToRoom rnc ri ci = moveClientInRooms rnc lobbyId ri ci
+
+
+clientRoomM :: MRoomsAndClients r c -> ClientIndex -> IO RoomIndex
+clientRoomM (MRoomsAndClients (_, clients)) (ClientIndex ci) = liftM clientRoom' (clients `readElem` ci)
+
+
+withRoomsAndClients :: MRoomsAndClients r c -> (IRoomsAndClients r c -> a) -> IO a
+withRoomsAndClients (MRoomsAndClients (rooms, clients)) f =
+    withIStore2 rooms clients (\r c -> f $ IRoomsAndClients (r, c))
+
+----------------------------------------
+----------- IRoomsAndClients -----------
+
+showRooms :: (Show r, Show c) => IRoomsAndClients r c -> String
+showRooms rnc@(IRoomsAndClients (rooms, clients)) = concatMap showRoom (allRooms rnc)
+    where
+    showRoom r = unlines $ ((show r) ++ ": " ++ (show $ room' $ rooms ! (unRoomIndex r))) : (map showClient (roomClients' $ rooms ! (unRoomIndex r)))
+    showClient c = "    " ++ (show c) ++ ": " ++ (show $ client' $ clients ! (unClientIndex c))
+
+
+allRooms :: IRoomsAndClients r c -> [RoomIndex]
+allRooms (IRoomsAndClients (rooms, _)) = map RoomIndex $ indices rooms
+
+allClients :: IRoomsAndClients r c -> [ClientIndex]
+allClients (IRoomsAndClients (_, clients)) = map ClientIndex $ indices clients
+
+
+clientRoom :: ClientIndex -> IRoomsAndClients r c -> RoomIndex
+clientRoom (ClientIndex ci) (IRoomsAndClients (_, clients)) = clientRoom' (clients ! ci)
+
+client :: IRoomsAndClients r c -> ClientIndex -> c
+client (IRoomsAndClients (_, clients)) (ClientIndex ci) = client' (clients ! ci)

--- a/gameServer/ServerCore.hs	Tue May 04 21:30:25 2010 +0000
+++ b/gameServer/ServerCore.hs	Wed May 05 08:01:37 2010 +0000
@@ -2,7 +2,6 @@
 
 import Network
 import Control.Concurrent
-import Control.Concurrent.STM
 import Control.Concurrent.Chan
 import Control.Monad
 import qualified Data.IntMap as IntMap
@@ -10,7 +9,6 @@
 --------------------------------------
 import CoreTypes
 import NetRoutines
-import Utils
 import HWProtoCore
 import Actions
 import OfficialServer.DBInteraction
@@ -28,7 +26,7 @@
 mainLoop :: ServerInfo -> Clients -> Rooms -> IO ()
 mainLoop serverInfo clients rooms = do
     r <- readChan $ coreChan serverInfo
-    
+
     (newServerInfo, mClients, mRooms) <-
         case r of
             Accept ci ->
@@ -59,11 +57,6 @@
                     foldM processAction (0, serverInfo, clients, rooms) $
                         PingAll : [StatsAction | even tick]
 
-
-    {-          let hadRooms = (not $ null rooms) && (null mrooms)
-                    in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $
-                        mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -}
-
     mainLoop newServerInfo mClients mRooms
 
 startServer :: ServerInfo -> Socket -> IO ()
@@ -84,4 +77,4 @@
 
     forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
 
-    forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"
\ No newline at end of file
+    forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/Store.hs	Wed May 05 08:01:37 2010 +0000
@@ -0,0 +1,122 @@
+module Store(
+    ElemIndex(),
+    MStore(),
+    IStore(),
+    newStore,
+    addElem,
+    removeElem,
+    readElem,
+    writeElem,
+    modifyElem,
+    firstIndex,
+    withIStore,
+    withIStore2,
+    (!),
+    indices
+    ) where
+
+import qualified Data.Array.IArray as IA
+import qualified Data.Array.IO as IOA
+import qualified Data.IntSet as IntSet
+import Data.IORef
+import Control.Monad
+
+
+newtype ElemIndex = ElemIndex Int
+    deriving (Eq)
+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
+
+-- MStore code
+initialSize :: Int
+initialSize = 10
+
+
+growFunc :: Int -> Int
+growFunc a = a * 3 `div` 2
+
+
+newStore :: IO (MStore e)
+newStore = do
+    newar <- IOA.newArray_ (0, initialSize - 1)
+    new <- newIORef (IntSet.empty, IntSet.fromAscList [0..initialSize - 1], newar)
+    return (MStore new)
+
+
+growStore :: MStore e -> IO ()
+growStore (MStore ref) = do
+    (busyElems, freeElems, arr) <- readIORef ref
+    (_, m') <- IOA.getBounds arr
+    let newM' = growFunc (m' + 1) - 1
+    newArr <- IOA.newArray_ (0, newM')
+    sequence_ [IOA.readArray arr i >>= IOA.writeArray newArr i | i <- [0..m']]
+    writeIORef ref (busyElems, freeElems `IntSet.union` (IntSet.fromAscList [m'+1..newM']), newArr)
+
+
+growIfNeeded :: MStore e -> IO ()
+growIfNeeded m@(MStore ref) = do
+    (_, freeElems, _) <- readIORef ref
+    when (IntSet.null freeElems) $ growStore m
+
+
+addElem :: MStore e -> e -> IO ElemIndex
+addElem m@(MStore ref) element = do
+    growIfNeeded m
+    (busyElems, freeElems, arr) <- readIORef ref
+    let (n, freeElems') = IntSet.deleteFindMin freeElems
+    IOA.writeArray arr n element
+    writeIORef ref (IntSet.insert n busyElems, freeElems', arr)
+    return $ ElemIndex n
+
+
+removeElem :: MStore e -> ElemIndex -> IO ()
+removeElem (MStore ref) (ElemIndex n) = do
+    (busyElems, freeElems, arr) <- readIORef ref
+    IOA.writeArray arr n undefined
+    writeIORef ref (IntSet.delete n busyElems, IntSet.insert n freeElems, arr)
+
+
+readElem :: MStore e -> ElemIndex -> IO e
+readElem (MStore ref) (ElemIndex n) = readIORef ref >>= \(_, _, arr) -> IOA.readArray arr n
+
+
+writeElem :: MStore e -> ElemIndex -> e -> IO ()
+writeElem (MStore ref) (ElemIndex n) el = readIORef ref >>= \(_, _, arr) -> IOA.writeArray arr n el
+
+
+modifyElem :: MStore e -> (e -> e) -> ElemIndex -> IO ()
+modifyElem (MStore ref) f (ElemIndex n) = do
+    (_, _, arr) <- readIORef ref
+    IOA.readArray arr n >>= (IOA.writeArray arr n) . f
+
+
+-- A way to use see MStore elements in pure code via IStore
+m2i :: MStore e -> IO (IStore e)
+m2i (MStore ref) = do
+    (a, _, c') <- readIORef ref 
+    c <- IOA.unsafeFreeze c'
+    return $ IStore (a, c)
+
+withIStore :: MStore e -> (IStore e -> a) -> IO a
+withIStore m f = liftM f (m2i m)
+
+
+withIStore2 :: MStore e1 -> MStore e2 -> (IStore e1 -> IStore e2 -> a) -> IO a
+withIStore2 m1 m2 f = do
+    i1 <- m2i m1
+    i2 <- m2i m2
+    return $ f i1 i2
+
+
+-- IStore code
+(!) :: IStore e -> ElemIndex -> e
+(!) (IStore (_, arr)) (ElemIndex i) = (IA.!) arr i
+
+indices :: IStore e -> [ElemIndex]
+indices (IStore (busy, _)) = map ElemIndex $ IntSet.toList busy

--- a/gameServer/hedgewars-server.hs	Tue May 04 21:30:25 2010 +0000
+++ b/gameServer/hedgewars-server.hs	Wed May 05 08:01:37 2010 +0000
@@ -2,8 +2,7 @@
 
 module Main where
 
-import Network.Socket
-import qualified Network
+import Network
 import Control.Concurrent.STM
 import Control.Concurrent.Chan
 #if defined(NEW_EXCEPTIONS)
@@ -15,9 +14,7 @@
 -----------------------------------
 import Opts
 import CoreTypes
-import OfficialServer.DBInteraction
 import ServerCore
-import Utils
 
 
 #if !defined(mingw32_HOST_OS)
@@ -27,7 +24,7 @@
 
 setupLoggers =
     updateGlobalLogger "Clients"
-        (setLevel INFO)
+        (setLevel DEBUG)
 
 main = withSocketsDo $ do
 #if !defined(mingw32_HOST_OS)
@@ -37,10 +34,10 @@
 
     setupLoggers
 
-    stats <- atomically $ newTMVar (StatisticsInfo 0 0)
+    stats' <- atomically $ newTMVar (StatisticsInfo 0 0)
     dbQueriesChan <- newChan
-    coreChan <- newChan
-    serverInfo' <- getOpts $ newServerInfo stats coreChan dbQueriesChan
+    coreChan' <- newChan
+    serverInfo' <- getOpts $ newServerInfo stats' coreChan' dbQueriesChan
     
 #if defined(OFFICIAL_SERVER)
     dbHost' <- askFromConsole "DB host: "

--- a/gameServer/stresstest.hs	Tue May 04 21:30:25 2010 +0000
+++ b/gameServer/stresstest.hs	Wed May 05 08:01:37 2010 +0000
@@ -6,7 +6,7 @@
 import System.IO
 import Control.Concurrent
 import Network
-import Control.Exception
+import Control.OldException
 import Control.Monad
 import System.Random
 
@@ -14,24 +14,24 @@
 import System.Posix
 #endif
 
-session1 nick room = ["NICK", nick, "", "PROTO", "24", "", "CHAT", "lobby 1", "", "CREATE", room, "", "CHAT", "room 1", "", "QUIT", "bye-bye", ""]
-session2 nick room = ["NICK", nick, "", "PROTO", "24", "", "LIST", "", "JOIN", room, "", "CHAT", "room 2", "", "PART", "", "CHAT", "lobby after part", "", "QUIT", "bye-bye", ""]
-session3 nick room = ["NICK", nick, "", "PROTO", "24", "", "LIST", "", "JOIN", room, "", "CHAT", "room 2", "", "QUIT", "bye-bye", ""]
+session1 nick room = ["NICK", nick, "", "PROTO", "32", "", "PING", "", "CHAT", "lobby 1", "", "CREATE_ROOM", room, "", "CHAT", "room 1", "", "QUIT", "creator", ""]
+session2 nick room = ["NICK", nick, "", "PROTO", "32", "", "LIST", "", "JOIN_ROOM", room, "", "CHAT", "room 2", "", "PART", "", "CHAT", "lobby after part", "", "QUIT", "part-quit", ""]
+session3 nick room = ["NICK", nick, "", "PROTO", "32", "", "LIST", "", "JOIN_ROON", room, "", "CHAT", "room 2", "", "QUIT", "quit", ""]
 
 emulateSession sock s = do
-    mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (50000::Int, 90000) >>= threadDelay) s
+    mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (300000::Int, 590000) >>= threadDelay) s
     hFlush sock
     threadDelay 225000
 
-testing = Control.Exception.handle print $ do
+testing = Control.OldException.handle print $ do
     putStrLn "Start"
     sock <- connectTo "127.0.0.1" (PortNumber 46631)
 
     num1 <- randomRIO (70000::Int, 70100)
     num2 <- randomRIO (0::Int, 2)
     num3 <- randomRIO (0::Int, 5)
-    let nick1 = show num1
-    let room1 = show num2
+    let nick1 = 'n' : show num1
+    let room1 = 'r' : show num2
     case num2 of 
         0 -> emulateSession sock $ session1 nick1 room1
         1 -> emulateSession sock $ session2 nick1 room1
@@ -40,7 +40,7 @@
     putStrLn "Finish"
 
 forks = forever $ do
-    delay <- randomRIO (10000::Int, 19000)
+    delay <- randomRIO (300000::Int, 590000)
     threadDelay delay
     forkIO testing