gameServer/OfficialServer/GameReplayStore.hs
author sheepluva
Thu, 21 Mar 2013 15:01:27 +0100
changeset 8763 988901d27abf
parent 8511 4f899fbce66d
child 9662 47dbd9601342
permissions -rw-r--r--
don't poison the dead, it's not cool. (poisoning hogs during their death animation would cause them to still be poisoned after resurrect) thanks to CheezeMonkey for pointing this out
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)