gameServer/ConfigFile.hs
author nemo
Sun, 14 Aug 2011 23:52:45 -0400
changeset 5569 8313952b2811
parent 5009 12135f659bf1
child 8401 87410ae372f6
permissions -rw-r--r--
suggestion of mikade's - delete old mines if the collision array shows signs of filling up. This is kind of an edge case, esp now that array is up to 1024, but should prevent (easiest) way to crash by collision array overflow (endless mines/minestrikes).

{-# LANGUAGE RankNTypes #-}
module ConfigFile where

import Data.Maybe
import Data.TConfig
import qualified Data.ByteString.Char8 as B
-------------------
import CoreTypes

cfgFileName :: String
cfgFileName = "hedgewars-server.ini"


readServerConfig :: ServerInfo -> IO ServerInfo
readServerConfig serverInfo' = do
    cfg <- readConfig cfgFileName
    let si = serverInfo'{
        dbHost = value "dbHost" cfg
        , dbName = value "dbName" cfg
        , dbLogin = value "dbLogin" cfg
        , dbPassword = value "dbPassword" cfg
        , serverMessage = value "sv_message" cfg
        , serverMessageForOldVersions = value "sv_messageOld" cfg
        , bans = read . fromJust2 "bans" $ getValue "bans" cfg
        , latestReleaseVersion = read . fromJust $ getValue "sv_latestProto" cfg
        , serverConfig = Just cfg
    }
    return si
    where
        value n c = B.pack . fromJust2 n $ getValue n c
        fromJust2 n Nothing = error $ "Missing config entry " ++ n
        fromJust2 _ (Just a) = a


writeServerConfig :: ServerInfo -> IO ()
writeServerConfig ServerInfo{serverConfig = Nothing} = return ()
writeServerConfig ServerInfo{
    dbHost = dh,
    dbName = dn,
    dbLogin = dl,
    dbPassword = dp,
    serverMessage = sm,
    serverMessageForOldVersions = smo,
    bans = b,
    latestReleaseVersion = ver,
    serverConfig = Just cfg}
        =
    writeConfig cfgFileName $ foldl1 (.) entries cfg
    where
        entries =
            repConfig "sv_latestProto" (show ver)
            : repConfig "bans" (show b)
            : map (\(n, v) -> repConfig n (B.unpack v)) [
            ("dbHost", dh)
            , ("dbName", dn)
            , ("dbLogin", dl)
            , ("dbPassword", dp)
            , ("sv_message", sm)
            , ("sv_messageOld", smo)
            ]