# HG changeset patch
# User unc0rr
# Date 1299179713 -10800
# Node ID 31da8979e5b1c623275e1995a12aef400c008a52
# Parent  078cd026a7b13c342d274e4bb847119fab818381
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)

diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/Actions.hs
--- a/gameServer/Actions.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/Actions.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -22,7 +22,7 @@
 import ServerState
 import Consts
 
-data Action =
+data Action c =
     AnswerClients ![ClientChan] ![B.ByteString]
     | SendServerMessage
     | SendServerVars
@@ -44,7 +44,7 @@
     | ModifyClient (ClientInfo -> ClientInfo)
     | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
     | ModifyRoom (RoomInfo -> RoomInfo)
-    | ModifyServerInfo (ServerInfo -> ServerInfo)
+    | ModifyServerInfo (ServerInfo c -> ServerInfo c)
     | AddRoom B.ByteString B.ByteString
     | CheckRegistered
     | ClearAccountsCache
@@ -56,9 +56,9 @@
     | RestartServer Bool
 
 
-type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
+type CmdHandler c = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action c]
 
-instance NFData Action where
+instance NFData (Action c) where
     rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
     rnf a = a `seq` ()
 
@@ -66,13 +66,13 @@
 instance NFData (Chan a)
 
 
-othersChans :: StateT ServerState IO [ClientChan]
+othersChans :: StateT (ServerState c) IO [ClientChan]
 othersChans = do
     cl <- client's id
     ri <- clientRoomA
     liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
 
-processAction :: Action -> StateT ServerState IO ()
+processAction :: Action c -> StateT (ServerState c) IO ()
 
 
 processAction (AnswerClients chans msg) =
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/ConfigFile.hs
--- a/gameServer/ConfigFile.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/ConfigFile.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -1,11 +1,23 @@
+{-# LANGUAGE RankNTypes #-}
 module ConfigFile where
 
+import Data.Maybe
 import Data.TConfig
+import qualified Data.ByteString.Char8 as B
 -------------------
 import CoreTypes
 
-readServerConfig :: ServerInfo -> IO ServerInfo
-readServerConfig = undefined
+readServerConfig serverInfo' = do
+    cfg <- readConfig "hedgewars-server.ini"
+    let si = serverInfo'{
+        dbHost = value "dbHost" cfg
+        , dbLogin = value "dbLogin" cfg
+        , dbPassword = value "dbPassword" cfg
+        , serverConfig = Just cfg
+    }
+    return si
+    where
+        value n c = B.pack . fromJust $ getValue n c
 
-writeServerConfig :: ServerInfo -> IO
+writeServerConfig :: ServerInfo c -> IO ()
 writeServerConfig = undefined
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/CoreTypes.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -12,6 +12,7 @@
 import Data.Unique
 import Control.Exception
 import Data.Typeable
+import Data.TConfig
 -----------------------
 import RoomsAndClients
 
@@ -123,7 +124,7 @@
         roomsNumber :: Int
     }
 
-data ServerInfo =
+data ServerInfo c =
     ServerInfo
     {
         isDedicated :: Bool,
@@ -138,13 +139,14 @@
         lastLogins :: [(B.ByteString, (UTCTime, B.ByteString))],
         restartPending :: Bool,
         coreChan :: Chan CoreMessage,
-        dbQueries :: Chan DBQuery
+        dbQueries :: Chan DBQuery,
+        serverConfig :: Maybe c
     }
 
-instance Show ServerInfo where
+instance Show (ServerInfo c) where
     show _ = "Server Info"
 
-newServerInfo :: Chan CoreMessage -> Chan DBQuery -> ServerInfo
+newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe c -> ServerInfo c
 newServerInfo =
     ServerInfo
         True
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/HWProtoCore.hs
--- a/gameServer/HWProtoCore.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/HWProtoCore.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -14,7 +14,7 @@
 import RoomsAndClients
 import Utils
 
-handleCmd, handleCmd_loggedin :: CmdHandler
+handleCmd, handleCmd_loggedin :: CmdHandler c
 
 
 handleCmd ["PING"] = answerClient ["PONG"]
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/HWProtoInRoomState.hs
--- a/gameServer/HWProtoInRoomState.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/HWProtoInRoomState.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -15,7 +15,7 @@
 import HandlerUtils
 import RoomsAndClients
 
-handleCmd_inRoom :: CmdHandler
+handleCmd_inRoom :: CmdHandler c
 
 handleCmd_inRoom ["CHAT", msg] = do
     n <- clientNick
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/HWProtoLobbyState.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -15,7 +15,7 @@
 import RoomsAndClients
 
 
-answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
+answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action c]
 answerAllTeams cl = concatMap toAnswer
     where
         clChan = sendChan cl
@@ -24,7 +24,7 @@
             AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
             AnswerClients [clChan] ["HH_NUM", teamname team, B.pack . show $ hhnum team]]
 
-handleCmd_lobby :: CmdHandler
+handleCmd_lobby :: CmdHandler c
 
 
 handleCmd_lobby ["LIST"] = do
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/HWProtoNEState.hs
--- a/gameServer/HWProtoNEState.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/HWProtoNEState.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -11,7 +11,7 @@
 import Utils
 import RoomsAndClients
 
-handleCmd_NotEntered :: CmdHandler
+handleCmd_NotEntered :: CmdHandler c
 
 handleCmd_NotEntered ["NICK", newNick] = do
     (ci, irnc) <- ask
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/HandlerUtils.hs
--- a/gameServer/HandlerUtils.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/HandlerUtils.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -51,7 +51,7 @@
     (ci, rnc) <- ask
     return [sendChan (rnc `client` ci)]
 
-answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
+answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action c]
 answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans
 
 allRoomInfos :: Reader (a, IRnC) [RoomInfo]
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/OfficialServer/DBInteraction.hs
--- a/gameServer/OfficialServer/DBInteraction.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/OfficialServer/DBInteraction.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -27,7 +27,7 @@
 localAddressList :: [B.ByteString]
 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"]
 
-fakeDbConnection :: forall b. ServerInfo -> IO b
+--fakeDbConnection :: forall b. (ServerInfo c)-> IO b
 fakeDbConnection si = forever $ do
     q <- readChan $ dbQueries si
     case q of
@@ -36,9 +36,9 @@
         ClearCache -> return ()
         SendStats {} -> return ()
 
-dbConnectionLoop :: forall b. ServerInfo -> IO b
+--dbConnectionLoop :: forall b. (ServerInfo c) -> IO b
 #if defined(OFFICIAL_SERVER)
-flushRequests :: ServerInfo -> IO ()
+flushRequests :: (ServerInfo c) -> IO ()
 flushRequests si = do
     e <- isEmptyChan $ dbQueries si
     unless e $ do
@@ -89,7 +89,7 @@
         maybeException (Just a) = return a
         maybeException Nothing = ioError (userError "Can't read")
 
-pipeDbConnection :: forall b. Map.Map ByteString (UTCTime, AccountInfo) -> ServerInfo -> Int -> IO b
+--pipeDbConnection :: forall b. Map.Map ByteString (UTCTime, AccountInfo) -> (ServerInfo c) -> Int -> IO b
 pipeDbConnection accountsCache si errNum = do
     (updatedCache, newErrNum) <-
         Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, errNum + 1)) $ do
@@ -118,6 +118,6 @@
 dbConnectionLoop = fakeDbConnection
 #endif
 
-startDBConnection :: ServerInfo -> IO ()
+startDBConnection :: (ServerInfo c) -> IO ()
 startDBConnection serverInfo =
     forkIO (dbConnectionLoop serverInfo) >> return ()
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/Opts.hs
--- a/gameServer/Opts.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/Opts.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -11,7 +11,7 @@
 import CoreTypes
 import Utils
 
-options :: [OptDescr (ServerInfo -> ServerInfo)]
+options :: [OptDescr (ServerInfo c -> ServerInfo c)]
 options = [
     Option "p" ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
     Option "d" ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
@@ -19,7 +19,7 @@
 
 readListenPort
     , readDedicated
-    :: String -> ServerInfo -> ServerInfo
+    :: String -> ServerInfo c -> ServerInfo c
 
 
 readListenPort str opts = opts{listenPort = readPort}
@@ -30,7 +30,7 @@
     where
         readDed = fromMaybe True (maybeRead str :: Maybe Bool)
 
-getOpts :: ServerInfo -> IO ServerInfo
+getOpts :: ServerInfo c -> IO (ServerInfo c)
 getOpts opts = do
     args <- getArgs
     case getOpt Permute options args of
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/ServerCore.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -23,14 +23,14 @@
 timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
-reactCmd :: [B.ByteString] -> StateT ServerState IO ()
+reactCmd :: [B.ByteString] -> StateT (ServerState c) IO ()
 reactCmd cmd = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
     forM_ (actions `deepseq` actions) processAction
 
-mainLoop :: StateT ServerState IO ()
+mainLoop :: StateT (ServerState c) IO ()
 mainLoop = forever $ do
     -- get >>= \s -> put $! s
 
@@ -68,7 +68,7 @@
                     PingAll : [StatsAction | even tick]
 
 
-startServer :: ServerInfo -> Socket -> IO ()
+startServer :: ServerInfo c -> Socket -> IO ()
 startServer si serverSocket = do
     putStrLn $ "Listening on port " ++ show (listenPort si)
 
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/ServerState.hs
--- a/gameServer/ServerState.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/ServerState.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -15,33 +15,33 @@
 import RoomsAndClients
 import CoreTypes
 
-data ServerState = ServerState {
+data ServerState c = ServerState {
         clientIndex :: !(Maybe ClientIndex),
-        serverInfo :: !ServerInfo,
+        serverInfo :: !(ServerInfo c),
         removedClients :: !(Set.Set ClientIndex),
         roomsClients :: !MRnC
     }
 
 
-clientRoomA :: StateT ServerState IO RoomIndex
+clientRoomA :: StateT (ServerState c) IO RoomIndex
 clientRoomA = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     io $ clientRoomM rnc ci
 
-client's :: (ClientInfo -> a) -> StateT ServerState IO a
+client's :: (ClientInfo -> a) -> StateT (ServerState c) IO a
 client's f = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     io $ client'sM rnc f ci
 
-allClientsS :: StateT ServerState IO [ClientInfo]
+allClientsS :: StateT (ServerState c) IO [ClientInfo]
 allClientsS = gets roomsClients >>= liftIO . clientsM
 
-roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo]
+roomClientsS :: RoomIndex -> StateT (ServerState c) IO [ClientInfo]
 roomClientsS ri = do
     rnc <- gets roomsClients
     io $ roomClientsM rnc ri
 
-io :: IO a -> StateT ServerState IO a
+io :: IO a -> StateT (ServerState c) IO a
 io = liftIO
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/Utils.hs
--- a/gameServer/Utils.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/Utils.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -10,10 +10,10 @@
 import System.IO
 import qualified Data.List as List
 import Control.Monad
--------------------------------------------------
 import qualified Codec.Binary.Base64 as Base64
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString as BW
+-------------------------------------------------
 import CoreTypes
 
 
diff -r 078cd026a7b1 -r 31da8979e5b1 gameServer/hedgewars-server.hs
--- a/gameServer/hedgewars-server.hs	Mon Feb 28 22:28:43 2011 +0300
+++ b/gameServer/hedgewars-server.hs	Thu Mar 03 22:15:13 2011 +0300
@@ -8,6 +8,8 @@
 import qualified Control.Exception as E
 import System.Log.Logger
 import System.Process
+import Data.TConfig
+import Data.Maybe
 #if defined(OFFICIAL_SERVER)
 import Control.Monad
 #endif
@@ -28,7 +30,7 @@
         (setLevel INFO)
 
 
-server :: ServerInfo -> IO ()
+server :: ServerInfo c -> IO ()
 server si = do
     proto <- getProtocolNumber "tcp"
     E.bracket
@@ -58,11 +60,10 @@
 
     dbQueriesChan <- newChan
     coreChan' <- newChan
-    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan
+    serverInfo' <- getOpts $ newServerInfo coreChan' dbQueriesChan Nothing
 
 #if defined(OFFICIAL_SERVER)
-    [dbHost', dbLogin', dbPassword'] <- liftM read $ readFile "hedgewars-server.ini"
-    let si = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'}
+    si <- readServerConfig serverInfo'
 #else
     let si = serverInfo'
 #endif