|
1804
|
1 |
module OfficialServer.DBInteraction
|
|
|
2 |
(
|
|
|
3 |
startDBConnection,
|
|
|
4 |
DBQuery(HasRegistered, CheckPassword)
|
|
|
5 |
) where
|
|
|
6 |
|
|
|
7 |
import Database.HDBC
|
|
|
8 |
import Database.HDBC.MySQL
|
|
|
9 |
import System.IO
|
|
|
10 |
import Control.Concurrent
|
|
|
11 |
import Control.Exception
|
|
1833
|
12 |
import Monad
|
|
1834
|
13 |
import Maybe
|
|
1833
|
14 |
------------------------
|
|
|
15 |
import CoreTypes
|
|
1804
|
16 |
|
|
|
17 |
dbInteractionLoop queries dbConn = do
|
|
1833
|
18 |
q <- readChan queries
|
|
1804
|
19 |
case q of
|
|
1834
|
20 |
HasRegistered name -> do
|
|
|
21 |
statement <- prepare dbConn "SELECT uid FROM users WHERE name=?"
|
|
|
22 |
execute statement [SqlString name]
|
|
|
23 |
uid <- fetchRow statement
|
|
|
24 |
finish statement
|
|
|
25 |
putStrLn (show $ isJust uid)
|
|
1804
|
26 |
CheckPassword queryStr -> putStrLn queryStr
|
|
|
27 |
|
|
|
28 |
dbInteractionLoop queries dbConn
|
|
|
29 |
|
|
1833
|
30 |
dbConnectionLoop serverInfo = do
|
|
1804
|
31 |
Control.Exception.handle (\e -> print e) $ handleSqlError $
|
|
|
32 |
bracket
|
|
1833
|
33 |
(connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo })
|
|
1804
|
34 |
(disconnect)
|
|
1833
|
35 |
(dbInteractionLoop $ dbQueries serverInfo)
|
|
1804
|
36 |
|
|
|
37 |
threadDelay (15 * 10^6)
|
|
1833
|
38 |
dbConnectionLoop serverInfo
|
|
1804
|
39 |
|
|
1833
|
40 |
startDBConnection serverInfo =
|
|
|
41 |
when (not . null $ dbHost serverInfo) ((forkIO $ dbConnectionLoop serverInfo) >> return ())
|