56 q <- liftM read getLine |
57 q <- liftM read getLine |
57 hPutStrLn stderr $ show q |
58 hPutStrLn stderr $ show q |
58 |
59 |
59 case q of |
60 case q of |
60 CheckAccount clId clUid clNick _ -> do |
61 CheckAccount clId clUid clNick _ -> do |
61 statement <- prepare dbConn dbQueryAccount |
62 results <- query dbConn dbQueryAccount $ Only clNick |
62 execute statement [SqlByteString clNick] |
63 let response = case results of |
63 result <- fetchRow statement |
64 [(pass, adm, contr)] -> |
64 finish statement |
65 ( |
65 let response = |
66 clId, |
66 if isJust result then let [pass, adm, contr] = fromJust result in |
67 clUid, |
67 ( |
68 HasAccount |
68 clId, |
69 (pass) |
69 clUid, |
70 (adm == Just (1 :: Int)) |
70 HasAccount |
71 (contr == Just (1 :: Int)) |
71 (fromSql pass) |
72 ) |
72 (fromSql adm == Just (1 :: Int)) |
73 _ -> |
73 (fromSql contr == Just (1 :: Int)) |
74 (clId, clUid, Guest) |
74 ) |
|
75 else |
|
76 (clId, clUid, Guest) |
|
77 print response |
75 print response |
78 hFlush stdout |
76 hFlush stdout |
79 |
77 |
80 GetReplayName clId clUid fileId -> do |
78 GetReplayName clId clUid fileId -> do |
81 statement <- prepare dbConn dbQueryReplayFilename |
79 results <- query dbConn dbQueryReplayFilename $ Only fileId |
82 execute statement [SqlByteString fileId] |
80 let fn = if null results then "" else fromOnly $ head results |
83 result <- fetchRow statement |
|
84 finish statement |
|
85 let fn = if (isJust result) then fromJust . fromSql . head . fromJust $ result else "" |
|
86 print (clId, clUid, ReplayName fn) |
81 print (clId, clUid, ReplayName fn) |
87 hFlush stdout |
82 hFlush stdout |
88 |
83 |
89 SendStats clients rooms -> |
84 SendStats clients rooms -> |
90 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return () |
85 void $ execute dbConn dbQueryStats (clients, rooms) |
91 --StoreAchievements (B.pack fileName) (map toPair teams) info |
86 --StoreAchievements (B.pack fileName) (map toPair teams) info |
92 StoreAchievements p fileName teams info -> |
87 StoreAchievements p fileName teams info -> |
93 mapM_ (run dbConn dbQueryAchievement) $ (parseStats p fileName teams) info |
88 void $ executeMany dbConn dbQueryAchievement $ (parseStats p fileName teams) info |
94 |
89 |
95 |
90 |
96 readTime = read . B.unpack . B.take 19 . B.drop 8 |
91 readTime = read . B.unpack . B.take 19 . B.drop 8 |
97 |
92 |
98 |
93 |
99 parseStats :: Word16 -> B.ByteString -> [(B.ByteString, B.ByteString)] -> [B.ByteString] -> [[SqlValue]] |
94 parseStats :: |
|
95 Word16 |
|
96 -> B.ByteString |
|
97 -> [(B.ByteString, B.ByteString)] |
|
98 -> [B.ByteString] |
|
99 -> [(B.ByteString, B.ByteString, B.ByteString, Int, B.ByteString, B.ByteString, Int)] |
100 parseStats p fileName teams = ps |
100 parseStats p fileName teams = ps |
101 where |
101 where |
102 time = readTime fileName |
102 time = readTime fileName |
103 ps [] = [] |
103 ps [] = [] |
104 ps ("DRAW" : bs) = ps bs |
104 ps ("DRAW" : bs) = ps bs |
105 ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs |
105 ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs |
106 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = |
106 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = |
107 [ SqlUTCTime time |
107 ( time |
108 , SqlByteString typ |
108 , typ |
109 , SqlByteString $ fromMaybe "" (lookup teamname teams) |
109 , fromMaybe "" (lookup teamname teams) |
110 , SqlInt32 (readInt_ value) |
110 , readInt_ value |
111 , SqlByteString fileName |
111 , fileName |
112 , SqlByteString location |
112 , location |
113 , SqlInt32 $ fromIntegral p |
113 , fromIntegral p |
114 ] : ps bs |
114 ) : ps bs |
115 ps (b:bs) = ps bs |
115 ps (b:bs) = ps bs |
116 |
116 |
117 |
117 |
118 dbConnectionLoop mySQLConnectionInfo = |
118 dbConnectionLoop mySQLConnectionInfo = |
119 Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $ |
119 Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $ |
120 bracket |
120 bracket |
121 (connectMySQL mySQLConnectionInfo) |
121 (connect mySQLConnectionInfo) |
122 disconnect |
122 close |
123 dbInteractionLoop |
123 dbInteractionLoop |
124 |
124 |
125 |
125 |
126 --processRequest :: DBQuery -> IO String |
126 --processRequest :: DBQuery -> IO String |
127 --processRequest (CheckAccount clId clUid clNick clHost) = return $ show (clclId, clUid, Guest) |
127 --processRequest (CheckAccount clId clUid clNick clHost) = return $ show (clclId, clUid, Guest) |