7 import Control.Exception |
7 import Control.Exception |
8 import System.IO |
8 import System.IO |
9 import Data.Maybe |
9 import Data.Maybe |
10 import Database.HDBC |
10 import Database.HDBC |
11 import Database.HDBC.MySQL |
11 import Database.HDBC.MySQL |
|
12 import Data.List (lookup) |
|
13 import qualified Data.ByteString.Char8 as B |
12 -------------------------- |
14 -------------------------- |
13 import CoreTypes |
15 import CoreTypes |
|
16 import Utils |
14 |
17 |
15 |
18 |
16 dbQueryAccount = |
19 dbQueryAccount = |
17 "SELECT users.pass, users_roles.rid FROM users LEFT JOIN users_roles ON (users.uid = users_roles.uid AND users_roles.rid = 3) WHERE users.name = ?" |
20 "SELECT users.pass, users_roles.rid FROM users LEFT JOIN users_roles ON (users.uid = users_roles.uid AND users_roles.rid = 3) WHERE users.name = ?" |
18 |
21 |
19 dbQueryStats = |
22 dbQueryStats = |
20 "INSERT INTO gameserver_stats (players, rooms, last_update) VALUES (?, ?, UNIX_TIMESTAMP())" |
23 "INSERT INTO gameserver_stats (players, rooms, last_update) VALUES (?, ?, UNIX_TIMESTAMP())" |
|
24 |
|
25 dbQueryAchievement = |
|
26 "INSERT INTO achievements (typeid, userid, value, filename, location) \ |
|
27 \ VALUES ((SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \ |
|
28 \ ?, ?, ?)" |
21 |
29 |
22 dbInteractionLoop dbConn = forever $ do |
30 dbInteractionLoop dbConn = forever $ do |
23 q <- liftM read getLine |
31 q <- liftM read getLine |
24 hPutStrLn stderr $ show q |
32 hPutStrLn stderr $ show q |
25 |
33 |
43 print response |
51 print response |
44 hFlush stdout |
52 hFlush stdout |
45 |
53 |
46 SendStats clients rooms -> |
54 SendStats clients rooms -> |
47 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return () |
55 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return () |
|
56 --StoreAchievements (B.pack fileName) (map toPair teams) info |
|
57 StoreAchievements fileName teams info -> |
|
58 mapM_ (run dbConn dbQueryAchievement) $ (parseStats fileName teams) info |
48 |
59 |
49 StoreAchievements {} -> return () |
60 parseStats :: B.ByteString -> [(B.ByteString, B.ByteString)] -> [B.ByteString] -> [[SqlValue]] |
50 |
61 parseStats fileName teams = ps |
|
62 where |
|
63 ps ("DRAW" : bs) = ps bs |
|
64 ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs |
|
65 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = |
|
66 [SqlByteString typ |
|
67 , SqlByteString $ fromMaybe "" (lookup teamname teams) |
|
68 , SqlInt32 (readInt_ value) |
|
69 , SqlByteString fileName |
|
70 , SqlByteString location |
|
71 ] : ps bs |
51 |
72 |
52 dbConnectionLoop mySQLConnectionInfo = |
73 dbConnectionLoop mySQLConnectionInfo = |
53 Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $ |
74 Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $ |
54 bracket |
75 bracket |
55 (connectMySQL mySQLConnectionInfo) |
76 (connectMySQL mySQLConnectionInfo) |