Attempt to fix
issue #125. The password pop-up doesn't appear every time when going into the official server anymore, now it only does it when the password is blank. If a user enters an invalid password, the password is set blank to avoid the user going back to the official server just to be rejected. When entering an invalid password, the unknown error dialog doesn't show up anymore, but the connection lost to server one still does. This fixes the bug where the user would be spammed with error messages. The user can also now change his password in the settings page.
{-# 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 =
"UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = 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