gameServer/HWProtoLobbyState.hs
author koda
Sat, 20 Mar 2010 15:16:59 +0000
changeset 3025 01682ec58eb0
parent 2961 3e057dfa601f
child 3260 b44b88908758
permissions -rw-r--r--
update project for ipad target relocate objects (windbar, fps, timer) so that window size doesn't matter move touch input in its custom controller rather than hack sdl one
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module HWProtoLobbyState where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
import qualified Data.Map as Map
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import qualified Data.IntMap as IntMap
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import qualified Data.IntSet as IntSet
1813
cfe1481e0247 Removeteam action
unc0rr
parents: 1811
diff changeset
     6
import qualified Data.Foldable as Foldable
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Maybe
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Data.List
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    14
answerAllTeams protocol teams = concatMap toAnswer teams
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    15
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    16
        toAnswer team =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    17
            [AnswerThisClient $ teamToNet protocol team,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    18
            AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    19
            AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
handleCmd_lobby :: CmdHandler
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
handleCmd_lobby clID clients rooms ["LIST"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    24
    [AnswerThisClient ("ROOMS" : roomsInfoList)]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    25
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    26
        roomsInfoList = concatMap roomInfo sameProtoRooms
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    27
        sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    28
        roomsList = IntMap.elems rooms
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    29
        protocol = clientProto client
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    30
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    31
        roomInfo room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    32
            | clientProto client < 28 = [
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    33
                name room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    34
                show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    35
                show $ gameinprogress room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    36
                ]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    37
            | otherwise = [
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    38
                show $ gameinprogress room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    39
                name room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    40
                show $ playersIn room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    41
                show $ length $ teams room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    42
                nick $ clients IntMap.! (masterID room),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    43
                head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    44
                head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    45
                head (Map.findWithDefault ["Default"] "AMMO" (params room))
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    46
                ]
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
    47
1815
3d62cf9c350e Save some more bytes in protocol
unc0rr
parents: 1813
diff changeset
    48
handleCmd_lobby clID clients _ ["CHAT", msg] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    49
    [AnswerOthersInRoom ["CHAT", clientNick, msg]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    50
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    51
        clientNick = nick $ clients IntMap.! clID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
    53
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2155
diff changeset
    54
handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    55
    | haveSameRoom = [Warning "Room exists"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    56
    | illegalName newRoom = [Warning "Illegal room name"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    57
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    58
        [RoomRemoveThisClient "", -- leave lobby
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    59
        AddRoom newRoom roomPassword,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    60
        AnswerThisClient ["NOT_READY", clientNick]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    61
        ]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    62
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    63
        clientNick = nick $ clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    64
        haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    65
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
    66
1905
b1ec8db513f2 - Use QCryptographicHash for md5
unc0rr
parents: 1871
diff changeset
    67
handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    68
    handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    69
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
    70
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2155
diff changeset
    71
handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    72
    | noSuchRoom = [Warning "No such room"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    73
    | isRestrictedJoins jRoom = [Warning "Joining restricted"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    74
    | roomPassword /= password jRoom = [Warning "Wrong password"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    75
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    76
        [RoomRemoveThisClient "", -- leave lobby
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    77
        RoomAddThisClient rID] -- join room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    78
        ++ answerNicks
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    79
        ++ answerReady
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    80
        ++ [AnswerThisRoom ["NOT_READY", nick client]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    81
        ++ answerFullConfig
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    82
        ++ answerTeams
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    83
        ++ watchRound
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    84
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    85
        noSuchRoom = isNothing mbRoom
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    86
        mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    87
        jRoom = fromJust mbRoom
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    88
        rID = roomUID jRoom
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    89
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    90
        roomClientsIDs = IntSet.elems $ playersIDs jRoom
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    91
        answerNicks =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    92
            [AnswerThisClient $ "JOINED" :
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    93
            map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    94
        answerReady = map
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    95
            ((\ c ->
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    96
                AnswerThisClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    97
                [if isReady c then "READY" else "NOT_READY", nick c])
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    98
            . (\ clID -> clients IntMap.! clID))
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    99
            roomClientsIDs
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   100
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   101
        toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   102
        
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   103
        answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   104
        (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
1813
cfe1481e0247 Removeteam action
unc0rr
parents: 1811
diff changeset
   105
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   106
        watchRound = if not $ gameinprogress jRoom then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   107
                    []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   108
                else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   109
                    [AnswerThisClient  ["RUN_GAME"],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   110
                    AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
1813
cfe1481e0247 Removeteam action
unc0rr
parents: 1811
diff changeset
   111
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   112
        answerTeams = if gameinprogress jRoom then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   113
                answerAllTeams (clientProto client) (teamsAtStart jRoom)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   114
            else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   115
                answerAllTeams (clientProto client) (teams jRoom)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   116
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   117
1905
b1ec8db513f2 - Use QCryptographicHash for md5
unc0rr
parents: 1871
diff changeset
   118
handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   119
    handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""]
2961
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   120
    
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   121
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   122
handleCmd_lobby clID clients rooms ["FOLLOW", asknick] =
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   123
    if noSuchClient || roomID followClient == 0 then
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   124
        []
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   125
    else
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   126
        handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName]
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   127
    where
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   128
        maybeClient = Foldable.find (\cl -> asknick == nick cl) clients
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   129
        noSuchClient = isNothing maybeClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   130
        followClient = fromJust maybeClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   131
        roomName = name $ rooms IntMap.! roomID followClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   132
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   133
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   134
    ---------------------------
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   135
    -- Administrator's stuff --
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   136
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   137
handleCmd_lobby clID clients rooms ["KICK", kickNick] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   138
        [KickClient kickID | isAdministrator client && (not noSuchClient) && kickID /= clID]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   139
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   140
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   141
        maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   142
        noSuchClient = isNothing maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   143
        kickID = clientUID $ fromJust maybeClient
1866
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   144
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   145
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   146
handleCmd_lobby clID clients rooms ["BAN", banNick] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   147
    if not $ isAdministrator client then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   148
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   149
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   150
        BanClient banNick : handleCmd_lobby clID clients rooms ["KICK", banNick]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   151
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   152
        client = clients IntMap.! clID
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   153
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   154
1925
ec923e56c444 Allow admin to set server's motd
unc0rr
parents: 1905
diff changeset
   155
handleCmd_lobby clID clients rooms ["SET_SERVER_MESSAGE", newMessage] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   156
        [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   157
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   158
        client = clients IntMap.! clID
1925
ec923e56c444 Allow admin to set server's motd
unc0rr
parents: 1905
diff changeset
   159
ec923e56c444 Allow admin to set server's motd
unc0rr
parents: 1905
diff changeset
   160
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   161
handleCmd_lobby clID clients rooms ["CLEAR_ACCOUNTS_CACHE"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   162
        [ClearAccountsCache | isAdministrator client]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   163
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   164
        client = clients IntMap.! clID
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   165
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   166
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   167
handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"]