4 DBQuery(HasRegistered, CheckPassword) |
4 DBQuery(HasRegistered, CheckPassword) |
5 ) where |
5 ) where |
6 |
6 |
7 import Database.HDBC |
7 import Database.HDBC |
8 import Database.HDBC.MySQL |
8 import Database.HDBC.MySQL |
9 |
|
10 import System.IO |
9 import System.IO |
11 import Control.Concurrent |
10 import Control.Concurrent |
12 import Control.Concurrent.STM |
|
13 import Control.Exception |
11 import Control.Exception |
14 |
12 import Monad |
15 data DBQuery = |
13 ------------------------ |
16 HasRegistered String |
14 import CoreTypes |
17 | CheckPassword String |
|
18 |
15 |
19 dbInteractionLoop queries dbConn = do |
16 dbInteractionLoop queries dbConn = do |
20 q <- atomically $ readTChan queries |
17 q <- readChan queries |
21 case q of |
18 case q of |
22 HasRegistered queryStr -> putStrLn queryStr |
19 HasRegistered queryStr -> putStrLn queryStr |
23 CheckPassword queryStr -> putStrLn queryStr |
20 CheckPassword queryStr -> putStrLn queryStr |
24 |
21 |
25 dbInteractionLoop queries dbConn |
22 dbInteractionLoop queries dbConn |
26 |
23 |
27 dbConnectionLoop queries = do |
24 dbConnectionLoop serverInfo = do |
28 Control.Exception.handle (\e -> print e) $ handleSqlError $ |
25 Control.Exception.handle (\e -> print e) $ handleSqlError $ |
29 bracket |
26 bracket |
30 (connectMySQL defaultMySQLConnectInfo { mysqlHost = "192.168.50.5", mysqlDatabase = "glpi" }) |
27 (connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo }) |
31 (disconnect) |
28 (disconnect) |
32 (dbInteractionLoop queries) |
29 (dbInteractionLoop $ dbQueries serverInfo) |
33 |
30 |
34 threadDelay (15 * 10^6) |
31 threadDelay (15 * 10^6) |
35 dbConnectionLoop queries |
32 dbConnectionLoop serverInfo |
36 |
33 |
37 startDBConnection queries = forkIO $ dbConnectionLoop queries |
34 startDBConnection serverInfo = |
|
35 when (not . null $ dbHost serverInfo) ((forkIO $ dbConnectionLoop serverInfo) >> return ()) |