gameServer/OfficialServer/extdbinterface.hs
author antonc27 <antonc27@mail.ru>
Mon, 09 Nov 2015 05:02:53 +0100
branchios-revival
changeset 11327 a0163b8302c5
parent 11320 556eafd1443a
child 11573 8fd1808b12ed
permissions -rw-r--r--
- Fix for wrong footer labels size on autorotation on GameConfig screen
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