gameServer/OfficialServer/GameReplayStore.hs
author unc0rr
Mon, 18 Feb 2013 00:31:16 +0400
changeset 8511 4f899fbce66d
parent 8509 eda9f2106d8d
child 9662 47dbd9601342
permissions -rw-r--r--
Catch exceptions when moving files
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE ScopedTypeVariables #-}
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
     2
module OfficialServer.GameReplayStore where
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
     3
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
     4
import Data.Time
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
     5
import Control.Exception as E
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
     6
import qualified Data.Map as Map
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
     7
import Data.Sequence()
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
     8
import System.Log.Logger
5996
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5143
diff changeset
     9
import Data.Maybe
6040
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    10
import Data.Unique
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    11
import Control.Monad
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8423
diff changeset
    12
import Data.List
8482
5656a73fe3c3 Fix official server build
unc0rr
parents: 8479
diff changeset
    13
import qualified Data.ByteString as B
5656a73fe3c3 Fix official server build
unc0rr
parents: 8479
diff changeset
    14
import System.Directory
6040
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    15
---------------
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    16
import CoreTypes
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8423
diff changeset
    17
import EngineInteraction
6040
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 5996
diff changeset
    18
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
    19
8509
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    20
pickReplayFile :: Int -> IO String
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    21
pickReplayFile p = do
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    22
    files <- liftM (filter (isSuffixOf ('.' : show p))) $ getDirectoryContents "replays"
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    23
    if (not $ null files) then
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    24
        return $ "replays/" ++ head files
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    25
        else
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    26
        return ""
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    27
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents:
diff changeset
    28
saveReplay :: RoomInfo -> IO ()
8423
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    29
saveReplay r = do
5996
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5143
diff changeset
    30
    let gi = fromJust $ gameInfo r
8423
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    31
    when (allPlayersHaveRegisteredAccounts gi) $ do
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    32
        time <- getCurrentTime
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    33
        u <- liftM hashUnique newUnique
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8423
diff changeset
    34
        let fileName = "replays/" ++ show time ++ "-" ++ show u ++ "." ++ show (roomProto r)
8423
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    35
        let replayInfo = (teamsAtStart gi, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs gi)
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    36
        E.catch
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    37
            (writeFile fileName (show replayInfo))
8aa450f6cf2c Fix official server build
unc0rr
parents: 8371
diff changeset
    38
            (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e)
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8423
diff changeset
    39
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8423
diff changeset
    40
8509
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    41
loadReplay :: Int -> IO (Maybe CheckInfo, [B.ByteString])
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    42
loadReplay p = E.handle (\(e :: SomeException) -> warningM "REPLAYS" "Problems reading replay" >> return (Nothing, [])) $ do
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    43
    fileName <- pickReplayFile p
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    44
    if (not $ null fileName) then
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    45
        loadFile fileName
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8423
diff changeset
    46
        else
8509
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    47
        return (Nothing, [])
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8423
diff changeset
    48
    where
8509
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    49
        loadFile :: String -> IO (Maybe CheckInfo, [B.ByteString])
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    50
        loadFile fileName = E.handle (\(e :: SomeException) ->
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    51
                    warningM "REPLAYS" ("Problems reading " ++ fileName ++ ": " ++ show e) >> return (Nothing, [])) $ do
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8423
diff changeset
    52
            (teams, params1, params2, roundMsgs) <- liftM read $ readFile fileName
8509
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    53
            return $ (
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    54
                Just (CheckInfo fileName teams)
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    55
                , replayToDemo teams (Map.fromList params1) (Map.fromList params2) (reverse roundMsgs)
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    56
                )
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    57
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    58
moveFailedRecord :: String -> IO ()
8511
4f899fbce66d Catch exceptions when moving files
unc0rr
parents: 8509
diff changeset
    59
moveFailedRecord fn = E.handle (\(e :: SomeException) -> warningM "REPLAYS" $ show e) $
4f899fbce66d Catch exceptions when moving files
unc0rr
parents: 8509
diff changeset
    60
    renameFile fn ("failed/" ++ drop 8 fn)
8509
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    61
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    62
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8502
diff changeset
    63
moveCheckedRecord :: String -> IO ()
8511
4f899fbce66d Catch exceptions when moving files
unc0rr
parents: 8509
diff changeset
    64
moveCheckedRecord fn = E.handle (\(e :: SomeException) -> warningM "REPLAYS" $ show e) $
4f899fbce66d Catch exceptions when moving files
unc0rr
parents: 8509
diff changeset
    65
    renameFile fn ("checked/" ++ drop 8 fn)