# HG changeset patch
# User unc0rr
# Date 1359922435 -14400
# Node ID 8d71109b04d22d16084d851f54199b0351104949
# Parent  d12531f09d597f9a1c7d4efa2ecb797d8bdd8835
Some work on loading replay and interaction with checker

diff -r d12531f09d59 -r 8d71109b04d2 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Sat Feb 02 22:57:05 2013 +0400
+++ b/gameServer/Actions.hs	Mon Feb 04 00:13:55 2013 +0400
@@ -77,6 +77,7 @@
     | CheckBanned Bool
     | SaveReplay
     | Stats
+    | CheckRecord
 
 
 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
@@ -670,6 +671,17 @@
     io $ do
         r <- room'sM rnc id ri
         saveReplay r
+
+
+processAction CheckRecord = do
+    p <- client's clientProto
+    c <- client's clChan
+    l <- loadReplay p
+    when (not $ null l) $
+        processAction $ AnswerClients [c] ("REPLAY" : l)
+
+
 #else
 processAction SaveReplay = return ()
+processAction CheckRecord = return ()
 #endif
diff -r d12531f09d59 -r 8d71109b04d2 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Sat Feb 02 22:57:05 2013 +0400
+++ b/gameServer/CoreTypes.hs	Mon Feb 04 00:13:55 2013 +0400
@@ -68,7 +68,7 @@
 
 instance Eq TeamInfo where
     (==) = (==) `on` teamname
-    
+
 data GameInfo =
     GameInfo
     {
diff -r d12531f09d59 -r 8d71109b04d2 gameServer/EngineInteraction.hs
--- a/gameServer/EngineInteraction.hs	Sat Feb 02 22:57:05 2013 +0400
+++ b/gameServer/EngineInteraction.hs	Mon Feb 04 00:13:55 2013 +0400
@@ -5,6 +5,7 @@
 import qualified Codec.Binary.Base64 as Base64
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString as BW
+import qualified Data.Map as Map
 -------------
 import CoreTypes
 
@@ -31,8 +32,13 @@
         slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
 
 
-gameInfo2Replay :: GameInfo -> B.ByteString
-gameInfo2Replay GameInfo{roundMsgs = rm,
-        teamsAtStart = teams,
-        giMapParams = params1,
-        giParams = params2} = undefined
+replayToDemo :: [TeamInfo]
+        -> Map.Map B.ByteString B.ByteString
+        -> Map.Map B.ByteString [B.ByteString]
+        -> [B.ByteString]
+        -> [B.ByteString]
+replayToDemo teams mapParams params msgs = undefined
+
+
+
+
diff -r d12531f09d59 -r 8d71109b04d2 gameServer/HWProtoChecker.hs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/HWProtoChecker.hs	Mon Feb 04 00:13:55 2013 +0400
@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+module HWProtoChecker where
+
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.List
+import Control.Monad.Reader
+--------------------------------------
+import CoreTypes
+import Actions
+import Utils
+import HandlerUtils
+import RoomsAndClients
+import EngineInteraction
+
+
+handleCmd_checker :: CmdHandler
+
+handleCmd_checker ["READY"] = return [CheckRecord]
+
+handleCmd_checker _ = return [ProtocolError "Unknown command"]
diff -r d12531f09d59 -r 8d71109b04d2 gameServer/HWProtoCore.hs
--- a/gameServer/HWProtoCore.hs	Sat Feb 02 22:57:05 2013 +0400
+++ b/gameServer/HWProtoCore.hs	Mon Feb 04 00:13:55 2013 +0400
@@ -11,6 +11,7 @@
 import HWProtoNEState
 import HWProtoLobbyState
 import HWProtoInRoomState
+import HWProtoChecker
 import HandlerUtils
 import RoomsAndClients
 import Utils
@@ -48,8 +49,12 @@
 
 handleCmd cmd = do
     (ci, irnc) <- ask
-    if logonPassed (irnc `client` ci) then
-        handleCmd_loggedin cmd
+    let cl = irnc `client` ci
+    if logonPassed cl then
+        if isChecker cl then
+            handleCmd_checker cmd
+            else
+            handleCmd_loggedin cmd
         else
         handleCmd_NotEntered cmd
 
diff -r d12531f09d59 -r 8d71109b04d2 gameServer/OfficialServer/GameReplayStore.hs
--- a/gameServer/OfficialServer/GameReplayStore.hs	Sat Feb 02 22:57:05 2013 +0400
+++ b/gameServer/OfficialServer/GameReplayStore.hs	Mon Feb 04 00:13:55 2013 +0400
@@ -9,8 +9,10 @@
 import Data.Maybe
 import Data.Unique
 import Control.Monad
+import Data.List
 ---------------
 import CoreTypes
+import EngineInteraction
 
 
 saveReplay :: RoomInfo -> IO ()
@@ -19,8 +21,21 @@
     when (allPlayersHaveRegisteredAccounts gi) $ do
         time <- getCurrentTime
         u <- liftM hashUnique newUnique
-        let fileName = "replays/" ++ show time ++ "-" ++ show u
+        let fileName = "replays/" ++ show time ++ "-" ++ show u ++ "." ++ show (roomProto r)
         let replayInfo = (teamsAtStart gi, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs gi)
         E.catch
             (writeFile fileName (show replayInfo))
             (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e)
+
+
+loadReplay :: Int -> IO [B.ByteString]
+loadReplay p = E.handle (\(e :: SomeException) -> warningM "REPLAYS" $ "Problems reading replay") $ do
+    files <- liftM (isSuffixOf ('.' : show p)) getDirectoryContents
+    if (not $ null files) then
+        loadFile $ head files
+        else
+        return []
+    where
+        loadFile fileName = E.handle (\(e :: SomeException) -> warningM "REPLAYS" $ "Problems reading " ++ fileName) $ do
+            (teams, params1, params2, roundMsgs) <- liftM read $ readFile fileName
+            return $ replayToDemo teams (Map.fromList params1) (Map.fromList params2) roundMsgs
diff -r d12531f09d59 -r 8d71109b04d2 gameServer/OfficialServer/checker.hs
--- a/gameServer/OfficialServer/checker.hs	Sat Feb 02 22:57:05 2013 +0400
+++ b/gameServer/OfficialServer/checker.hs	Mon Feb 04 00:13:55 2013 +0400
@@ -72,7 +72,9 @@
         debugM "Network" $ "Send: " ++ show p
         sendAll s $ B.unlines p `B.snoc` '\n'
     onPacket :: [B.ByteString] -> IO ()
-    onPacket ("CONNECTED":_) = answer ["CHECKER", protocolNumber, l, p]
+    onPacket ("CONNECTED":_) = do
+        answer ["CHECKER", protocolNumber, l, p]
+        answer ["READY"]
     onPacket ["PING"] = answer ["PONG"]
     onPacket ("BYE" : xs) = error $ show xs
     onPacket _ = return ()