diff -r 21dd1def5aaf -r 0eab727d4717 gameServer/HWProtoLobbyState.hs --- a/gameServer/HWProtoLobbyState.hs Wed Feb 02 09:05:48 2011 +0100 +++ b/gameServer/HWProtoLobbyState.hs Wed Feb 02 11:28:38 2011 +0300 @@ -1,149 +1,145 @@ +{-# LANGUAGE OverloadedStrings #-} module HWProtoLobbyState where import qualified Data.Map as Map -import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.Foldable as Foldable import Data.Maybe import Data.List import Data.Word +import Control.Monad.Reader +import qualified Data.ByteString.Char8 as B +import Control.DeepSeq -------------------------------------- import CoreTypes import Actions import Utils +import HandlerUtils +import RoomsAndClients -answerAllTeams protocol teams = concatMap toAnswer teams +answerAllTeams cl = concatMap toAnswer where + clChan = sendChan cl toAnswer team = - [AnswerThisClient $ teamToNet protocol team, - AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team], - AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]] + [AnswerClients [clChan] $ teamToNet team, + AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team], + AnswerClients [clChan] ["HH_NUM", teamname team, B.pack . show $ hhnum team]] handleCmd_lobby :: CmdHandler -handleCmd_lobby clID clients rooms ["LIST"] = - [AnswerThisClient ("ROOMS" : roomsInfoList)] + +handleCmd_lobby ["LIST"] = do + (ci, irnc) <- ask + let cl = irnc `client` ci + rooms <- allRoomInfos + let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r)) + return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)] where - roomsInfoList = concatMap roomInfo sameProtoRooms - sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList - roomsList = IntMap.elems rooms - protocol = clientProto client - client = clients IntMap.! clID - roomInfo room - | clientProto client < 28 = [ + roomInfo irnc room = [ + showB $ gameinprogress room, name room, - show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")", - show $ gameinprogress room - ] - | otherwise = [ - show $ gameinprogress room, - name room, - show $ playersIn room, - show $ length $ teams room, - nick $ clients IntMap.! (masterID room), + showB $ playersIn room, + showB $ length $ teams room, + nick $ irnc `client` masterID room, head (Map.findWithDefault ["+gen+"] "MAP" (params room)), head (Map.findWithDefault ["Default"] "SCHEME" (params room)), head (Map.findWithDefault ["Default"] "AMMO" (params room)) ] -handleCmd_lobby clID clients _ ["CHAT", msg] = - [AnswerOthersInRoom ["CHAT", clientNick, msg]] - where - clientNick = nick $ clients IntMap.! clID + +handleCmd_lobby ["CHAT", msg] = do + n <- clientNick + s <- roomOthersChans + return [AnswerClients s ["CHAT", n, msg]] + +handleCmd_lobby ["CREATE_ROOM", newRoom, roomPassword] + | illegalName newRoom = return [Warning "Illegal room name"] + | otherwise = do + rs <- allRoomInfos + cl <- thisClient + return $ if isJust $ find (\room -> newRoom == name room) rs then + [Warning "Room exists"] + else + [ + AddRoom newRoom roomPassword, + AnswerClients [sendChan cl] ["NOT_READY", nick cl] + ] -handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword] - | haveSameRoom = [Warning "Room exists"] - | illegalName newRoom = [Warning "Illegal room name"] - | otherwise = - [RoomRemoveThisClient "", -- leave lobby - AddRoom newRoom roomPassword, - AnswerThisClient ["NOT_READY", clientNick] - ] - where - clientNick = nick $ clients IntMap.! clID - haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms - - -handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] = - handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""] +handleCmd_lobby ["CREATE_ROOM", newRoom] = + handleCmd_lobby ["CREATE_ROOM", newRoom, ""] -handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword] - | noSuchRoom = [Warning "No such room"] - | isRestrictedJoins jRoom = [Warning "Joining restricted"] - | roomPassword /= password jRoom = [Warning "Wrong password"] - | otherwise = - [RoomRemoveThisClient "", -- leave lobby - RoomAddThisClient rID] -- join room - ++ answerNicks - ++ answerReady - ++ [AnswerThisRoom ["NOT_READY", nick client]] - ++ answerFullConfig - ++ answerTeams - ++ watchRound - where - noSuchRoom = isNothing mbRoom - mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms - jRoom = fromJust mbRoom - rID = roomUID jRoom - client = clients IntMap.! clID - roomClientsIDs = IntSet.elems $ playersIDs jRoom - answerNicks = - [AnswerThisClient $ "JOINED" : - map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0] - answerReady = map - ((\ c -> - AnswerThisClient - [if isReady c then "READY" else "NOT_READY", nick c]) - . (\ clID -> clients IntMap.! clID)) - roomClientsIDs +handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do + (ci, irnc) <- ask + let ris = allRooms irnc + cl <- thisClient + let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris + let jRI = fromJust maybeRI + let jRoom = irnc `room` jRI + let jRoomClients = map (client irnc) $ roomClients irnc jRI + let nicks = map nick jRoomClients + let chans = map sendChan (cl : jRoomClients) + return $ + if isNothing maybeRI then + [Warning "No such rooms"] + else if isRestrictedJoins jRoom then + [Warning "Joining restricted"] + else if roomPassword /= password jRoom then + [Warning "Wrong password"] + else + [ + MoveToRoom jRI, + AnswerClients [sendChan cl] $ "JOINED" : nicks, + AnswerClients chans ["NOT_READY", nick cl] + ] + ++ (map (readynessMessage cl) jRoomClients) + ++ (answerFullConfig cl $ params jRoom) + ++ (answerTeams cl jRoom) + ++ (watchRound cl jRoom) - toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs - - answerFullConfig = map toAnswer ((Data.List.reverse . Data.List.sort $ leftConfigPart) ++ rightConfigPart) - (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p == "MAP" || p == "MAPGEN" || p == "SCHEME") (Map.toList $ params jRoom) + where + readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c] + + toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs - watchRound = if not $ gameinprogress jRoom then + answerFullConfig cl params = map (toAnswer cl) (leftConfigPart ++ rightConfigPart) + where + (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") $ Map.toList params + + answerTeams cl jRoom = let f = if gameinprogress jRoom then teamsAtStart else teams in answerAllTeams cl $ f jRoom + + watchRound cl jRoom = if not $ gameinprogress jRoom then [] else - [AnswerThisClient ["RUN_GAME"], - AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)] + [AnswerClients [sendChan cl] ["RUN_GAME"], + AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)] - answerTeams = if gameinprogress jRoom then - answerAllTeams (clientProto client) (teamsAtStart jRoom) - else - answerAllTeams (clientProto client) (teams jRoom) + +handleCmd_lobby ["JOIN_ROOM", roomName] = + handleCmd_lobby ["JOIN_ROOM", roomName, ""] -handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName] = - handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""] - - -handleCmd_lobby clID clients rooms ["FOLLOW", asknick] = - if noSuchClient || roomID followClient == 0 then - [] - else - handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName] - where - maybeClient = Foldable.find (\cl -> asknick == nick cl) clients - noSuchClient = isNothing maybeClient - followClient = fromJust maybeClient - roomName = name $ rooms IntMap.! roomID followClient - +handleCmd_lobby ["FOLLOW", asknick] = do + (_, rnc) <- ask + ci <- clientByNick asknick + let ri = clientRoom rnc $ fromJust ci + let clRoom = room rnc ri + if isNothing ci || ri == lobbyId then + return [] + else + handleCmd_lobby ["JOIN_ROOM", name clRoom] --------------------------- -- Administrator's stuff -- -handleCmd_lobby clID clients rooms ["KICK", kickNick] = - [KickClient kickID | isAdministrator client && (not noSuchClient) && kickID /= clID] - where - client = clients IntMap.! clID - maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients - noSuchClient = isNothing maybeClient - kickID = clientUID $ fromJust maybeClient +handleCmd_lobby ["KICK", kickNick] = do + (ci, _) <- ask + cl <- thisClient + kickId <- clientByNick kickNick + return [KickClient $ fromJust kickId | isAdministrator cl && isJust kickId && fromJust kickId /= ci] - +{- handleCmd_lobby clID clients rooms ["BAN", banNick] = if not $ isAdministrator client then [] @@ -151,35 +147,32 @@ BanClient banNick : handleCmd_lobby clID clients rooms ["KICK", banNick] where client = clients IntMap.! clID - + -} -handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "MOTD_NEW", newMessage] = - [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client] - where - client = clients IntMap.! clID +handleCmd_lobby ["SET_SERVER_VAR", "MOTD_NEW", newMessage] = do + cl <- thisClient + return [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator cl] -handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "MOTD_OLD", newMessage] = - [ModifyServerInfo (\si -> si{serverMessageForOldVersions = newMessage}) | isAdministrator client] - where - client = clients IntMap.! clID +handleCmd_lobby ["SET_SERVER_VAR", "MOTD_OLD", newMessage] = do + cl <- thisClient + return [ModifyServerInfo (\si -> si{serverMessageForOldVersions = newMessage}) | isAdministrator cl] -handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "LATEST_PROTO", protoNum] = - [ModifyServerInfo (\si -> si{latestReleaseVersion = fromJust readNum}) | isAdministrator client && isJust readNum] +handleCmd_lobby ["SET_SERVER_VAR", "LATEST_PROTO", protoNum] = do + cl <- thisClient + return [ModifyServerInfo (\si -> si{latestReleaseVersion = readNum}) | isAdministrator cl && readNum > 0] where - client = clients IntMap.! clID - readNum = maybeRead protoNum :: Maybe Word16 + readNum = case B.readInt protoNum of + Just (i, t) | B.null t -> fromIntegral i + otherwise -> 0 -handleCmd_lobby clID clients rooms ["GET_SERVER_VAR"] = - [SendServerVars | isAdministrator client] - where - client = clients IntMap.! clID +handleCmd_lobby ["GET_SERVER_VAR"] = do + cl <- thisClient + return [SendServerVars | isAdministrator cl] + +handleCmd_lobby ["CLEAR_ACCOUNTS_CACHE"] = do + cl <- thisClient + return [ClearAccountsCache | isAdministrator cl] -handleCmd_lobby clID clients rooms ["CLEAR_ACCOUNTS_CACHE"] = - [ClearAccountsCache | isAdministrator client] - where - client = clients IntMap.! clID - - -handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"] +handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"]