gameServer/OfficialServer/extdbinterface.hs
author dag10
Mon, 21 Jan 2013 21:52:49 -0500
changeset 8424 225ede46e3dc
parent 6040 a740069c21e3
child 8909 95542e198bc8
permissions -rw-r--r--
On pagenetgame, when window is too small the map/game options becomes a tabbed interface to allow for a few lines of chat to always be visible. Restored HWForm's min height to 580. Fixed the 2px alignment issue with the map list and map previews' top edges that unC0Rr was whining about. <3

{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}

module Main where

import Prelude hiding (catch)
import Control.Monad
import Control.Exception
import System.IO
import Data.Maybe
import Database.HDBC
import Database.HDBC.MySQL
--------------------------
import CoreTypes


dbQueryAccount =
    "SELECT users.pass, users_roles.rid FROM users LEFT JOIN users_roles ON users.uid = users_roles.uid WHERE users.name = ?"

dbQueryStats =
    "INSERT INTO gameserver_stats (players, rooms, last_update) VALUES (?, ?, UNIX_TIMESTAMP())"

dbInteractionLoop dbConn = forever $ do
    q <- liftM read getLine
    hPutStrLn stderr $ show q

    case q of
        CheckAccount clId clUid clNick _ -> do
                statement <- prepare dbConn dbQueryAccount
                execute statement [SqlByteString clNick]
                passAndRole <- fetchRow statement
                finish statement
                let response = 
                        if isJust passAndRole then
                        (
                            clId,
                            clUid,
                            HasAccount
                                (fromSql . head . fromJust $ passAndRole)
                                (fromSql (last . fromJust $ passAndRole) == Just (3 :: Int))
                        )
                        else
                        (clId, clUid, Guest)
                print response
                hFlush stdout

        SendStats clients rooms ->
                run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return ()


dbConnectionLoop mySQLConnectionInfo =
    Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $
        bracket
            (connectMySQL mySQLConnectionInfo)
            disconnect
            dbInteractionLoop


--processRequest :: DBQuery -> IO String
--processRequest (CheckAccount clId clUid clNick clHost) = return $ show (clclId, clUid, Guest)

main = do
        dbHost <- getLine
        dbName <- getLine
        dbLogin <- getLine
        dbPassword <- getLine

        let mySQLConnectInfo = defaultMySQLConnectInfo {mysqlHost = dbHost, mysqlDatabase = dbName, mysqlUser = dbLogin, mysqlPassword = dbPassword}

        dbConnectionLoop mySQLConnectInfo