gameServer/Actions.hs
branchqmlfrontend
changeset 11403 b894922d58cc
parent 11341 e6e748d021d0
child 11463 fe46826de291
equal deleted inserted replaced
11076:fcbdee9cdd74 11403:b894922d58cc
   742     ri <- clientRoomA
   742     ri <- clientRoomA
   743     rnc <- gets roomsClients
   743     rnc <- gets roomsClients
   744 
   744 
   745     blackList <- liftM (map (recordFileName . fromJust . checkInfo) . filter (isJust . checkInfo)) allClientsS
   745     blackList <- liftM (map (recordFileName . fromJust . checkInfo) . filter (isJust . checkInfo)) allClientsS
   746 
   746 
   747     readyCheckersIds <- io $ do
       
   748         allci <- allClientsM rnc
       
   749         filterM (client'sM rnc (isJust . checkInfo)) allci
       
   750 
       
   751     (cinfo, l) <- io $ loadReplay (fromIntegral p) blackList
   747     (cinfo, l) <- io $ loadReplay (fromIntegral p) blackList
   752     when (isJust cinfo) $
   748     when (isJust cinfo) $
   753         mapM_ processAction [
   749         mapM_ processAction [
   754             AnswerClients [c] ("REPLAY" : l)
   750             AnswerClients [c] ("REPLAY" : l)
   755             , ModifyClient $ \c -> c{checkInfo = cinfo, isReady = False}
   751             , ModifyClient $ \c -> c{checkInfo = cinfo, isReady = False}
   756             ]
   752             ]
   757 
   753 
   758 
   754 
   759 processAction (CheckFailed msg) = do
   755 processAction (CheckFailed msg) = do
   760     Just (CheckInfo fileName _) <- client's checkInfo
   756     Just (CheckInfo fileName _ _) <- client's checkInfo
   761     io $ moveFailedRecord fileName
   757     io $ moveFailedRecord fileName
   762 
   758 
   763 
   759 
   764 processAction (CheckSuccess info) = do
   760 processAction (CheckSuccess info) = do
   765     Just (CheckInfo fileName teams) <- client's checkInfo
   761     Just (CheckInfo fileName teams gameDetails) <- client's checkInfo
   766     p <- client's clientProto
   762     p <- client's clientProto
   767     si <- gets serverInfo
   763     si <- gets serverInfo
   768     io $ writeChan (dbQueries si) $ StoreAchievements p (B.pack fileName) (map toPair teams) info
   764     when (isJust gameDetails)
       
   765         $ io $ writeChan (dbQueries si) $ StoreAchievements p (B.pack fileName) (map toPair teams) (fromJust gameDetails) info
   769     io $ moveCheckedRecord fileName
   766     io $ moveCheckedRecord fileName
   770     where
   767     where
   771         toPair t = (teamname t, teamowner t)
   768         toPair t = (teamname t, teamowner t)
   772 
   769 
   773 processAction (QueryReplay rname) = do
   770 processAction (QueryReplay rname) = do