gameServer/Actions.hs
changeset 10017 de822cd3df3a
parent 10015 4feced261c68
child 10056 cb9e07753802
equal deleted inserted replaced
10015:4feced261c68 10017:de822cd3df3a
   325     rnc <- gets roomsClients
   325     rnc <- gets roomsClients
   326     ri <- clientRoomA
   326     ri <- clientRoomA
   327     thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
   327     thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
   328     joinedMidGame <- liftM (filter isJoinedMidGame) $ roomClientsS ri
   328     joinedMidGame <- liftM (filter isJoinedMidGame) $ roomClientsS ri
   329     answerRemovedTeams <- io $
   329     answerRemovedTeams <- io $
   330          room'sM rnc (\r -> let gi = fromJust $ gameInfo r in 
   330          room'sM rnc (\r -> let gi = fromJust $ gameInfo r in
   331                         concatMap (\c -> 
   331                         concatMap (\c ->
   332                             (answerFullConfigParams c (mapParams r) (params r))
   332                             (answerFullConfigParams c (mapParams r) (params r))
   333                             ++
   333                             ++
   334                             (map (\t -> AnswerClients [sendChan c] ["REMOVE_TEAM", t]) $ leftTeams gi) 
   334                             (map (\t -> AnswerClients [sendChan c] ["REMOVE_TEAM", t]) $ leftTeams gi)
   335                         ) joinedMidGame
   335                         ) joinedMidGame
   336                      ) ri
   336                      ) ri
   337 
   337 
   338     mapM_ processAction $ (
   338     mapM_ processAction $ (
   339         SaveReplay
   339         SaveReplay
   355     mapM_ processAction [
   355     mapM_ processAction [
   356         AnswerClients chans ["EM", rmTeamMsg],
   356         AnswerClients chans ["EM", rmTeamMsg],
   357         ModifyRoom (\r -> r{
   357         ModifyRoom (\r -> r{
   358                 gameInfo = liftM (\g -> g{
   358                 gameInfo = liftM (\g -> g{
   359                     teamsInGameNumber = teamsInGameNumber g - 1
   359                     teamsInGameNumber = teamsInGameNumber g - 1
   360                     , roundMsgs = (if isJust $ lastFilteredTimedMsg g then (:) (fromJust $ lastFilteredTimedMsg g) else id) 
   360                     , roundMsgs = (if isJust $ lastFilteredTimedMsg g then (:) (fromJust $ lastFilteredTimedMsg g) else id)
   361                       $ rmTeamMsg : roundMsgs g
   361                       $ rmTeamMsg : roundMsgs g
   362                 }) $ gameInfo r
   362                 }) $ gameInfo r
   363             })
   363             })
   364         ]
   364         ]
   365 
   365 
   454     checkerLogin _ False _ = processAction $ ByeClient $ loc "No checker rights"
   454     checkerLogin _ False _ = processAction $ ByeClient $ loc "No checker rights"
   455     checkerLogin p True _ = do
   455     checkerLogin p True _ = do
   456         wp <- client's webPassword
   456         wp <- client's webPassword
   457         chan <- client's sendChan
   457         chan <- client's sendChan
   458         mapM_ processAction $
   458         mapM_ processAction $
   459             if wp == p then 
   459             if wp == p then
   460                 [ModifyClient $ \c -> c{logonPassed = True}
   460                 [ModifyClient $ \c -> c{logonPassed = True}
   461                 , AnswerClients [chan] ["LOGONPASSED"]
   461                 , AnswerClients [chan] ["LOGONPASSED"]
   462                 ]
   462                 ]
   463                 else 
   463                 else
   464                 [ByeClient $ loc "Authentication failed"]
   464                 [ByeClient $ loc "Authentication failed"]
   465     playerLogin p a contr = do
   465     playerLogin p a contr = do
   466         chan <- client's sendChan
   466         chan <- client's sendChan
   467         mapM_ processAction [
   467         mapM_ processAction [
   468             AnswerClients [chan] ["ASKPASSWORD"]
   468             AnswerClients [chan] ["ASKPASSWORD"]
   528         AddIP2Bans ip msg (addUTCTime seconds currentTime)
   528         AddIP2Bans ip msg (addUTCTime seconds currentTime)
   529 
   529 
   530 
   530 
   531 processAction (BanNick n seconds reason) = do
   531 processAction (BanNick n seconds reason) = do
   532     currentTime <- io getCurrentTime
   532     currentTime <- io getCurrentTime
   533     let msg = 
   533     let msg =
   534             if seconds > 60 * 60 * 24 * 365 then
   534             if seconds > 60 * 60 * 24 * 365 then
   535                 B.concat ["Permanent ban (", reason, ")"]
   535                 B.concat ["Permanent ban (", reason, ")"]
   536                 else
   536                 else
   537                 B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
   537                 B.concat ["Ban for ", B.pack . show $ seconds, " (", reason, ")"]
   538     processAction $
   538     processAction $
   773             ]
   773             ]
   774 
   774 
   775 
   775 
   776 processAction Cleanup = do
   776 processAction Cleanup = do
   777     jm <- gets joinsMonitor
   777     jm <- gets joinsMonitor
   778     
   778 
   779     io $ do
   779     io $ do
   780         t <- getCurrentTime
   780         t <- getCurrentTime
   781         cleanup jm t
   781         cleanup jm t