12 -------------------------- |
12 -------------------------- |
13 import CoreTypes |
13 import CoreTypes |
14 |
14 |
15 |
15 |
16 dbQueryAccount = |
16 dbQueryAccount = |
17 "select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?" |
17 "SELECT users.pass, users_roles.rid FROM users LEFT JOIN users_roles ON users.uid = users_roles.uid WHERE users.name = ?" |
18 |
18 |
19 dbQueryStats = |
19 dbQueryStats = |
20 "UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()" |
20 "UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()" |
21 |
21 |
22 dbInteractionLoop dbConn = forever $ do |
22 dbInteractionLoop dbConn = forever $ do |
23 q <- (getLine >>= return . read) |
23 q <- (getLine >>= return . read) |
24 hPutStrLn stderr $ show q |
24 hPutStrLn stderr $ show q |
25 |
25 |
26 case q of |
26 case q of |
27 CheckAccount clUid clNick _ -> do |
27 CheckAccount clUid clNick _ -> do |
28 statement <- prepare dbConn dbQueryAccount |
28 statement <- prepare dbConn dbQueryAccount |
29 execute statement [SqlString $ clNick] |
29 execute statement [SqlString $ clNick] |
30 passAndRole <- fetchRow statement |
30 passAndRole <- fetchRow statement |
31 finish statement |
31 finish statement |
32 let response = |
32 let response = |
33 if isJust passAndRole then |
33 if isJust passAndRole then |
34 ( |
34 ( |
35 clUid, |
35 clUid, |
36 HasAccount |
36 HasAccount |
37 (fromSql $ head $ fromJust $ passAndRole) |
37 (fromSql $ head $ fromJust $ passAndRole) |
38 ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) |
38 ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) |
39 ) |
39 ) |
40 else |
40 else |
41 (clUid, Guest) |
41 (clUid, Guest) |
42 putStrLn (show response) |
42 putStrLn (show response) |
43 hFlush stdout |
43 hFlush stdout |
44 |
44 |
45 SendStats clients rooms -> |
45 SendStats clients rooms -> |
46 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return () |
46 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return () |
47 |
47 |
48 |
48 |
49 dbConnectionLoop mySQLConnectionInfo = |
49 dbConnectionLoop mySQLConnectionInfo = |
50 Control.Exception.handle (\(_ :: IOException) -> return ()) $ handleSqlError $ |
50 Control.Exception.handle (\(_ :: IOException) -> return ()) $ handleSqlError $ |
51 bracket |
51 bracket |
52 (connectMySQL mySQLConnectionInfo) |
52 (connectMySQL mySQLConnectionInfo) |
53 (disconnect) |
53 (disconnect) |
54 (dbInteractionLoop) |
54 (dbInteractionLoop) |
55 |
55 |
56 |
56 |
57 processRequest :: DBQuery -> IO String |
57 processRequest :: DBQuery -> IO String |
58 processRequest (CheckAccount clUid clNick clHost) = return $ show (clUid, Guest) |
58 processRequest (CheckAccount clUid clNick clHost) = return $ show (clUid, Guest) |
59 |
59 |
60 main = do |
60 main = do |
61 dbHost <- getLine |
61 dbHost <- getLine |
62 dbLogin <- getLine |
62 dbLogin <- getLine |
63 dbPassword <- getLine |
63 dbPassword <- getLine |
64 |
64 |
65 let mySQLConnectInfo = defaultMySQLConnectInfo {mysqlHost = dbHost, mysqlDatabase = "hedge_main", mysqlUser = dbLogin, mysqlPassword = dbPassword} |
65 let mySQLConnectInfo = defaultMySQLConnectInfo {mysqlHost = dbHost, mysqlDatabase = "hedge_main", mysqlUser = dbLogin, mysqlPassword = dbPassword} |
66 |
66 |
67 dbConnectionLoop mySQLConnectInfo |
67 dbConnectionLoop mySQLConnectInfo |