723 io $ writeChan (dbQueries si) $ StoreAchievements (B.pack fileName) (map toPair teams) info |
721 io $ writeChan (dbQueries si) $ StoreAchievements (B.pack fileName) (map toPair teams) info |
724 io $ moveCheckedRecord fileName |
722 io $ moveCheckedRecord fileName |
725 where |
723 where |
726 toPair t = (teamname t, teamowner t) |
724 toPair t = (teamname t, teamowner t) |
727 |
725 |
728 processAction (QueryReplay name) = do |
726 processAction (QueryReplay rname) = do |
729 (Just ci) <- gets clientIndex |
727 (Just ci) <- gets clientIndex |
730 si <- gets serverInfo |
728 si <- gets serverInfo |
731 uid <- client's clUID |
729 uid <- client's clUID |
732 io $ writeChan (dbQueries si) $ GetReplayName ci (hashUnique uid) name |
730 io $ writeChan (dbQueries si) $ GetReplayName ci (hashUnique uid) rname |
733 |
731 |
734 #else |
732 #else |
735 processAction SaveReplay = return () |
733 processAction SaveReplay = return () |
736 processAction CheckRecord = return () |
734 processAction CheckRecord = return () |
737 processAction (CheckFailed _) = return () |
735 processAction (CheckFailed _) = return () |
738 processAction (CheckSuccess _) = return () |
736 processAction (CheckSuccess _) = return () |
739 processAction (QueryReplay _) = return () |
737 processAction (QueryReplay _) = return () |
740 #endif |
738 #endif |
741 |
739 |
742 processAction (ShowReplay name) = do |
740 processAction (ShowReplay rname) = do |
743 c <- client's sendChan |
741 c <- client's sendChan |
744 cl <- client's id |
742 cl <- client's id |
745 |
743 |
746 let fileName = B.concat ["checked/", if B.isPrefixOf "replays/" name then B.drop 8 name else name] |
744 let fileName = B.concat ["checked/", if B.isPrefixOf "replays/" rname then B.drop 8 rname else rname] |
747 |
745 |
748 checkInfo <- liftIO $ E.handle (\(e :: SomeException) -> |
746 cInfo <- liftIO $ E.handle (\(e :: SomeException) -> |
749 warningM "REPLAYS" (B.unpack $ B.concat ["Problems reading ", fileName, ": ", B.pack $ show e]) >> return Nothing) $ do |
747 warningM "REPLAYS" (B.unpack $ B.concat ["Problems reading ", fileName, ": ", B.pack $ show e]) >> return Nothing) $ do |
750 (t, p1, p2, msgs) <- liftM read $ readFile (B.unpack fileName) |
748 (t, p1, p2, msgs) <- liftM read $ readFile (B.unpack fileName) |
751 return $ Just (t, Map.fromList p1, Map.fromList p2, reverse msgs) |
749 return $ Just (t, Map.fromList p1, Map.fromList p2, reverse msgs) |
752 |
750 |
753 let (teams, params1, params2, roundMsgs) = fromJust checkInfo |
751 let (teams', params1, params2, roundMsgs') = fromJust cInfo |
754 |
752 |
755 when (isJust checkInfo) $ do |
753 when (isJust cInfo) $ do |
756 mapM_ processAction $ concat [ |
754 mapM_ processAction $ concat [ |
757 [AnswerClients [c] ["JOINED", nick cl]] |
755 [AnswerClients [c] ["JOINED", nick cl]] |
758 , answerFullConfigParams cl params1 params2 |
756 , answerFullConfigParams cl params1 params2 |
759 , answerAllTeams cl teams |
757 , answerAllTeams cl teams' |
760 , [AnswerClients [c] ["RUN_GAME"]] |
758 , [AnswerClients [c] ["RUN_GAME"]] |
761 , [AnswerClients [c] $ "EM" : roundMsgs] |
759 , [AnswerClients [c] $ "EM" : roundMsgs'] |
762 , [AnswerClients [c] ["KICKED"]] |
760 , [AnswerClients [c] ["KICKED"]] |
763 ] |
761 ] |