# HG changeset patch
# User unc0rr
# Date 1281969812 -14400
# Node ID 73246d25dfe19d8278158c7cf61d529f7544fdb5
# Parent  97cf933e5bd2c37a62758d9316b0fb38e7dd13ea
Add some more strictness, use unsafeThaw and unsafeFreeze functions which work at O(1)

diff -r 97cf933e5bd2 -r 73246d25dfe1 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Sat Aug 14 02:10:27 2010 +0200
+++ b/gameServer/Actions.hs	Mon Aug 16 18:43:32 2010 +0400
@@ -11,7 +11,7 @@
 import Data.Time
 import Data.Maybe
 import Control.Monad.Reader
-import Control.Monad.State
+import Control.Monad.State.Strict
 import qualified Data.ByteString.Char8 as B
 -----------------------------
 import CoreTypes
@@ -57,9 +57,7 @@
 
 
 processAction (AnswerClients chans msg) = do
-    liftIO (putStr $ "AnswerClients... " ++ (show $ length chans) ++ " (" ++ (show msg) ++")")
-    liftIO $ map (flip seq ()) chans `seq` mapM_ (flip writeChan msg) chans
-    liftIO (putStrLn "done")
+    liftIO $ map (flip seq ()) chans `seq` map (flip seq ()) msg `seq` mapM_ (flip writeChan msg) chans
 
 
 processAction SendServerMessage = do
diff -r 97cf933e5bd2 -r 73246d25dfe1 gameServer/RoomsAndClients.hs
--- a/gameServer/RoomsAndClients.hs	Sat Aug 14 02:10:27 2010 +0200
+++ b/gameServer/RoomsAndClients.hs	Mon Aug 16 18:43:32 2010 +0400
@@ -15,6 +15,7 @@
     moveClientToRoom,
     clientRoom,
     clientRoomM,
+    clientExists,
     client,
     room,
     client'sM,
@@ -139,6 +140,9 @@
 moveClientToRoom rnc ri ci = moveClientInRooms rnc lobbyId ri ci
 
 
+clientExists :: MRoomsAndClients r c -> ClientIndex -> IO Bool
+clientExists (MRoomsAndClients (_, clients)) (ClientIndex ci) = elemExists clients ci
+
 clientRoomM :: MRoomsAndClients r c -> ClientIndex -> IO RoomIndex
 clientRoomM (MRoomsAndClients (_, clients)) (ClientIndex ci) = liftM clientRoom' (clients `readElem` ci)
 
diff -r 97cf933e5bd2 -r 73246d25dfe1 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Sat Aug 14 02:10:27 2010 +0200
+++ b/gameServer/ServerCore.hs	Mon Aug 16 18:43:32 2010 +0400
@@ -7,7 +7,7 @@
 import qualified Data.IntMap as IntMap
 import System.Log.Logger
 import Control.Monad.Reader
-import Control.Monad.State
+import Control.Monad.State.Strict
 import Data.Set as Set
 import qualified Data.ByteString.Char8 as B
 --------------------------------------
@@ -19,7 +19,7 @@
 import ServerState
 
 
-timerLoop :: Int -> Chan CoreMessage -> IO()
+timerLoop :: Int -> Chan CoreMessage -> IO ()
 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
@@ -57,13 +57,13 @@
                 --return (serverInfo, rnc)
 
         ClientAccountInfo (ci, info) -> do
-            --should instead check ci exists and has same nick/hostname
-            --removed <- gets removedClients
-            --when (not $ ci `Set.member` removed) $ do
-            --    modify (\as -> as{clientIndex = Just ci})
-            --    processAction (ProcessAccountInfo info)
-            return ()
-            
+            rnc <- gets roomsClients
+            exists <- liftIO $ clientExists rnc ci
+            when (exists) $ do
+                modify (\as -> as{clientIndex = Just ci})
+                processAction (ProcessAccountInfo info)
+                return ()
+
         TimerAction tick ->
                 mapM_ processAction $
                     PingAll : [StatsAction | even tick]
diff -r 97cf933e5bd2 -r 73246d25dfe1 gameServer/ServerState.hs
--- a/gameServer/ServerState.hs	Sat Aug 14 02:10:27 2010 +0200
+++ b/gameServer/ServerState.hs	Mon Aug 16 18:43:32 2010 +0400
@@ -8,7 +8,7 @@
     roomClientsS
     ) where
 
-import Control.Monad.State
+import Control.Monad.State.Strict
 import Data.Set as Set
 ----------------------
 import RoomsAndClients
diff -r 97cf933e5bd2 -r 73246d25dfe1 gameServer/Store.hs
--- a/gameServer/Store.hs	Sat Aug 14 02:10:27 2010 +0200
+++ b/gameServer/Store.hs	Mon Aug 16 18:43:32 2010 +0400
@@ -8,6 +8,7 @@
     readElem,
     writeElem,
     modifyElem,
+    elemExists,
     firstIndex,
     indicesM,
     withIStore,
@@ -94,6 +95,10 @@
     (_, _, arr) <- readIORef ref
     IOA.readArray arr n >>= (IOA.writeArray arr n) . f
 
+elemExists :: MStore e -> ElemIndex -> IO Bool
+elemExists (MStore ref) (ElemIndex n) = do
+    (_, free, _) <- readIORef ref
+    return $ n `IntSet.notMember` free
 
 indicesM :: MStore e -> IO [ElemIndex]
 indicesM (MStore ref) = do
@@ -101,23 +106,35 @@
     return $ map ElemIndex $ IntSet.toList busy
 
 
--- A way to use see MStore elements in pure code via IStore
+-- A way to see MStore elements in pure code via IStore
 m2i :: MStore e -> IO (IStore e)
 m2i (MStore ref) = do
-    (a, _, c') <- readIORef ref 
-    c <- IOA.freeze c'
+    (a, _, c') <- readIORef ref
+    c <- IOA.unsafeFreeze c'
     return $ IStore (a, c)
 
+i2m :: (MStore e) -> IStore e -> IO ()
+i2m (MStore ref) (IStore (_, arr)) = do
+    (b, e, _) <- readIORef ref
+    a <- IOA.unsafeThaw arr
+    writeIORef ref (b, e, a)
 
 withIStore :: MStore e -> (IStore e -> a) -> IO a
-withIStore m f = liftM f (m2i m)
+withIStore m f = do
+    i <- m2i m
+    let res = f i
+    res `seq` i2m m i
+    return res
 
 
 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
+    let res = f i1 i2
+    res `seq` i2m m1 i1
+    i2m m2 i2
+    return res
 
 
 -- IStore code
diff -r 97cf933e5bd2 -r 73246d25dfe1 gameServer/stresstest3.hs
--- a/gameServer/stresstest3.hs	Sat Aug 14 02:10:27 2010 +0200
+++ b/gameServer/stresstest3.hs	Mon Aug 16 18:43:32 2010 +0400
@@ -44,7 +44,7 @@
 
 emulateSession :: StateT SState IO ()
 emulateSession = do
-    n <- io $ randomRIO (100000::Int, 100000)
+    n <- io $ randomRIO (100000::Int, 100100)
     waitPacket "CONNECTED"
     sendPacket ["NICK", "test" ++ (show n)]
     waitPacket "NICK"