Start support of achievement replay query:
- /watch command
- Query filename from database
--- 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