# HG changeset patch # User unc0rr # Date 1428699485 -10800 # Node ID 9b8e9813c6f812cc98c2c8dd5b799b6c62c561bb # Parent c0919d7e5ce9862b3a1289a61d3ed0a45153a664 Switch to mysql-simple, as hdbc package seems to be abandoned and anyway never satisfied me diff -r c0919d7e5ce9 -r 9b8e9813c6f8 gameServer/OfficialServer/extdbinterface.hs --- a/gameServer/OfficialServer/extdbinterface.hs Fri Apr 10 11:14:53 2015 -0400 +++ b/gameServer/OfficialServer/extdbinterface.hs Fri Apr 10 23:58:05 2015 +0300 @@ -25,8 +25,9 @@ import Control.Exception import System.IO import Data.Maybe -import Database.HDBC -import Database.HDBC.MySQL +import Database.MySQL.Simple +import Database.MySQL.Simple.QueryResults +import Database.MySQL.Simple.Result import Data.List (lookup) import qualified Data.ByteString.Char8 as B import Data.Word @@ -58,45 +59,44 @@ case q of CheckAccount clId clUid clNick _ -> do - statement <- prepare dbConn dbQueryAccount - execute statement [SqlByteString clNick] - result <- fetchRow statement - finish statement - let response = - if isJust result then let [pass, adm, contr] = fromJust result in - ( - clId, - clUid, - HasAccount - (fromSql pass) - (fromSql adm == Just (1 :: Int)) - (fromSql contr == Just (1 :: Int)) - ) - else - (clId, clUid, Guest) + results <- query dbConn dbQueryAccount $ Only clNick + let response = case results of + [(pass, adm, contr)] -> + ( + clId, + clUid, + HasAccount + (pass) + (adm == Just (1 :: Int)) + (contr == Just (1 :: Int)) + ) + _ -> + (clId, clUid, Guest) print response hFlush stdout GetReplayName clId clUid fileId -> do - statement <- prepare dbConn dbQueryReplayFilename - execute statement [SqlByteString fileId] - result <- fetchRow statement - finish statement - let fn = if (isJust result) then fromJust . fromSql . head . fromJust $ result else "" + results <- query dbConn dbQueryReplayFilename $ Only fileId + let fn = if null results then "" else fromOnly $ head results print (clId, clUid, ReplayName fn) hFlush stdout SendStats clients rooms -> - run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return () + void $ execute dbConn dbQueryStats (clients, rooms) --StoreAchievements (B.pack fileName) (map toPair teams) info StoreAchievements p fileName teams info -> - mapM_ (run dbConn dbQueryAchievement) $ (parseStats p fileName teams) info + void $ executeMany dbConn dbQueryAchievement $ (parseStats p fileName teams) info readTime = read . B.unpack . B.take 19 . B.drop 8 -parseStats :: Word16 -> B.ByteString -> [(B.ByteString, B.ByteString)] -> [B.ByteString] -> [[SqlValue]] +parseStats :: + Word16 + -> B.ByteString + -> [(B.ByteString, B.ByteString)] + -> [B.ByteString] + -> [(B.ByteString, B.ByteString, B.ByteString, Int, B.ByteString, B.ByteString, Int)] parseStats p fileName teams = ps where time = readTime fileName @@ -104,22 +104,22 @@ ps ("DRAW" : bs) = ps bs ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = - [ SqlUTCTime time - , SqlByteString typ - , SqlByteString $ fromMaybe "" (lookup teamname teams) - , SqlInt32 (readInt_ value) - , SqlByteString fileName - , SqlByteString location - , SqlInt32 $ fromIntegral p - ] : ps bs + ( time + , typ + , fromMaybe "" (lookup teamname teams) + , readInt_ value + , fileName + , location + , fromIntegral p + ) : ps bs ps (b:bs) = ps bs dbConnectionLoop mySQLConnectionInfo = - Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $ + Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $ bracket - (connectMySQL mySQLConnectionInfo) - disconnect + (connect mySQLConnectionInfo) + close dbInteractionLoop @@ -132,6 +132,11 @@ dbLogin <- getLine dbPassword <- getLine - let mySQLConnectInfo = defaultMySQLConnectInfo {mysqlHost = dbHost, mysqlDatabase = dbName, mysqlUser = dbLogin, mysqlPassword = dbPassword} + let mySQLConnectInfo = defaultConnectInfo { + connectHost = dbHost + , connectDatabase = dbName + , connectUser = dbLogin + , connectPassword = dbPassword + } dbConnectionLoop mySQLConnectInfo