gameServer/OfficialServer/DBInteraction.hs
author jose1711
Thu, 08 Mar 2018 21:46:43 +0100
changeset 13130 13b6f1621ef2
parent 11046 47a8c19ecb60
permissions -rw-r--r--
Update Slovak translation
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10460
diff changeset
     3
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    14
 * You should have received a copy of the GNU General Public License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    15
 * along with this program; if not, write to the Free Software
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    16
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 9661
diff changeset
    18
4906
22cc9c2b5ae5 Fix even more
unc0rr
parents: 4568
diff changeset
    19
{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
module OfficialServer.DBInteraction
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
(
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    22
    startDBConnection
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
) where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
1979
912e450d4db2 - Add gameServer to build system
unc0rr
parents: 1970
diff changeset
    25
import Prelude hiding (catch);
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    26
import Control.Concurrent
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    27
import Control.Monad
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    28
import Data.List as L
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    29
import Data.ByteString.Char8 as B
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    30
#if defined(OFFICIAL_SERVER)
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 1979
diff changeset
    31
import System.Process
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
    32
import System.IO as SIO
2296
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2245
diff changeset
    33
import qualified Control.Exception as Exception
2117
1ac0e10e546f Add caching for accounts information (entries are stored in memory forever)
unc0rr
parents: 2116
diff changeset
    34
import qualified Data.Map as Map
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    35
import Data.Maybe
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    36
import Data.Time
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1834
diff changeset
    37
import System.Log.Logger
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    38
#endif
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    39
------------------------
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    40
import CoreTypes
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    41
#if defined(OFFICIAL_SERVER)
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 1979
diff changeset
    42
import Utils
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    43
#endif
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    45
localAddressList :: [B.ByteString]
1921
2a09f7f786a0 - User from localhost is server admin
unc0rr
parents: 1857
diff changeset
    46
localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"]
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1834
diff changeset
    47
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4982
diff changeset
    48
fakeDbConnection :: forall b. ServerInfo -> IO b
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    49
fakeDbConnection si = forever $ do
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    50
    q <- readChan $ dbQueries si
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    51
    case q of
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    52
        CheckAccount clId clUid _ clHost ->
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    53
            writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    54
        ClearCache -> return ()
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    55
        SendStats {} -> return ()
1857
b835395659e2 Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents: 1847
diff changeset
    56
4996
76ef3d8bd78e Fix crash (accessing already deleted client record) by reverting to old client removing handling + throwTo
unc0rr
parents: 4992
diff changeset
    57
dbConnectionLoop :: ServerInfo -> IO ()
76ef3d8bd78e Fix crash (accessing already deleted client record) by reverting to old client removing handling + throwTo
unc0rr
parents: 4992
diff changeset
    58
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 1979
diff changeset
    59
#if defined(OFFICIAL_SERVER)
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4982
diff changeset
    60
flushRequests :: ServerInfo -> IO ()
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    61
flushRequests si = do
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    62
    e <- isEmptyChan $ dbQueries si
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    63
    unless e $ do
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    64
        q <- readChan $ dbQueries si
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    65
        case q of
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    66
            CheckAccount clId clUid _ clHost ->
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    67
                writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    68
            ClearCache -> return ()
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    69
            SendStats {} -> return ()
9661
788fd9eedfb0 Fix 'non-exhaustive pattern' server crash
unc0rr
parents: 9450
diff changeset
    70
            GetReplayName {} -> return ()
788fd9eedfb0 Fix 'non-exhaustive pattern' server crash
unc0rr
parents: 9450
diff changeset
    71
            StoreAchievements {} -> return ()
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    72
        flushRequests si
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    73
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
    74
pipeDbConnectionLoop :: Chan DBQuery -> Chan CoreMessage -> Handle -> Handle -> Map.Map ByteString (UTCTime, AccountInfo) -> Int -> IO (Map.Map ByteString (UTCTime, AccountInfo), Int)
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
    75
pipeDbConnectionLoop queries cChan hIn hOut accountsCache req =
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
    76
    Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, req)) $
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    77
    do
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    78
    q <- readChan queries
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
    79
    (updatedCache, newReq) <- case q of
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
    80
        CheckAccount clId clUid clNick _ -> do
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    81
            let cacheEntry = clNick `Map.lookup` accountsCache
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    82
            currentTime <- getCurrentTime
7331
0e50456d652c Well, since we have database on the same computer as game server, could remove caching, but I just set expiration time to 10 minutes
unc0rr
parents: 4996
diff changeset
    83
            if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 10 * 60) then
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    84
                do
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
    85
                    SIO.hPutStrLn hIn $ show q
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    86
                    hFlush hIn
2117
1ac0e10e546f Add caching for accounts information (entries are stored in memory forever)
unc0rr
parents: 2116
diff changeset
    87
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
    88
                    (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead)
2117
1ac0e10e546f Add caching for accounts information (entries are stored in memory forever)
unc0rr
parents: 2116
diff changeset
    89
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    90
                    writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo
2117
1ac0e10e546f Add caching for accounts information (entries are stored in memory forever)
unc0rr
parents: 2116
diff changeset
    91
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
    92
                    return $ (Map.insert clNick (currentTime, accountInfo) accountsCache, req + 1)
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    93
                `Exception.onException`
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
    94
                    (unGetChan queries q)
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    95
                else
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
    96
                do
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
    97
                    writeChan cChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry)
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
    98
                    return (accountsCache, req)
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2129
diff changeset
    99
9446
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9399
diff changeset
   100
        GetReplayName {} -> do
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9399
diff changeset
   101
            SIO.hPutStrLn hIn $ show q
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9399
diff changeset
   102
            hFlush hIn
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9399
diff changeset
   103
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9399
diff changeset
   104
            (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead)
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9399
diff changeset
   105
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9399
diff changeset
   106
            writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo
9450
2084b1b7839c Fix official server build
unc0rr
parents: 9446
diff changeset
   107
            return (accountsCache, req)
9446
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9399
diff changeset
   108
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
   109
        ClearCache -> return (Map.empty, req)
9399
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 7331
diff changeset
   110
        StoreAchievements {} -> (
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 7331
diff changeset
   111
                (SIO.hPutStrLn hIn $ show q) >>
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 7331
diff changeset
   112
                hFlush hIn >>
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 7331
diff changeset
   113
                return (accountsCache, req))
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 7331
diff changeset
   114
                `Exception.onException`
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 7331
diff changeset
   115
                (unGetChan queries q)
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   116
        SendStats {} -> (
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
   117
                (SIO.hPutStrLn hIn $ show q) >>
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   118
                hFlush hIn >>
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
   119
                return (accountsCache, req))
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   120
                `Exception.onException`
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   121
                (unGetChan queries q)
2184
f59f80e034b1 Oops, fix database process interaction
unc0rr
parents: 2172
diff changeset
   122
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
   123
    pipeDbConnectionLoop queries cChan hIn hOut updatedCache newReq
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   124
    where
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   125
        maybeException (Just a) = return a
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   126
        maybeException Nothing = ioError (userError "Can't read")
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   127
4992
408301a9d2d6 - Simplify insane TConfig code
unc0rr
parents: 4989
diff changeset
   128
pipeDbConnection ::
4982
3572eaf14340 Add dbName parameter to .ini file, fix some warnings
unc0rr
parents: 4975
diff changeset
   129
        Map.Map ByteString (UTCTime, AccountInfo)
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4982
diff changeset
   130
        -> ServerInfo
4992
408301a9d2d6 - Simplify insane TConfig code
unc0rr
parents: 4989
diff changeset
   131
        -> Int
408301a9d2d6 - Simplify insane TConfig code
unc0rr
parents: 4989
diff changeset
   132
        -> IO ()
4982
3572eaf14340 Add dbName parameter to .ini file, fix some warnings
unc0rr
parents: 4975
diff changeset
   133
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
   134
pipeDbConnection accountsCache si errNum = do
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
   135
    (updatedCache, newErrNum) <-
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
   136
        Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, errNum + 1)) $ do
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   137
            (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" [])
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   138
                    {std_in = CreatePipe,
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   139
                    std_out = CreatePipe}
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   140
            hSetBuffering hIn LineBuffering
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   141
            hSetBuffering hOut LineBuffering
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   142
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
   143
            B.hPutStrLn hIn $ dbHost si
4982
3572eaf14340 Add dbName parameter to .ini file, fix some warnings
unc0rr
parents: 4975
diff changeset
   144
            B.hPutStrLn hIn $ dbName si
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
   145
            B.hPutStrLn hIn $ dbLogin si
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
   146
            B.hPutStrLn hIn $ dbPassword si
4944
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
   147
            (c, r) <- pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache 0
e43a3da2fc22 More robust login system when db server goes away
unc0rr
parents: 4943
diff changeset
   148
            return (c, if r > 0 then 0 else errNum + 1)
2184
f59f80e034b1 Oops, fix database process interaction
unc0rr
parents: 2172
diff changeset
   149
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
   150
    when (newErrNum > 1) $ flushRequests si
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
   151
    threadDelay (3000000)
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
   152
    pipeDbConnection updatedCache si newErrNum
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 1979
diff changeset
   153
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
   154
dbConnectionLoop si =
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
   155
        if (not . B.null $ dbHost si) then
4943
21d6b2b79cfe Allow users to join official server even when there's no db connection
unc0rr
parents: 4932
diff changeset
   156
            pipeDbConnection Map.empty si 0
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2387
diff changeset
   157
        else
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4918
diff changeset
   158
            fakeDbConnection si
1979
912e450d4db2 - Add gameServer to build system
unc0rr
parents: 1970
diff changeset
   159
#else
912e450d4db2 - Add gameServer to build system
unc0rr
parents: 1970
diff changeset
   160
dbConnectionLoop = fakeDbConnection
912e450d4db2 - Add gameServer to build system
unc0rr
parents: 1970
diff changeset
   161
#endif
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   162
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4982
diff changeset
   163
startDBConnection :: ServerInfo -> IO ()
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
   164
startDBConnection serverInfo =
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
   165
    forkIO (dbConnectionLoop serverInfo) >> return ()