1 {-# LANGUAGE ScopedTypeVariables #-} |
1 {- |
|
2 * Hedgewars, a free turn based strategy game |
|
3 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> |
|
4 * |
|
5 * This program is free software; you can redistribute it and/or modify |
|
6 * it under the terms of the GNU General Public License as published by |
|
7 * the Free Software Foundation; version 2 of the License |
|
8 * |
|
9 * This program is distributed in the hope that it will be useful, |
|
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
12 * GNU General Public License for more details. |
|
13 * |
|
14 * You should have received a copy of the GNU General Public License |
|
15 * along with this program; if not, write to the Free Software |
|
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
|
17 \-} |
|
18 |
|
19 {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} |
2 module OfficialServer.GameReplayStore where |
20 module OfficialServer.GameReplayStore where |
3 |
21 |
4 import Data.Time |
22 import Data.Time |
5 import Control.Exception as E |
23 import Control.Exception as E |
6 import qualified Data.Map as Map |
24 import qualified Data.Map as Map |
7 import Data.Sequence() |
25 import Data.Sequence() |
8 import System.Log.Logger |
26 import System.Log.Logger |
9 import Data.Maybe |
27 import Data.Maybe |
10 import Data.Unique |
28 import Data.Unique |
11 import Control.Monad |
29 import Control.Monad |
|
30 import Data.List |
|
31 import qualified Data.ByteString as B |
|
32 import System.Directory |
|
33 import Control.DeepSeq |
12 --------------- |
34 --------------- |
13 import CoreTypes |
35 import CoreTypes |
|
36 import EngineInteraction |
14 |
37 |
|
38 |
|
39 pickReplayFile :: Int -> [String] -> IO String |
|
40 pickReplayFile p blackList = do |
|
41 files <- liftM (filter (\f -> sameProto f && notBlacklisted ("replays/" ++ f))) $ getDirectoryContents "replays" |
|
42 if (not $ null files) then |
|
43 return $ "replays/" ++ head files |
|
44 else |
|
45 return "" |
|
46 where |
|
47 sameProto = isSuffixOf ('.' : show p) |
|
48 notBlacklisted = flip notElem blackList |
15 |
49 |
16 saveReplay :: RoomInfo -> IO () |
50 saveReplay :: RoomInfo -> IO () |
17 saveReplay r = do |
51 saveReplay r = do |
18 time <- getCurrentTime |
|
19 u <- liftM hashUnique newUnique |
|
20 let fileName = "replays/" ++ show time ++ "-" ++ show u |
|
21 let gi = fromJust $ gameInfo r |
52 let gi = fromJust $ gameInfo r |
22 let replayInfo = (teamsAtStart gi, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs gi) |
53 when (allPlayersHaveRegisteredAccounts gi) $ do |
23 E.catch |
54 time <- getCurrentTime |
24 (writeFile fileName (show replayInfo)) |
55 u <- liftM hashUnique newUnique |
25 (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e) |
56 let fileName = "replays/" ++ show time ++ "-" ++ show u ++ "." ++ show (roomProto r) |
26 |
57 let replayInfo = (teamsAtStart gi, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs gi) |
|
58 E.catch |
|
59 (writeFile fileName (show replayInfo)) |
|
60 (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e) |
|
61 |
|
62 |
|
63 loadReplay :: Int -> [String] -> IO (Maybe CheckInfo, [B.ByteString]) |
|
64 loadReplay p blackList = E.handle (\(e :: SomeException) -> warningM "REPLAYS" "Problems reading replay" >> return (Nothing, [])) $ do |
|
65 fileName <- pickReplayFile p blackList |
|
66 if (not $ null fileName) then |
|
67 loadFile fileName |
|
68 else |
|
69 return (Nothing, []) |
|
70 where |
|
71 loadFile :: String -> IO (Maybe CheckInfo, [B.ByteString]) |
|
72 loadFile fileName = E.handle (\(e :: SomeException) -> |
|
73 warningM "REPLAYS" ("Problems reading " ++ fileName ++ ": " ++ show e) >> return (Just $ CheckInfo fileName [] Nothing, [])) $ do |
|
74 (teams, params1, params2, roundMsgs) <- liftM read $ readFile fileName |
|
75 let d = replayToDemo teams (Map.fromList params1) (Map.fromList params2) (reverse roundMsgs) |
|
76 d `deepseq` return $ ( |
|
77 Just (CheckInfo fileName teams (fst d)) |
|
78 , snd d |
|
79 ) |
|
80 |
|
81 moveFailedRecord :: String -> IO () |
|
82 moveFailedRecord fn = E.handle (\(e :: SomeException) -> warningM "REPLAYS" $ show e) $ |
|
83 renameFile fn ("failed/" ++ drop 8 fn) |
|
84 |
|
85 |
|
86 moveCheckedRecord :: String -> IO () |
|
87 moveCheckedRecord fn = E.handle (\(e :: SomeException) -> warningM "REPLAYS" $ show e) $ |
|
88 renameFile fn ("checked/" ++ drop 8 fn) |