gameServer/HWProtoLobbyState.hs
author koda
Sat, 05 Jun 2010 14:07:58 +0000
changeset 3495 a6b4f351d400
parent 3435 4e4f88a7bdf2
child 3500 af8390d807d6
permissions -rw-r--r--
now engine can be optionally built as library, there's an example wrapper of how to use it building server is now disabled by default, saves users some headaches
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
3260
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
     9
import Data.Word
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import Utils
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    14
import HandlerUtils
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    16
{-answerAllTeams protocol teams = concatMap toAnswer teams
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    17
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    18
        toAnswer team =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    19
            [AnswerThisClient $ teamToNet protocol team,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    20
            AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    21
            AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    22
-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
handleCmd_lobby :: CmdHandler
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    25
{-
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
handleCmd_lobby clID clients rooms ["LIST"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    27
    [AnswerThisClient ("ROOMS" : roomsInfoList)]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    28
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    29
        roomsInfoList = concatMap roomInfo sameProtoRooms
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    30
        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
    31
        roomsList = IntMap.elems rooms
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    32
        protocol = clientProto client
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    33
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    34
        roomInfo room
3277
70d4265871ff Oops, fix server
unc0rr
parents: 3260
diff changeset
    35
            | clientProto client < 28 = [
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    36
                name room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    37
                show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")",
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
                ]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    40
            | otherwise = [
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    41
                show $ gameinprogress room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    42
                name room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    43
                show $ playersIn room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    44
                show $ length $ teams room,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    45
                nick $ clients IntMap.! (masterID room),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    46
                head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    47
                head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    48
                head (Map.findWithDefault ["Default"] "AMMO" (params room))
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    49
                ]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    50
-}
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
    51
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    52
handleCmd_lobby ["CHAT", msg] = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    53
    n <- clientNick
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    54
    s <- roomOthersChans
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    55
    return [AnswerClients s ["CHAT", n, msg]]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    57
{-
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2155
diff changeset
    58
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
    59
    | haveSameRoom = [Warning "Room exists"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    60
    | illegalName newRoom = [Warning "Illegal room name"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    61
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    62
        [RoomRemoveThisClient "", -- leave lobby
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    63
        AddRoom newRoom roomPassword,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    64
        AnswerThisClient ["NOT_READY", clientNick]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    65
        ]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    66
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    67
        clientNick = nick $ clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    68
        haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    69
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
    70
1905
b1ec8db513f2 - Use QCryptographicHash for md5
unc0rr
parents: 1871
diff changeset
    71
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
    72
    handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    73
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
    74
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2155
diff changeset
    75
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
    76
    | noSuchRoom = [Warning "No such room"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    77
    | isRestrictedJoins jRoom = [Warning "Joining restricted"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    78
    | roomPassword /= password jRoom = [Warning "Wrong password"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    79
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    80
        [RoomRemoveThisClient "", -- leave lobby
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    81
        RoomAddThisClient rID] -- join room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    82
        ++ answerNicks
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    83
        ++ answerReady
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    84
        ++ [AnswerThisRoom ["NOT_READY", nick client]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    85
        ++ answerFullConfig
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    86
        ++ answerTeams
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    87
        ++ watchRound
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    88
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    89
        noSuchRoom = isNothing mbRoom
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    90
        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
    91
        jRoom = fromJust mbRoom
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    92
        rID = roomUID jRoom
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    93
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    94
        roomClientsIDs = IntSet.elems $ playersIDs jRoom
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    95
        answerNicks =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    96
            [AnswerThisClient $ "JOINED" :
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    97
            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
    98
        answerReady = map
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    99
            ((\ c ->
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   100
                AnswerThisClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   101
                [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
   102
            . (\ clID -> clients IntMap.! clID))
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   103
            roomClientsIDs
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   104
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   105
        toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
3425
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 3283
diff changeset
   106
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   107
        answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   108
        (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
1813
cfe1481e0247 Removeteam action
unc0rr
parents: 1811
diff changeset
   109
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   110
        watchRound = if not $ gameinprogress jRoom then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   111
                    []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   112
                else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   113
                    [AnswerThisClient  ["RUN_GAME"],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   114
                    AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
1813
cfe1481e0247 Removeteam action
unc0rr
parents: 1811
diff changeset
   115
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   116
        answerTeams = if gameinprogress jRoom then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   117
                answerAllTeams (clientProto client) (teamsAtStart jRoom)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   118
            else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   119
                answerAllTeams (clientProto client) (teams jRoom)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   120
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   121
1905
b1ec8db513f2 - Use QCryptographicHash for md5
unc0rr
parents: 1871
diff changeset
   122
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
   123
    handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""]
3425
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 3283
diff changeset
   124
2961
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   125
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   126
handleCmd_lobby clID clients rooms ["FOLLOW", asknick] =
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   127
    if noSuchClient || roomID followClient == 0 then
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   128
        []
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   129
    else
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   130
        handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName]
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   131
    where
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   132
        maybeClient = Foldable.find (\cl -> asknick == nick cl) clients
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   133
        noSuchClient = isNothing maybeClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   134
        followClient = fromJust maybeClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   135
        roomName = name $ rooms IntMap.! roomID followClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   136
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   137
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   138
    ---------------------------
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   139
    -- Administrator's stuff --
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   140
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   141
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
   142
        [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
   143
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   144
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   145
        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
   146
        noSuchClient = isNothing maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   147
        kickID = clientUID $ fromJust maybeClient
1866
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   148
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   149
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   150
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
   151
    if not $ isAdministrator client then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   152
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   153
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   154
        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
   155
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   156
        client = clients IntMap.! clID
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   157
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   158
3283
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   159
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   160
handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "MOTD_NEW", newMessage] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   161
        [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   162
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   163
        client = clients IntMap.! clID
1925
ec923e56c444 Allow admin to set server's motd
unc0rr
parents: 1905
diff changeset
   164
3283
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   165
handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "MOTD_OLD", newMessage] =
3260
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   166
        [ModifyServerInfo (\si -> si{serverMessageForOldVersions = newMessage}) | isAdministrator client]
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   167
    where
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   168
        client = clients IntMap.! clID
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   169
3283
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   170
handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "LATEST_PROTO", protoNum] =
3260
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   171
    [ModifyServerInfo (\si -> si{latestReleaseVersion = fromJust readNum}) | isAdministrator client && isJust readNum]
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   172
    where
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   173
        client = clients IntMap.! clID
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   174
        readNum = maybeRead protoNum :: Maybe Word16
1925
ec923e56c444 Allow admin to set server's motd
unc0rr
parents: 1905
diff changeset
   175
3283
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   176
handleCmd_lobby clID clients rooms ["GET_SERVER_VAR"] =
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   177
    [SendServerVars | isAdministrator client]
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   178
    where
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   179
        client = clients IntMap.! clID
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   180
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   181
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   182
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
   183
        [ClearAccountsCache | isAdministrator client]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   184
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   185
        client = clients IntMap.! clID
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   186
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   187
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   188
handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
   189
-}