gameServer/OfficialServer/DBInteraction.hs
author unc0rr
Wed, 25 Feb 2009 17:12:32 +0000
changeset 1841 fba7210b438b
parent 1839 5dd4cb7fd7e5
child 1847 2178c0fc838c
permissions -rw-r--r--
Retrieve client password from web database and ask for it

module OfficialServer.DBInteraction
(
	startDBConnection
) where

import Prelude hiding (catch);
import Database.HDBC
import Database.HDBC.MySQL
import System.IO
import Control.Concurrent
import Control.Exception
import Monad
import Maybe
import System.Log.Logger
------------------------
import CoreTypes


-------------------------------------------------------------------
-- borrowed from base 4.0.0 ---------------------------------------
onException :: IO a -> IO b -> IO a                              --
onException io what = io `catch` \e -> do what                   --
                                          throw (e :: Exception) --
-- to be deleted --------------------------------------------------
-------------------------------------------------------------------


dbInteractionLoop queries coreChan dbConn = do
	q <- readChan queries
	case q of
		CheckAccount clID name -> do
				statement <- prepare dbConn "SELECT pass FROM users WHERE name=?"
				execute statement [SqlString name]
				pass <- fetchRow statement
				finish statement
				if isJust pass then
					writeChan coreChan $ ClientAccountInfo clID (HasAccount $ fromSql $ head $ fromJust $ pass)
					else
					writeChan coreChan $ ClientAccountInfo clID Guest
			`onException`
				(unGetChan queries $ CheckAccount clID name)
		
		CheckPassword queryStr -> putStrLn queryStr

	dbInteractionLoop queries coreChan dbConn

dbConnectionLoop serverInfo = do
	Control.Exception.handle (\e -> infoM "Database" $ show e) $ handleSqlError $
		bracket
			(connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo })
			(disconnect)
			(dbInteractionLoop (dbQueries serverInfo) (coreChan serverInfo))

	threadDelay (5 * 10^6)
	dbConnectionLoop serverInfo

startDBConnection serverInfo =
	when (not . null $ dbHost serverInfo) ((forkIO $ dbConnectionLoop serverInfo) >> return ())