--- 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
--- 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
{
--- 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
+
+
+
+
--- /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"]
--- 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
--- 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
--- 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 ()