1 module Main where

     2 

     3 import Prelude hiding (catch);

     4 import Control.Monad

     5 import Control.Exception

     6 import System.IO

     7 import Maybe

     8 import Database.HDBC

     9 import Database.HDBC.MySQL

    10 --------------------------

    11 import CoreTypes

    12 

    13 

    14 dbQueryString =

    15 	"select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?"

    16 

    17 dbInteractionLoop dbConn = forever $ do

    18 	q <- (getLine >>= return . read)

    19 	

    20 	response <- case q of

    21 		CheckAccount clUid clNick _ -> do

    22 				statement <- prepare dbConn dbQueryString

    23 				execute statement [SqlString $ clNick]

    24 				passAndRole <- fetchRow statement

    25 				finish statement

    26 				if isJust passAndRole then

    27 					return $ (

    28 								clUid,

    29 								HasAccount

    30 									(fromSql $ head $ fromJust $ passAndRole)

    31 									((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int)))

    32 							)

    33 					else

    34 					return $ (clUid, Guest)

    35 

    36 	putStrLn (show response)

    37 	hFlush stdout

    38 

    39 dbConnectionLoop mySQLConnectionInfo =

    40 	Control.Exception.handle (\e -> return ()) $ handleSqlError $

    41 		bracket

    42 			(connectMySQL mySQLConnectionInfo)

    43 			(disconnect)

    44 			(dbInteractionLoop)

    45 

    46 

    47 processRequest :: DBQuery -> IO String

    48 processRequest (CheckAccount clUid clNick clHost) = return $ show (clUid, Guest)

    49 

    50 main = do

    51 		dbHost <- getLine

    52 		dbLogin <- getLine

    53 		dbPassword <- getLine

    54 

    55 		let mySQLConnectInfo = defaultMySQLConnectInfo {mysqlHost = dbHost, mysqlDatabase = "hedge_main", mysqlUser = dbLogin, mysqlPassword = dbPassword}

    56 

    57 		dbConnectionLoop mySQLConnectInfo