# HG changeset patch
# User unc0rr
# Date 1361386456 -14400
# Node ID 98e2dbdda8c0129d362e1f16ad46b7727dd68211
# Parent  648bb1cb7ebcc7e3b14b8d3812c00ee1cd3edd7e
Workaround desync issue if I correctly understand its roots (barely tested)

diff -r 648bb1cb7ebc -r 98e2dbdda8c0 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/Actions.hs	Wed Feb 20 22:54:16 2013 +0400
@@ -32,68 +32,9 @@
 import ConfigFile
 import EngineInteraction
 
-data Action =
-    AnswerClients ![ClientChan] ![B.ByteString]
-    | SendServerMessage
-    | SendServerVars
-    | MoveToRoom RoomIndex
-    | MoveToLobby B.ByteString
-    | RemoveTeam B.ByteString
-    | SendTeamRemovalMessage B.ByteString
-    | RemoveRoom
-    | FinishGame
-    | UnreadyRoomClients
-    | JoinLobby
-    | ProtocolError B.ByteString
-    | Warning B.ByteString
-    | NoticeMessage Notice
-    | ByeClient B.ByteString
-    | KickClient ClientIndex
-    | KickRoomClient ClientIndex
-    | BanClient NominalDiffTime B.ByteString ClientIndex
-    | BanIP B.ByteString NominalDiffTime B.ByteString
-    | BanNick B.ByteString NominalDiffTime B.ByteString
-    | BanList
-    | Unban B.ByteString
-    | ChangeMaster (Maybe ClientIndex)
-    | RemoveClientTeams
-    | ModifyClient (ClientInfo -> ClientInfo)
-    | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
-    | ModifyRoomClients (ClientInfo -> ClientInfo)
-    | ModifyRoom (RoomInfo -> RoomInfo)
-    | ModifyServerInfo (ServerInfo -> ServerInfo)
-    | AddRoom B.ByteString B.ByteString
-    | SendUpdateOnThisRoom
-    | CheckRegistered
-    | ClearAccountsCache
-    | ProcessAccountInfo AccountInfo
-    | AddClient ClientInfo
-    | DeleteClient ClientIndex
-    | PingAll
-    | StatsAction
-    | RestartServer
-    | AddNick2Bans B.ByteString B.ByteString UTCTime
-    | AddIP2Bans B.ByteString B.ByteString UTCTime
-    | CheckBanned Bool
-    | SaveReplay
-    | Stats
-    | CheckRecord
-    | CheckFailed B.ByteString
-    | CheckSuccess [B.ByteString]
-
 
 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
 
-instance NFData Action where
-    rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
-    rnf a = a `seq` ()
-
-#if __GLASGOW_HASKELL__ < 706
-instance NFData B.ByteString
-#endif
-
-instance NFData (Chan a)
-
 
 othersChans :: StateT ServerState IO [ClientChan]
 othersChans = do
@@ -594,6 +535,7 @@
     when (not $ ci `Set.member` rc)
         $ processAction $ ModifyServerInfo (\s -> s{bans = BanByIP ip reason expiring : bans s})
 
+
 processAction (CheckBanned byIP) = do
     clTime <- client's connectTime
     clNick <- client's nick
@@ -613,6 +555,7 @@
         getBanReason (BanByIP _ msg _) = msg
         getBanReason (BanByNick _ msg _) = msg
 
+
 processAction PingAll = do
     rnc <- gets roomsClients
     io (allClientsM rnc) >>= mapM_ (kickTimeouted rnc)
diff -r 648bb1cb7ebc -r 98e2dbdda8c0 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/CoreTypes.hs	Wed Feb 20 22:54:16 2013 +0400
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
+{-# LANGUAGE CPP, OverloadedStrings, DeriveDataTypeable #-}
 module CoreTypes where
 
 import Control.Concurrent
@@ -12,9 +12,70 @@
 import Control.Exception
 import Data.Typeable
 import Data.TConfig
+import Control.DeepSeq
 -----------------------
 import RoomsAndClients
 
+
+#if __GLASGOW_HASKELL__ < 706
+instance NFData B.ByteString
+#endif
+
+instance NFData (Chan a)
+
+instance NFData Action where
+    rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
+    rnf a = a `seq` ()
+
+data Action =
+    AnswerClients ![ClientChan] ![B.ByteString]
+    | SendServerMessage
+    | SendServerVars
+    | MoveToRoom RoomIndex
+    | MoveToLobby B.ByteString
+    | RemoveTeam B.ByteString
+    | SendTeamRemovalMessage B.ByteString
+    | RemoveRoom
+    | FinishGame
+    | UnreadyRoomClients
+    | JoinLobby
+    | ProtocolError B.ByteString
+    | Warning B.ByteString
+    | NoticeMessage Notice
+    | ByeClient B.ByteString
+    | KickClient ClientIndex
+    | KickRoomClient ClientIndex
+    | BanClient NominalDiffTime B.ByteString ClientIndex
+    | BanIP B.ByteString NominalDiffTime B.ByteString
+    | BanNick B.ByteString NominalDiffTime B.ByteString
+    | BanList
+    | Unban B.ByteString
+    | ChangeMaster (Maybe ClientIndex)
+    | RemoveClientTeams
+    | ModifyClient (ClientInfo -> ClientInfo)
+    | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
+    | ModifyRoomClients (ClientInfo -> ClientInfo)
+    | ModifyRoom (RoomInfo -> RoomInfo)
+    | ModifyServerInfo (ServerInfo -> ServerInfo)
+    | AddRoom B.ByteString B.ByteString
+    | SendUpdateOnThisRoom
+    | CheckRegistered
+    | ClearAccountsCache
+    | ProcessAccountInfo AccountInfo
+    | AddClient ClientInfo
+    | DeleteClient ClientIndex
+    | PingAll
+    | StatsAction
+    | RestartServer
+    | AddNick2Bans B.ByteString B.ByteString UTCTime
+    | AddIP2Bans B.ByteString B.ByteString UTCTime
+    | CheckBanned Bool
+    | SaveReplay
+    | Stats
+    | CheckRecord
+    | CheckFailed B.ByteString
+    | CheckSuccess [B.ByteString]
+
 type ClientChan = Chan [B.ByteString]
 
 data CheckInfo =
@@ -47,7 +108,8 @@
         isKickedFromServer :: Bool,
         clientClan :: !(Maybe B.ByteString),
         checkInfo :: Maybe CheckInfo,
-        teamsInGame :: Word
+        teamsInGame :: Word,
+        actionsPending :: [Action]
     }
 
 instance Eq ClientInfo where
diff -r 648bb1cb7ebc -r 98e2dbdda8c0 gameServer/HWProtoCore.hs
--- a/gameServer/HWProtoCore.hs	Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/HWProtoCore.hs	Wed Feb 20 22:54:16 2013 +0400
@@ -30,7 +30,7 @@
 handleCmd ["PONG"] = do
     cl <- thisClient
     if pingsQueue cl == 0 then
-        return [ProtocolError "Protocol violation"]
+        return $ actionsPending cl ++ [ModifyClient (\c -> c{actionsPending = []})]
         else
         return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})]
 
diff -r 648bb1cb7ebc -r 98e2dbdda8c0 gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/HWProtoLobbyState.hs	Wed Feb 20 22:54:16 2013 +0400
@@ -92,9 +92,12 @@
                 , AnswerClients [sendChan cl] $ ["CLIENT_FLAGS", "+h", ownerNick]
             ]
             ++ (if clientProto cl < 38 then map (readynessMessage cl) jRoomClients else [sendStateFlags cl jRoomClients])
-            ++ answerFullConfig cl (mapParams jRoom) (params jRoom)
-            ++ answerTeams cl jRoom
-            ++ watchRound cl jRoom chans
+            ++ [AnswerClients [sendChan cl] ["PING"]
+                , ModifyClient $ \c -> c{actionsPending = actionsPending cl
+                    ++ answerFullConfig cl (mapParams jRoom) (params jRoom)
+                    ++ answerTeams cl jRoom
+                    ++ watchRound cl jRoom chans}
+                ]
 
         where
         readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c]
diff -r 648bb1cb7ebc -r 98e2dbdda8c0 gameServer/NetRoutines.hs
--- a/gameServer/NetRoutines.hs	Tue Feb 19 22:03:33 2013 +0400
+++ b/gameServer/NetRoutines.hs	Wed Feb 20 22:54:16 2013 +0400
@@ -47,6 +47,7 @@
                     Nothing
                     Nothing
                     0
+                    []
                     )
 
         writeChan chan $ Accept newClient