# HG changeset patch
# User unc0rr
# Date 1279566010 -14400
# Node ID 18189fbc75301bc300210eb599ef172118777e79
# Parent  c0d94fedbd86aa38669b5ea5437982fc3c3b1cce
Reimplement ping timeout

diff -r c0d94fedbd86 -r 18189fbc7530 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Mon Jul 19 22:37:47 2010 +0400
+++ b/gameServer/Actions.hs	Mon Jul 19 23:00:10 2010 +0400
@@ -417,24 +417,22 @@
             return (ci, serverInfo)
 -}
 
-    
 
 
-{-
-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"]
+processAction PingAll = do
+    rnc <- gets roomsClients
+    cis <- liftIO $ allClientsM rnc
+    mapM_ (kickTimeouted rnc) $ cis
+    chans <- liftIO $ mapM (client'sM rnc sendChan) cis
+    liftIO $ mapM_ (modifyClient rnc (\cl -> cl{pingsQueue = pingsQueue cl + 1})) cis
+    processAction $ AnswerClients chans ["PING"]
     where
-        kickTimeouted (clID, serverInfo, rnc) client =
-            if pingsQueue client > 0 then
-                processAction (clientUID client, serverInfo, rnc) $ ByeClient "Ping timeout"
-                else
-                return (clID, serverInfo, rnc)
+        kickTimeouted rnc ci = do
+            pq <- liftIO $ client'sM rnc pingsQueue ci
+            when (pq > 0) $
+                withStateT (\as -> as{clientIndex = Just ci}) $
+                    processAction (ByeClient "Ping timeout")
 
--}
 
 processAction (StatsAction) = do
     rnc <- gets roomsClients
diff -r c0d94fedbd86 -r 18189fbc7530 gameServer/RoomsAndClients.hs
--- a/gameServer/RoomsAndClients.hs	Mon Jul 19 22:37:47 2010 +0400
+++ b/gameServer/RoomsAndClients.hs	Mon Jul 19 23:00:10 2010 +0400
@@ -19,6 +19,7 @@
     room,
     client'sM,
     room'sM,
+    allClientsM,
     clientsM,
     roomClientsM,
     withRoomsAndClients,
@@ -146,6 +147,9 @@
 room'sM :: MRoomsAndClients r c -> (r -> a) -> RoomIndex -> IO a
 room'sM (MRoomsAndClients (rooms, _)) f (RoomIndex ri) = liftM (f . room') (rooms `readElem` ri)
 
+allClientsM :: MRoomsAndClients r c -> IO [ClientIndex]
+allClientsM (MRoomsAndClients (_, clients)) = liftM (map ClientIndex) $ indicesM clients
+
 clientsM :: MRoomsAndClients r c -> IO [c]
 clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (\ci -> liftM client' $ readElem clients ci)