--- a/gameServer/Actions.hs Tue Aug 06 00:26:07 2013 +0400
+++ b/gameServer/Actions.hs Sat Aug 17 23:38:53 2013 +0400
@@ -671,8 +671,11 @@
io $ moveFailedRecord fileName
processAction (CheckSuccess info) = do
- Just (CheckInfo fileName _) <- client's checkInfo
+ Just (CheckInfo fileName teams) <- client's checkInfo
+ io $ writeChan (dbQueries si) $ StoreAchievement fileName (map toPair teams) info
io $ moveCheckedRecord fileName
+ where
+ toPair t = (teamname t, teamowner t)
#else
processAction SaveReplay = return ()
--- a/gameServer/CoreTypes.hs Tue Aug 06 00:26:07 2013 +0400
+++ b/gameServer/CoreTypes.hs Sat Aug 17 23:38:53 2013 +0400
@@ -263,6 +263,7 @@
CheckAccount ClientIndex Int B.ByteString B.ByteString
| ClearCache
| SendStats Int Int
+ | StoreAchievement [(B.ByteString, B.ByteString)] [B.ByteString]
deriving (Show, Read)
data CoreMessage =
--- a/gameServer/OfficialServer/DBInteraction.hs Tue Aug 06 00:26:07 2013 +0400
+++ b/gameServer/OfficialServer/DBInteraction.hs Sat Aug 17 23:38:53 2013 +0400
@@ -78,6 +78,12 @@
return (accountsCache, req)
ClearCache -> return (Map.empty, req)
+ StoreAchievements {} -> (
+ (SIO.hPutStrLn hIn $ show q) >>
+ hFlush hIn >>
+ return (accountsCache, req))
+ `Exception.onException`
+ (unGetChan queries q)
SendStats {} -> (
(SIO.hPutStrLn hIn $ show q) >>
hFlush hIn >>
--- a/gameServer/OfficialServer/checker.hs Tue Aug 06 00:26:07 2013 +0400
+++ b/gameServer/OfficialServer/checker.hs Sat Aug 17 23:38:53 2013 +0400
@@ -32,11 +32,11 @@
serverAddress = "netserver.hedgewars.org"
protocolNumber = "45"
-getLines :: Handle -> IO [String]
+getLines :: Handle -> IO [B.ByteString]
getLines h = g
where
g = do
- l <- liftM Just (hGetLine h) `Exception.catch` (\(_ :: Exception.IOException) -> return Nothing)
+ l <- liftM Just (B.hGetLine h) `Exception.catch` (\(_ :: Exception.IOException) -> return Nothing)
if isNothing l then
return []
else
@@ -47,12 +47,12 @@
engineListener :: Chan Message -> Handle -> String -> IO ()
engineListener coreChan h fileName = do
- output <- getLines h
- debugM "Engine" $ show output
- if isNothing $ L.find start output then
+ stats <- liftM (L.dropWhile start) $ getLines h
+ debugM "Engine" $ show stats
+ if null stats then
writeChan coreChan $ CheckFailed "No stats msg"
else
- writeChan coreChan $ CheckSuccess []
+ writeChan coreChan $ CheckSuccess stats
removeFile fileName
where
--- a/gameServer/OfficialServer/extdbinterface.hs Tue Aug 06 00:26:07 2013 +0400
+++ b/gameServer/OfficialServer/extdbinterface.hs Sat Aug 17 23:38:53 2013 +0400
@@ -46,6 +46,8 @@
SendStats clients rooms ->
run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return ()
+ StoreAchievements -> return ()
+
dbConnectionLoop mySQLConnectionInfo =
Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $