Start support of achievement replay query:
authorunc0rr
Tue, 03 Sep 2013 00:05:38 +0400
changeset 9446 4fd5df03deb8
parent 9444 30748b1d9ec7
child 9448 04e0acfa7c2c
Start support of achievement replay query: - /watch command - Query filename from database
gameServer/Actions.hs
gameServer/CoreTypes.hs
gameServer/HWProtoCore.hs
gameServer/OfficialServer/DBInteraction.hs
gameServer/OfficialServer/extdbinterface.hs
--- a/gameServer/Actions.hs	Thu Aug 29 12:12:19 2013 +0400
+++ b/gameServer/Actions.hs	Tue Sep 03 00:05:38 2013 +0400
@@ -437,6 +437,7 @@
             mapM_ processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
             chan <- client's sendChan
             processAction $ AnswerClients [chan] ["ADMIN_ACCESS"]
+        ReplayName fn -> processAction $ ShowReplay fn
     where
     isBanned = do
         processAction $ CheckBanned False
@@ -698,9 +699,20 @@
     where
         toPair t = (teamname t, teamowner t)
 
+processAction (QueryReplay name) = do
+    (Just ci) <- gets clientIndex
+    si <- gets serverInfo
+    uid <- client's clUID
+    io $ writeChan (dbQueries si) $ GetReplayName ci (hashUnique uid) name
+
 #else
 processAction SaveReplay = return ()
 processAction CheckRecord = return ()
 processAction (CheckFailed _) = return ()
 processAction (CheckSuccess _) = return ()
+processAction (QueryReplay _) = return ()
 #endif
+
+processAction (ShowReplay name) = do
+    return ()
+
--- a/gameServer/CoreTypes.hs	Thu Aug 29 12:12:19 2013 +0400
+++ b/gameServer/CoreTypes.hs	Tue Sep 03 00:05:38 2013 +0400
@@ -76,6 +76,8 @@
     | CheckFailed B.ByteString
     | CheckSuccess [B.ByteString]
     | Random [ClientChan] [B.ByteString]
+    | QueryReplay B.ByteString
+    | ShowReplay B.ByteString
 
 type ClientChan = Chan [B.ByteString]
 
@@ -258,6 +260,7 @@
     HasAccount B.ByteString Bool Bool
     | Guest
     | Admin
+    | ReplayName B.ByteString
     deriving (Show, Read)
 
 data DBQuery =
@@ -265,6 +268,7 @@
     | ClearCache
     | SendStats Int Int
     | StoreAchievements B.ByteString [(B.ByteString, B.ByteString)] [B.ByteString]
+    | GetReplayName ClientIndex Int B.ByteString
     deriving (Show, Read)
 
 data CoreMessage =
--- a/gameServer/HWProtoCore.hs	Thu Aug 29 12:12:19 2013 +0400
+++ b/gameServer/HWProtoCore.hs	Tue Sep 03 00:05:38 2013 +0400
@@ -50,6 +50,7 @@
             rnc <- liftM snd ask
             let chans = map (sendChan . client rnc) $ allClients rnc
             return [AnswerClients chans ["CHAT", "[global notice]", p] | isAdministrator cl]
+        h "WATCH" = return . QueryReplay
         h c p = return [Warning $ B.concat ["Unknown cmd: /", c, p]]
 
 handleCmd cmd = do
--- a/gameServer/OfficialServer/DBInteraction.hs	Thu Aug 29 12:12:19 2013 +0400
+++ b/gameServer/OfficialServer/DBInteraction.hs	Tue Sep 03 00:05:38 2013 +0400
@@ -77,6 +77,14 @@
                     writeChan cChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry)
                     return (accountsCache, req)
 
+        GetReplayName {} -> do
+            SIO.hPutStrLn hIn $ show q
+            hFlush hIn
+
+            (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead)
+
+            writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo
+
         ClearCache -> return (Map.empty, req)
         StoreAchievements {} -> (
                 (SIO.hPutStrLn hIn $ show q) >>
--- a/gameServer/OfficialServer/extdbinterface.hs	Thu Aug 29 12:12:19 2013 +0400
+++ b/gameServer/OfficialServer/extdbinterface.hs	Tue Sep 03 00:05:38 2013 +0400
@@ -30,6 +30,9 @@
     \ VALUES (?, (SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \
     \ ?, ?, ?)"
 
+dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?"
+
+
 dbInteractionLoop dbConn = forever $ do
     q <- liftM read getLine
     hPutStrLn stderr $ show q
@@ -55,14 +58,25 @@
                 print response
                 hFlush stdout
 
+        GetReplayName clId clUid fileId -> do
+                statement <- prepare dbConn dbQueryReplayFilename
+                execute statement [SqlByteString fileId]
+                result <- fetchRow statement
+                finish statement
+                let fn = if (isJust result) then fromJust . fromSql . head $ result else ""
+                print (clId, clUid, ReplayName fn)
+                hFlush stdout
+
         SendStats clients rooms ->
                 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return ()
 --StoreAchievements (B.pack fileName) (map toPair teams) info
         StoreAchievements fileName teams info -> 
             mapM_ (run dbConn dbQueryAchievement) $ (parseStats fileName teams) info
 
+
 readTime = read . B.unpack . B.take 19 . B.drop 8
 
+
 parseStats :: B.ByteString -> [(B.ByteString, B.ByteString)] -> [B.ByteString] -> [[SqlValue]]
 parseStats fileName teams = ps
     where