Fix QSettings problems:
- Reopen file in ReadOnly mode if it was open in ReadWrite mode
and is being read. This is needed for stupid QSettings which
opens file in ReadWrite mode just to call readAll() on it.
- Implement setSize(0)
{-# 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