Also pass script information alongwith winner/achievements info, so that we could potentially have per mode ratings
authorunc0rr
Tue, 27 Oct 2015 23:04:15 +0300
changeset 11250 09a2d3988569
parent 11246 d9622394ec9c
child 11252 10facd5dffeb
Also pass script information alongwith winner/achievements info, so that we could potentially have per mode ratings
gameServer/Actions.hs
gameServer/CoreTypes.hs
gameServer/EngineInteraction.hs
gameServer/OfficialServer/GameReplayStore.hs
gameServer/OfficialServer/extdbinterface.hs
--- a/gameServer/Actions.hs	Sun Oct 25 20:40:27 2015 +0100
+++ b/gameServer/Actions.hs	Tue Oct 27 23:04:15 2015 +0300
@@ -757,15 +757,15 @@
 
 
 processAction (CheckFailed msg) = do
-    Just (CheckInfo fileName _) <- client's checkInfo
+    Just (CheckInfo fileName _ _) <- client's checkInfo
     io $ moveFailedRecord fileName
 
 
 processAction (CheckSuccess info) = do
-    Just (CheckInfo fileName teams) <- client's checkInfo
+    Just (CheckInfo fileName teams script) <- client's checkInfo
     p <- client's clientProto
     si <- gets serverInfo
-    io $ writeChan (dbQueries si) $ StoreAchievements p (B.pack fileName) (map toPair teams) info
+    io $ writeChan (dbQueries si) $ StoreAchievements p (B.pack fileName) (map toPair teams) script info
     io $ moveCheckedRecord fileName
     where
         toPair t = (teamname t, teamowner t)
--- a/gameServer/CoreTypes.hs	Sun Oct 25 20:40:27 2015 +0100
+++ b/gameServer/CoreTypes.hs	Tue Oct 27 23:04:15 2015 +0300
@@ -119,7 +119,8 @@
     CheckInfo
     {
         recordFileName :: String,
-        recordTeams :: [TeamInfo]
+        recordTeams :: [TeamInfo],
+        recordScript :: B.ByteString
     }
 
 data ClientInfo =
@@ -345,7 +346,7 @@
     CheckAccount ClientIndex Int B.ByteString B.ByteString
     | ClearCache
     | SendStats Int Int
-    | StoreAchievements Word16 B.ByteString [(B.ByteString, B.ByteString)] [B.ByteString]
+    | StoreAchievements Word16 B.ByteString [(B.ByteString, B.ByteString)] B.ByteString [B.ByteString]
     | GetReplayName ClientIndex Int B.ByteString
     deriving (Show, Read)
 
--- a/gameServer/EngineInteraction.hs	Sun Oct 25 20:40:27 2015 +0100
+++ b/gameServer/EngineInteraction.hs	Tue Oct 27 23:04:15 2015 +0300
@@ -100,8 +100,8 @@
         -> Map.Map B.ByteString B.ByteString
         -> Map.Map B.ByteString [B.ByteString]
         -> [B.ByteString]
-        -> [B.ByteString]
-replayToDemo ti mParams prms msgs = if not sane then [] else concat [
+        -> ([B.ByteString], [B.ByteString])
+replayToDemo ti mParams prms msgs = if not sane then ([], []) else ([scriptName], concat [
         [em "TD"]
         , maybeScript
         , maybeMap
@@ -117,7 +117,7 @@
         , concatMap teamSetup ti
         , msgs
         , [em "!"]
-        ]
+        ])
     where
         keys1, keys2 :: Set.Set B.ByteString
         keys1 = Set.fromList ["FEATURE_SIZE", "MAP", "MAPGEN", "MAZE_SIZE", "SEED", "TEMPLATE"]
@@ -127,7 +127,8 @@
             && (not . null . drop 41 $ scheme)
             && (not . null . tail $ prms Map.! "AMMO")
         mapGenTypes = ["+rnd+", "+maze+", "+drawn+", "+perlin+"]
-        maybeScript = let s = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
+        scriptName = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms
+        maybeScript = let s = scriptName in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
         maybeMap = let m = mParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]]
         scheme = tail $ prms Map.! "SCHEME"
         mapgen = mParams Map.! "MAPGEN"
--- a/gameServer/OfficialServer/GameReplayStore.hs	Sun Oct 25 20:40:27 2015 +0100
+++ b/gameServer/OfficialServer/GameReplayStore.hs	Tue Oct 27 23:04:15 2015 +0300
@@ -16,7 +16,7 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  \-}
 
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
 module OfficialServer.GameReplayStore where
 
 import Data.Time
@@ -70,11 +70,12 @@
     where
         loadFile :: String -> IO (Maybe CheckInfo, [B.ByteString])
         loadFile fileName = E.handle (\(e :: SomeException) ->
-                    warningM "REPLAYS" ("Problems reading " ++ fileName ++ ": " ++ show e) >> return (Just $ CheckInfo fileName [], [])) $ do
+                    warningM "REPLAYS" ("Problems reading " ++ fileName ++ ": " ++ show e) >> return (Just $ CheckInfo fileName [] "", [])) $ do
             (teams, params1, params2, roundMsgs) <- liftM read $ readFile fileName
-            return $ (
-                Just (CheckInfo fileName teams)
-                , let d = replayToDemo teams (Map.fromList params1) (Map.fromList params2) (reverse roundMsgs) in d `deepseq` d
+            let d = replayToDemo teams (Map.fromList params1) (Map.fromList params2) (reverse roundMsgs)
+            d `deepseq` return $ (
+                Just (CheckInfo fileName teams (head $ fst d))
+                , snd d
                 )
 
 moveFailedRecord :: String -> IO ()
--- a/gameServer/OfficialServer/extdbinterface.hs	Sun Oct 25 20:40:27 2015 +0100
+++ b/gameServer/OfficialServer/extdbinterface.hs	Tue Oct 27 23:04:15 2015 +0300
@@ -50,6 +50,9 @@
     \ VALUES (?, (SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \
     \ ?, ?, ?, ?)"
 
+dbQueryGamesHistory =
+    "? ? ?"
+
 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?"
 
 
@@ -83,8 +86,8 @@
 
         SendStats clients rooms ->
                 void $ execute dbConn dbQueryStats (clients, rooms)
-        StoreAchievements p fileName teams info ->
-            mapM_ (execute dbConn dbQueryAchievement) $ (parseStats p fileName teams) info
+        StoreAchievements p fileName teams script info ->
+            mapM_ (uncurry (execute dbConn)) $ parseStats p fileName teams script info
 
 
 --readTime = read . B.unpack . B.take 19 . B.drop 8
@@ -94,15 +97,16 @@
     Word16 
     -> B.ByteString 
     -> [(B.ByteString, B.ByteString)] 
-    -> [B.ByteString] 
-    -> [(B.ByteString, B.ByteString, B.ByteString, Int, B.ByteString, B.ByteString, Int)]
-parseStats p fileName teams = ps
+    -> B.ByteString
+    -> [B.ByteString]
+    -> [(Query, (B.ByteString, B.ByteString, B.ByteString, Int, B.ByteString, B.ByteString, Int))]
+parseStats p fileName teams script = ps
     where
     time = readTime fileName
     ps [] = []
     ps ("DRAW" : bs) = ps bs
     ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs
-    ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) =
+    ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = (dbQueryAchievement, 
         ( time
         , typ
         , fromMaybe "" (lookup teamname teams)
@@ -110,7 +114,7 @@
         , fileName
         , location
         , fromIntegral p
-        ) : ps bs
+        )) : ps bs
     ps (b:bs) = ps bs