# HG changeset patch # User unc0rr # Date 1445976255 -10800 # Node ID 09a2d39885690075150ddb565aa49728551db6fd # Parent d9622394ec9c2974a84b9b4d9e6c0ac26c4060ff Also pass script information alongwith winner/achievements info, so that we could potentially have per mode ratings diff -r d9622394ec9c -r 09a2d3988569 gameServer/Actions.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) diff -r d9622394ec9c -r 09a2d3988569 gameServer/CoreTypes.hs --- 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) diff -r d9622394ec9c -r 09a2d3988569 gameServer/EngineInteraction.hs --- 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" diff -r d9622394ec9c -r 09a2d3988569 gameServer/OfficialServer/GameReplayStore.hs --- 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 () diff -r d9622394ec9c -r 09a2d3988569 gameServer/OfficialServer/extdbinterface.hs --- 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