9 import Database.HDBC.MySQL |
9 import Database.HDBC.MySQL |
10 -------------------------- |
10 -------------------------- |
11 import CoreTypes |
11 import CoreTypes |
12 |
12 |
13 |
13 |
14 dbQueryString = |
14 dbQueryAccount = |
15 "select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?" |
15 "select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?" |
|
16 |
|
17 dbQueryStats = |
|
18 "UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()" |
16 |
19 |
17 dbInteractionLoop dbConn = forever $ do |
20 dbInteractionLoop dbConn = forever $ do |
18 q <- (getLine >>= return . read) |
21 q <- (getLine >>= return . read) |
19 |
22 |
20 response <- case q of |
23 case q of |
21 CheckAccount clUid clNick _ -> do |
24 CheckAccount clUid clNick _ -> do |
22 statement <- prepare dbConn dbQueryString |
25 statement <- prepare dbConn dbQueryAccount |
23 execute statement [SqlString $ clNick] |
26 execute statement [SqlString $ clNick] |
24 passAndRole <- fetchRow statement |
27 passAndRole <- fetchRow statement |
25 finish statement |
28 finish statement |
26 if isJust passAndRole then |
29 let response = |
27 return $ ( |
30 if isJust passAndRole then |
28 clUid, |
31 ( |
29 HasAccount |
32 clUid, |
30 (fromSql $ head $ fromJust $ passAndRole) |
33 HasAccount |
31 ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) |
34 (fromSql $ head $ fromJust $ passAndRole) |
32 ) |
35 ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) |
|
36 ) |
33 else |
37 else |
34 return $ (clUid, Guest) |
38 (clUid, Guest) |
|
39 putStrLn (show response) |
35 |
40 |
36 putStrLn (show response) |
41 SendStats clients rooms -> do |
|
42 statement <- prepare dbConn dbQueryStats |
|
43 execute statement [SqlInt32 $ fromIntegral rooms, SqlInt32 $ fromIntegral clients] |
|
44 finish statement |
|
45 |
37 hFlush stdout |
46 hFlush stdout |
38 |
47 |
39 dbConnectionLoop mySQLConnectionInfo = |
48 dbConnectionLoop mySQLConnectionInfo = |
40 Control.Exception.handle (\e -> return ()) $ handleSqlError $ |
49 Control.Exception.handle (\e -> return ()) $ handleSqlError $ |
41 bracket |
50 bracket |