--- a/gameServer/Actions.hs Sun Aug 15 10:25:21 2010 -0400
+++ b/gameServer/Actions.hs Tue Aug 17 19:43:17 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
--- a/gameServer/RoomsAndClients.hs Sun Aug 15 10:25:21 2010 -0400
+++ b/gameServer/RoomsAndClients.hs Tue Aug 17 19:43:17 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)
--- a/gameServer/ServerCore.hs Sun Aug 15 10:25:21 2010 -0400
+++ b/gameServer/ServerCore.hs Tue Aug 17 19:43:17 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]
--- a/gameServer/ServerState.hs Sun Aug 15 10:25:21 2010 -0400
+++ b/gameServer/ServerState.hs Tue Aug 17 19:43:17 2010 -0400
@@ -8,7 +8,7 @@
roomClientsS
) where
-import Control.Monad.State
+import Control.Monad.State.Strict
import Data.Set as Set
----------------------
import RoomsAndClients
--- a/gameServer/Store.hs Sun Aug 15 10:25:21 2010 -0400
+++ b/gameServer/Store.hs Tue Aug 17 19:43:17 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
--- a/gameServer/stresstest3.hs Sun Aug 15 10:25:21 2010 -0400
+++ b/gameServer/stresstest3.hs Tue Aug 17 19:43:17 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"