gameServer/OfficialServer/extdbinterface.hs
changeset 4932 f11d80bac7ed
parent 4921 2efad3acbb74
child 4982 3572eaf14340
equal deleted inserted replaced
4931:da43c36a6e92 4932:f11d80bac7ed
     4 
     4 
     5 import Prelude hiding (catch)
     5 import Prelude hiding (catch)
     6 import Control.Monad
     6 import Control.Monad
     7 import Control.Exception
     7 import Control.Exception
     8 import System.IO
     8 import System.IO
     9 import Maybe
     9 import Data.Maybe
    10 import Database.HDBC
    10 import Database.HDBC
    11 import Database.HDBC.MySQL
    11 import Database.HDBC.MySQL
    12 --------------------------
    12 --------------------------
    13 import CoreTypes
    13 import CoreTypes
    14 
    14 
    18 
    18 
    19 dbQueryStats =
    19 dbQueryStats =
    20     "UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()"
    20     "UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()"
    21 
    21 
    22 dbInteractionLoop dbConn = forever $ do
    22 dbInteractionLoop dbConn = forever $ do
    23     q <- (getLine >>= return . read)
    23     q <- liftM read getLine
    24     hPutStrLn stderr $ show q
    24     hPutStrLn stderr $ show q
    25 
    25 
    26     case q of
    26     case q of
    27         CheckAccount clId clUid clNick _ -> do
    27         CheckAccount clId clUid clNick _ -> do
    28                 statement <- prepare dbConn dbQueryAccount
    28                 statement <- prepare dbConn dbQueryAccount
    29                 execute statement [SqlByteString $ clNick]
    29                 execute statement [SqlByteString clNick]
    30                 passAndRole <- fetchRow statement
    30                 passAndRole <- fetchRow statement
    31                 finish statement
    31                 finish statement
    32                 let response = 
    32                 let response = 
    33                         if isJust passAndRole then
    33                         if isJust passAndRole then
    34                         (
    34                         (
    35                             clId,
    35                             clId,
    36                             clUid,
    36                             clUid,
    37                             HasAccount
    37                             HasAccount
    38                                 (fromSql $ head $ fromJust $ passAndRole)
    38                                 (fromSql . head . fromJust $ passAndRole)
    39                                 ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int)))
    39                                 (fromSql (last . fromJust $ passAndRole) == Just (3 :: Int))
    40                         )
    40                         )
    41                         else
    41                         else
    42                         (clId, clUid, Guest)
    42                         (clId, clUid, Guest)
    43                 putStrLn (show response)
    43                 print response
    44                 hFlush stdout
    44                 hFlush stdout
    45 
    45 
    46         SendStats clients rooms ->
    46         SendStats clients rooms ->
    47                 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return ()
    47                 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return ()
    48 
    48 
    49 
    49 
    50 dbConnectionLoop mySQLConnectionInfo =
    50 dbConnectionLoop mySQLConnectionInfo =
    51     Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $
    51     Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $
    52         bracket
    52         bracket
    53             (connectMySQL mySQLConnectionInfo)
    53             (connectMySQL mySQLConnectionInfo)
    54             (disconnect)
    54             disconnect
    55             (dbInteractionLoop)
    55             dbInteractionLoop
    56 
    56 
    57 
    57 
    58 --processRequest :: DBQuery -> IO String
    58 --processRequest :: DBQuery -> IO String
    59 --processRequest (CheckAccount clId clUid clNick clHost) = return $ show (clclId, clUid, Guest)
    59 --processRequest (CheckAccount clId clUid clNick clHost) = return $ show (clclId, clUid, Guest)
    60 
    60