gameServer/OfficialServer/extdbinterface.hs
author nemo
Wed, 30 Dec 2015 23:30:00 -0500
changeset 11473 023db094b22d
parent 11320 556eafd1443a
child 11573 8fd1808b12ed
permissions -rw-r--r--
Some themers expressed desire to have translucent themes. While the current AA stuff in uLandGraphics won't really allow this to work with LandBackTex properly, seems to me it should be safe to allow alpha for LandTex. Our LandTex should all have alpha of 255 on the existing themes.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10991
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: 10017
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
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: 10017
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: 10017
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
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: 10017
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: 10017
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
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: 10017
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: 10017
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: 10017
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10017
diff changeset
    18
4906
22cc9c2b5ae5 Fix even more
unc0rr
parents: 4568
diff changeset
    19
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
2348
b39d826e1ccd Drop support for ghc 6.8, use 6.10 instead
unc0rr
parents: 2195
diff changeset
    20
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    21
module Main where
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    22
2117
1ac0e10e546f Add caching for accounts information (entries are stored in memory forever)
unc0rr
parents: 2116
diff changeset
    23
import Prelude hiding (catch)
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    24
import Control.Monad
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    25
import Control.Exception
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    26
import System.IO
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    27
import Data.Maybe
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    28
import Database.MySQL.Simple
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    29
import Database.MySQL.Simple.QueryResults
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    30
import Database.MySQL.Simple.Result
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
    31
import Data.List (lookup, elem)
9409
6564baf7dedf Store TrophyRace records in database
unc0rr
parents: 9401
diff changeset
    32
import qualified Data.ByteString.Char8 as B
9884
6e09ca662fa3 Some fixes
unc0rr
parents: 9868
diff changeset
    33
import Data.Word
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
    34
import Data.Int
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    35
--------------------------
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    36
import CoreTypes
9409
6564baf7dedf Store TrophyRace records in database
unc0rr
parents: 9401
diff changeset
    37
import Utils
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    38
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    39
2172
80d34c0b9dfe Implement sending gameserver stats to webserver
unc0rr
parents: 2117
diff changeset
    40
dbQueryAccount =
11053
a009cc19a639 Don't accept any password from players banned on the website
unC0Rr
parents: 11046
diff changeset
    41
    "SELECT CASE WHEN users.status = 1 THEN users.pass ELSE '' END, \
9435
59eec19cb31a 'c' flag for contributors
unc0rr
parents: 9427
diff changeset
    42
    \ (SELECT COUNT(users_roles.rid) FROM users_roles WHERE users.uid = users_roles.uid AND users_roles.rid = 3), \
59eec19cb31a 'c' flag for contributors
unc0rr
parents: 9427
diff changeset
    43
    \ (SELECT COUNT(users_roles.rid) FROM users_roles WHERE users.uid = users_roles.uid AND users_roles.rid = 13) \
59eec19cb31a 'c' flag for contributors
unc0rr
parents: 9427
diff changeset
    44
    \ FROM users WHERE users.name = ?"
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    45
2172
80d34c0b9dfe Implement sending gameserver stats to webserver
unc0rr
parents: 2117
diff changeset
    46
dbQueryStats =
6040
a740069c21e3 - Add unique id to replay file name
unc0rr
parents: 4982
diff changeset
    47
    "INSERT INTO gameserver_stats (players, rooms, last_update) VALUES (?, ?, UNIX_TIMESTAMP())"
2172
80d34c0b9dfe Implement sending gameserver stats to webserver
unc0rr
parents: 2117
diff changeset
    48
9409
6564baf7dedf Store TrophyRace records in database
unc0rr
parents: 9401
diff changeset
    49
dbQueryAchievement =
9868
53d1b92db6ce Store protocol number in database for replays
unc0rr
parents: 9450
diff changeset
    50
    "INSERT INTO achievements (time, typeid, userid, value, filename, location, protocol) \
9427
unc0rr
parents: 9425
diff changeset
    51
    \ VALUES (?, (SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \
9868
53d1b92db6ce Store protocol number in database for replays
unc0rr
parents: 9450
diff changeset
    52
    \ ?, ?, ?, ?)"
9409
6564baf7dedf Store TrophyRace records in database
unc0rr
parents: 9401
diff changeset
    53
11246
09a2d3988569 Also pass script information alongwith winner/achievements info, so that we could potentially have per mode ratings
unc0rr
parents: 11053
diff changeset
    54
dbQueryGamesHistory =
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11275
diff changeset
    55
    "INSERT INTO rating_games (script, protocol, filename, time, vamp, ropes, infattacks) \
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11275
diff changeset
    56
    \ VALUES (?, ?, ?, ?, ?, ?, ?)"
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
    57
11275
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
    58
dbQueryGameId = "SELECT LAST_INSERT_ID()"
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
    59
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
    60
dbQueryGamesHistoryPlaces = "INSERT INTO rating_players (userid, gameid, place) \
11275
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
    61
    \ VALUES ((SELECT uid FROM users WHERE name = ?), ?, ?)"
11246
09a2d3988569 Also pass script information alongwith winner/achievements info, so that we could potentially have per mode ratings
unc0rr
parents: 11053
diff changeset
    62
9446
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
    63
dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?"
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
    64
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
    65
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    66
dbInteractionLoop dbConn = forever $ do
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    67
    q <- liftM read getLine
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
    68
    hPutStrLn stderr $ show q
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4906
diff changeset
    69
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
    70
    case q of
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4906
diff changeset
    71
        CheckAccount clId clUid clNick _ -> do
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    72
                results <- query dbConn dbQueryAccount $ Only clNick
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    73
                let response = case results of
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    74
                        [(pass, adm, contr)] ->
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    75
                            (
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    76
                                clId,
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    77
                                clUid,
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    78
                                HasAccount
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    79
                                    (pass)
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    80
                                    (adm == Just (1 :: Int))
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    81
                                    (contr == Just (1 :: Int))
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    82
                            )
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    83
                        _ ->
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    84
                            (clId, clUid, Guest)
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
    85
                print response
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
    86
                hFlush stdout
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
    87
9446
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
    88
        GetReplayName clId clUid fileId -> do
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    89
                results <- query dbConn dbQueryReplayFilename $ Only fileId
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    90
                let fn = if null results then "" else fromOnly $ head results
9446
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
    91
                print (clId, clUid, ReplayName fn)
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
    92
                hFlush stdout
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
    93
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
    94
        SendStats clients rooms ->
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
    95
                void $ execute dbConn dbQueryStats (clients, rooms)
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11275
diff changeset
    96
        StoreAchievements p fileName teams g info ->
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11275
diff changeset
    97
            sequence_ $ parseStats dbConn p fileName teams g info
2172
80d34c0b9dfe Implement sending gameserver stats to webserver
unc0rr
parents: 2117
diff changeset
    98
9446
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
    99
10991
189b2370353d Time is stored in bytestring now
unc0rr
parents: 10990
diff changeset
   100
--readTime = read . B.unpack . B.take 19 . B.drop 8
189b2370353d Time is stored in bytestring now
unc0rr
parents: 10990
diff changeset
   101
readTime = B.take 19 . B.drop 8
9446
4fd5df03deb8 Start support of achievement replay query:
unc0rr
parents: 9437
diff changeset
   102
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   103
parseStats :: 
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   104
    Connection
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   105
    -> Word16 
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   106
    -> B.ByteString 
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   107
    -> [(B.ByteString, B.ByteString)] 
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11275
diff changeset
   108
    -> GameDetails
11246
09a2d3988569 Also pass script information alongwith winner/achievements info, so that we could potentially have per mode ratings
unc0rr
parents: 11053
diff changeset
   109
    -> [B.ByteString]
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   110
    -> [IO Int64]
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11275
diff changeset
   111
parseStats dbConn p fileName teams (GameDetails script infRopes vamp infAttacks) = ps
9409
6564baf7dedf Store TrophyRace records in database
unc0rr
parents: 9401
diff changeset
   112
    where
9425
49eb707b9367 Extract time from file name, assuming it is stored in 'replay' folder
unc0rr
parents: 9421
diff changeset
   113
    time = readTime fileName
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   114
    ps :: [B.ByteString] -> [IO Int64]
9421
90fe753b3654 Fix 'non-exhaustive pattern' crash
unc0rr
parents: 9409
diff changeset
   115
    ps [] = []
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11275
diff changeset
   116
    ps ("DRAW" : bs) = execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time, vamp, infRopes, infAttacks)
11275
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   117
        : places (map drawParams teams)
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   118
        : ps bs
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11275
diff changeset
   119
    ps ("WINNERS" : n : bs) = let winNum = readInt_ n in execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time, vamp, infRopes, infAttacks)
11275
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   120
        : places (map (placeParams (take winNum bs)) teams)
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   121
        : ps (drop winNum bs)
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   122
    ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = execute dbConn dbQueryAchievement
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   123
        ( time
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   124
        , typ
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   125
        , fromMaybe "" (lookup teamname teams)
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   126
        , (readInt_ value) :: Int
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   127
        , fileName
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   128
        , location
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   129
        , (fromIntegral p) :: Int
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   130
        ) : ps bs
9421
90fe753b3654 Fix 'non-exhaustive pattern' crash
unc0rr
parents: 9409
diff changeset
   131
    ps (b:bs) = ps bs
11268
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   132
    drawParams t = (snd t, 0 :: Int)
096811aa3c55 Let's try to store games info necessary for ratings
unc0rr
parents: 11246
diff changeset
   133
    placeParams winners t = (snd t, if (fst t) `elem` winners then 1 else 2 :: Int)
11275
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   134
    places :: [(B.ByteString, Int)] -> IO Int64
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   135
    places params = do
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   136
        res <- query_ dbConn dbQueryGameId
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   137
        let gameId = case res of
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   138
                [Only a] -> a
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   139
                _ -> 0
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   140
        mapM_ (execute dbConn dbQueryGamesHistoryPlaces . midInsert gameId) params
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   141
        return 0
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   142
    midInsert :: Int -> (a, b) -> (a, Int, b)
13ce106c8836 Workaround mysql-simple library stupiness regarding executeMany
unc0rr
parents: 11268
diff changeset
   143
    midInsert g (a, b) = (a, g, b)
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
   144
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
   145
dbConnectionLoop mySQLConnectionInfo =
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   146
    Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
   147
        bracket
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   148
            (connect mySQLConnectionInfo)
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   149
            close
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4921
diff changeset
   150
            dbInteractionLoop
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
   151
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
   152
4921
2efad3acbb74 Fix build of official server
unc0rr
parents: 4906
diff changeset
   153
--processRequest :: DBQuery -> IO String
2efad3acbb74 Fix build of official server
unc0rr
parents: 4906
diff changeset
   154
--processRequest (CheckAccount clId clUid clNick clHost) = return $ show (clclId, clUid, Guest)
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
   155
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
   156
main = do
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
   157
        dbHost <- getLine
4982
3572eaf14340 Add dbName parameter to .ini file, fix some warnings
unc0rr
parents: 4932
diff changeset
   158
        dbName <- getLine
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
   159
        dbLogin <- getLine
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
   160
        dbPassword <- getLine
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
   161
10907
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   162
        let mySQLConnectInfo = defaultConnectInfo {
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   163
            connectHost = dbHost
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   164
            , connectDatabase = dbName
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   165
            , connectUser = dbLogin
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   166
            , connectPassword = dbPassword
9b8e9813c6f8 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me
unc0rr
parents: 10460
diff changeset
   167
            }
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
diff changeset
   168
2869
93cc73dcc421 Replace tabs with spaces here too
unc0rr
parents: 2348
diff changeset
   169
        dbConnectionLoop mySQLConnectInfo