module Game.LambdaHack.Server.Action.Save
( saveGameBkpSer, saveGameSer, restoreGameSer
) where
import Control.Concurrent
import qualified Control.Exception as Ex hiding (handle)
import Control.Monad
import System.Directory
import System.FilePath
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import Game.LambdaHack.Common.State
import Game.LambdaHack.Server.Config
import Game.LambdaHack.Server.State
import Game.LambdaHack.Utils.File
saveLock :: MVar ()
saveLock = unsafePerformIO newEmptyMVar
saveGameBkpSer :: Config -> State -> StateServer -> IO ()
saveGameBkpSer Config{configAppDataDir} s ser = do
b <- tryPutMVar saveLock ()
when b $
void $ forkIO $ do
let saveFile = configAppDataDir </> "server.sav"
saveFileBkp = saveFile <.> ".bkp"
encodeEOF saveFile (s, ser)
renameFile saveFile saveFileBkp
takeMVar saveLock
saveGameSer :: Config -> State -> StateServer -> IO ()
saveGameSer Config{configAppDataDir} s ser = do
putMVar saveLock ()
let saveFile = configAppDataDir </> "server.sav"
encodeEOF saveFile (s, ser)
takeMVar saveLock
restoreGameSer :: Config -> (FilePath -> IO FilePath)
-> IO (Maybe (State, StateServer))
restoreGameSer Config{ configAppDataDir
, configRulesCfgFile
, configScoresFile }
pathsDataFile = do
tryCreateDir configAppDataDir
tryCopyDataFiles pathsDataFile
[ (configRulesCfgFile <.> ".default", configRulesCfgFile <.> ".ini")
, (configScoresFile, configScoresFile) ]
let saveFile = configAppDataDir </> "server.sav"
saveFileBkp = saveFile <.> ".bkp"
sb <- doesFileExist saveFile
bb <- doesFileExist saveFileBkp
when sb $ renameFile saveFile saveFileBkp
res <- Ex.try $
if sb
then do
(s, ser) <- strictDecodeEOF saveFileBkp
return $ Just (s, ser)
else
if bb
then do
(s, ser) <- strictDecodeEOF saveFileBkp
let msg = "No server savefile found. "
++ "Restoring from a backup savefile."
hPutStrLn stderr msg
return $ Just (s, ser)
else return Nothing
let handler :: Ex.SomeException -> IO (Maybe (State, StateServer))
handler e = do
let msg = "Starting a new game, because server restore failed. "
++ "The error message is: "
++ (unwords . lines) (show e)
hPutStrLn stderr msg
return Nothing
either handler return res