--- a/gameServer/Actions.hs Sun Feb 17 00:25:53 2013 +0400
+++ b/gameServer/Actions.hs Mon Feb 18 00:22:13 2013 +0400
@@ -678,21 +678,20 @@
processAction CheckRecord = do
p <- client's clientProto
c <- client's sendChan
- l <- io $ loadReplay (fromIntegral p)
- when (not $ null l) $
- processAction $ AnswerClients [c] ("REPLAY" : l)
-
+ (cinfo, l) <- io $ loadReplay (fromIntegral p)
+ when (not . null $ l) $
+ mapM_ processAction [
+ AnswerClients [c] ("REPLAY" : l)
+ , ModifyClient $ \c -> c{checkInfo = cinfo}
+ ]
-processAction CheckRecord = do
- p <- client's clientProto
- c <- client's sendChan
- l <- io $ loadReplay (fromIntegral p)
- when (not $ null l) $
- processAction $ AnswerClients [c] ("REPLAY" : l)
+processAction (CheckFailed msg) = do
+ Just (CheckInfo fileName _) <- client's checkInfo
+ io $ moveFailedRecord fileName
-processAction (CheckFailed msg) = return ()
-
-processAction (CheckSuccess info) = return ()
+processAction (CheckSuccess info) = do
+ Just (CheckInfo fileName _) <- client's checkInfo
+ io $ moveCheckedRecord fileName
#else
processAction SaveReplay = return ()
--- a/gameServer/CoreTypes.hs Sun Feb 17 00:25:53 2013 +0400
+++ b/gameServer/CoreTypes.hs Mon Feb 18 00:22:13 2013 +0400
@@ -20,7 +20,7 @@
data CheckInfo =
CheckInfo
{
- recordFileName :: B.ByteString,
+ recordFileName :: String,
recordTeams :: [TeamInfo]
}
--- a/gameServer/OfficialServer/GameReplayStore.hs Sun Feb 17 00:25:53 2013 +0400
+++ b/gameServer/OfficialServer/GameReplayStore.hs Mon Feb 18 00:22:13 2013 +0400
@@ -17,6 +17,14 @@
import EngineInteraction
+pickReplayFile :: Int -> IO String
+pickReplayFile p = do
+ files <- liftM (filter (isSuffixOf ('.' : show p))) $ getDirectoryContents "replays"
+ if (not $ null files) then
+ return $ "replays/" ++ head files
+ else
+ return ""
+
saveReplay :: RoomInfo -> IO ()
saveReplay r = do
let gi = fromJust $ gameInfo r
@@ -30,15 +38,26 @@
(\(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" >> return []) $ do
- files <- liftM (filter (isSuffixOf ('.' : show p))) $ getDirectoryContents "replays"
- if (not $ null files) then
- loadFile $ "replays/" ++ head files
+loadReplay :: Int -> IO (Maybe CheckInfo, [B.ByteString])
+loadReplay p = E.handle (\(e :: SomeException) -> warningM "REPLAYS" "Problems reading replay" >> return (Nothing, [])) $ do
+ fileName <- pickReplayFile p
+ if (not $ null fileName) then
+ loadFile fileName
else
- return []
+ return (Nothing, [])
where
- loadFile :: String -> IO [B.ByteString]
- loadFile fileName = E.handle (\(e :: SomeException) -> warningM "REPLAYS" ("Problems reading " ++ fileName ++ ": " ++ show e) >> return []) $ do
+ loadFile :: String -> IO (Maybe CheckInfo, [B.ByteString])
+ loadFile fileName = E.handle (\(e :: SomeException) ->
+ warningM "REPLAYS" ("Problems reading " ++ fileName ++ ": " ++ show e) >> return (Nothing, [])) $ do
(teams, params1, params2, roundMsgs) <- liftM read $ readFile fileName
- return $ replayToDemo teams (Map.fromList params1) (Map.fromList params2) (reverse roundMsgs)
+ return $ (
+ Just (CheckInfo fileName teams)
+ , replayToDemo teams (Map.fromList params1) (Map.fromList params2) (reverse roundMsgs)
+ )
+
+moveFailedRecord :: String -> IO ()
+moveFailedRecord fn = renameFile fn ("failed/" ++ drop 8 fn)
+
+
+moveCheckedRecord :: String -> IO ()
+moveCheckedRecord fn = renameFile fn ("checked/" ++ drop 8 fn)