gameServer/HWProtoLobbyState.hs
author unc0rr
Wed, 26 Jan 2011 22:26:02 +0300
branchserver_refactor
changeset 4595 cd4433b44920
parent 4591 c91364bf6a69
child 4597 31e042ab870c
permissions -rw-r--r--
Send spectators info
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
     1
{-# LANGUAGE OverloadedStrings #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
module HWProtoLobbyState where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import qualified Data.Map as Map
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
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
     7
import Data.Maybe
1804
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
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    10
import Control.Monad.Reader
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    11
import qualified Data.ByteString.Char8 as B
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
import Utils
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    16
import HandlerUtils
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    17
import RoomsAndClients
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
4591
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
    19
answerAllTeams cl = concatMap toAnswer
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    20
    where
4591
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
    21
        clChan = sendChan cl
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    22
        toAnswer team =
4591
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
    23
            [AnswerClients [clChan] $ teamToNet team,
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
    24
            AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
    25
            AnswerClients [clChan] ["HH_NUM", teamname team, B.pack . show $ hhnum team]]
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
    26
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
handleCmd_lobby :: CmdHandler
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    29
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    30
handleCmd_lobby ["LIST"] = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    31
    (ci, irnc) <- ask
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    32
    let cl = irnc `client` ci
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    33
    rooms <- allRoomInfos
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    34
    let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    35
    return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    36
    where
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    37
        roomInfo irnc room = [
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    38
                showB $ gameinprogress room,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
    39
                name room,
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    40
                showB $ playersIn room,
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    41
                showB $ length $ teams room,
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    42
                nick $ irnc `client` masterID room,
2867
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
                ]
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    47
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    48
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    49
handleCmd_lobby ["CHAT", msg] = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    50
    n <- clientNick
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    51
    s <- roomOthersChans
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    52
    return [AnswerClients s ["CHAT", n, msg]]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    53
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    54
handleCmd_lobby ["CREATE_ROOM", newRoom, roomPassword]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    55
    | illegalName newRoom = return [Warning "Illegal room name"]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    56
    | otherwise = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    57
        rs <- allRoomInfos
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    58
        cl <- thisClient
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    59
        return $ if isJust $ find (\room -> newRoom == name room) rs then 
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    60
            [Warning "Room exists"]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    61
            else
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    62
            [
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    63
                AddRoom newRoom roomPassword,
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    64
                AnswerClients [sendChan cl] ["NOT_READY", nick cl]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    65
            ]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    66
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    67
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    68
handleCmd_lobby ["CREATE_ROOM", newRoom] =
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    69
    handleCmd_lobby ["CREATE_ROOM", newRoom, ""]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    70
3536
7d99655130ff Partially reimplement joining rooms
unc0rr
parents: 3502
diff changeset
    71
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    72
handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    73
    (ci, irnc) <- ask
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    74
    let ris = allRooms irnc
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    75
    cl <- thisClient
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    76
    let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    77
    let jRI = fromJust maybeRI
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    78
    let jRoom = irnc `room` jRI
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    79
    let jRoomClients = map (client irnc) $! roomClients irnc jRI -- no lazyness here!
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    80
    return $
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    81
        if isNothing maybeRI then 
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    82
            [Warning "No such rooms"]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    83
            else if isRestrictedJoins jRoom then
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    84
            [Warning "Joining restricted"]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    85
            else if roomPassword /= password jRoom then
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    86
            [Warning "Wrong password"]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    87
            else
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    88
            [
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    89
                MoveToRoom jRI,
4571
597440c80b8a Bring back room and teams removing
unc0rr
parents: 4337
diff changeset
    90
                AnswerClients (map sendChan $ cl : jRoomClients) ["NOT_READY", nick cl],
597440c80b8a Bring back room and teams removing
unc0rr
parents: 4337
diff changeset
    91
                AnswerClients [sendChan cl] $ "JOINED" : map nick jRoomClients
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    92
            ]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    93
            ++ (map (readynessMessage cl) jRoomClients)
4587
adf64662b6a8 Send room config to client
unc0rr
parents: 4571
diff changeset
    94
            ++ (answerFullConfig cl $ params jRoom)
4591
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
    95
            ++ (answerTeams cl jRoom)
4595
cd4433b44920 Send spectators info
unc0rr
parents: 4591
diff changeset
    96
            ++ (watchRound cl jRoom)
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    97
4587
adf64662b6a8 Send room config to client
unc0rr
parents: 4571
diff changeset
    98
        where
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    99
        readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c]
3536
7d99655130ff Partially reimplement joining rooms
unc0rr
parents: 3502
diff changeset
   100
4587
adf64662b6a8 Send room config to client
unc0rr
parents: 4571
diff changeset
   101
        toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs
adf64662b6a8 Send room config to client
unc0rr
parents: 4571
diff changeset
   102
adf64662b6a8 Send room config to client
unc0rr
parents: 4571
diff changeset
   103
        answerFullConfig cl params = map (toAnswer cl) (leftConfigPart ++ rightConfigPart)
adf64662b6a8 Send room config to client
unc0rr
parents: 4571
diff changeset
   104
            where
adf64662b6a8 Send room config to client
unc0rr
parents: 4571
diff changeset
   105
            (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") $ Map.toList params
adf64662b6a8 Send room config to client
unc0rr
parents: 4571
diff changeset
   106
4591
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
   107
        answerTeams cl jRoom = let f = if gameinprogress jRoom then teamsAtStart else teams in answerAllTeams cl $ f jRoom
c91364bf6a69 Send teams info on join
unc0rr
parents: 4587
diff changeset
   108
4595
cd4433b44920 Send spectators info
unc0rr
parents: 4591
diff changeset
   109
        watchRound cl jRoom = if not $ gameinprogress jRoom then
cd4433b44920 Send spectators info
unc0rr
parents: 4591
diff changeset
   110
                    []
cd4433b44920 Send spectators info
unc0rr
parents: 4591
diff changeset
   111
                else
cd4433b44920 Send spectators info
unc0rr
parents: 4591
diff changeset
   112
                    [AnswerClients [sendChan cl]  ["RUN_GAME"],
cd4433b44920 Send spectators info
unc0rr
parents: 4591
diff changeset
   113
                    AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
cd4433b44920 Send spectators info
unc0rr
parents: 4591
diff changeset
   114
3536
7d99655130ff Partially reimplement joining rooms
unc0rr
parents: 3502
diff changeset
   115
7d99655130ff Partially reimplement joining rooms
unc0rr
parents: 3502
diff changeset
   116
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   117
{-
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   118
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2155
diff changeset
   119
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
   120
    | noSuchRoom = [Warning "No such room"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   121
    | isRestrictedJoins jRoom = [Warning "Joining restricted"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   122
    | roomPassword /= password jRoom = [Warning "Wrong password"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   123
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   124
        [RoomRemoveThisClient "", -- leave lobby
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   125
        RoomAddThisClient rID] -- join room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   126
        ++ answerNicks
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   127
        ++ answerReady
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   128
        ++ [AnswerThisRoom ["NOT_READY", nick client]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   129
        ++ answerFullConfig
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   130
        ++ answerTeams
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   131
        ++ watchRound
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   132
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   133
        answerNicks =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   134
            [AnswerThisClient $ "JOINED" :
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   135
            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
   136
        answerReady = map
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   137
            ((\ c ->
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   138
                AnswerThisClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   139
                [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
   140
            . (\ clID -> clients IntMap.! clID))
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   141
            roomClientsIDs
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   142
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   143
        toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   144
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   145
        answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   146
        (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
1813
cfe1481e0247 Removeteam action
unc0rr
parents: 1811
diff changeset
   147
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   148
        watchRound = if not $ gameinprogress jRoom then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   149
                    []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   150
                else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   151
                    [AnswerThisClient  ["RUN_GAME"],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   152
                    AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
1813
cfe1481e0247 Removeteam action
unc0rr
parents: 1811
diff changeset
   153
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   154
        answerTeams = if gameinprogress jRoom then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   155
                answerAllTeams (clientProto client) (teamsAtStart jRoom)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   156
            else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   157
                answerAllTeams (clientProto client) (teams jRoom)
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   158
-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   159
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   160
handleCmd_lobby ["JOIN_ROOM", roomName] =
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   161
    handleCmd_lobby ["JOIN_ROOM", roomName, ""]
3425
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 3283
diff changeset
   162
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   163
{-
2961
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   164
handleCmd_lobby clID clients rooms ["FOLLOW", asknick] =
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   165
    if noSuchClient || roomID followClient == 0 then
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   166
        []
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   167
    else
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   168
        handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName]
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   169
    where
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   170
        maybeClient = Foldable.find (\cl -> asknick == nick cl) clients
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   171
        noSuchClient = isNothing maybeClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   172
        followClient = fromJust maybeClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   173
        roomName = name $ rooms IntMap.! roomID followClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file
unc0rr
parents: 2867
diff changeset
   174
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   175
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   176
    ---------------------------
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   177
    -- Administrator's stuff --
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   178
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   179
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
   180
        [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
   181
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   182
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   183
        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
   184
        noSuchClient = isNothing maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   185
        kickID = clientUID $ fromJust maybeClient
1866
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   186
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   187
36aa0ca6e8af Cut the length of most used net packet
unc0rr
parents: 1862
diff changeset
   188
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
   189
    if not $ isAdministrator client then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   190
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   191
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   192
        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
   193
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   194
        client = clients IntMap.! clID
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1815
diff changeset
   195
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   196
3283
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   197
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   198
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
   199
        [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   200
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   201
        client = clients IntMap.! clID
1925
ec923e56c444 Allow admin to set server's motd
unc0rr
parents: 1905
diff changeset
   202
3283
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   203
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
   204
        [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
   205
    where
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   206
        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
   207
3283
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   208
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
   209
    [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
   210
    where
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2961
diff changeset
   211
        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
   212
        readNum = maybeRead protoNum :: Maybe Word16
1925
ec923e56c444 Allow admin to set server's motd
unc0rr
parents: 1905
diff changeset
   213
3283
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   214
handleCmd_lobby clID clients rooms ["GET_SERVER_VAR"] =
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   215
    [SendServerVars | isAdministrator client]
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   216
    where
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   217
        client = clients IntMap.! clID
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   218
18ee933a5864 Some stuff for game server administration task
unc0rr
parents: 3277
diff changeset
   219
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   220
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
   221
        [ClearAccountsCache | isAdministrator client]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   222
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2408
diff changeset
   223
        client = clients IntMap.! clID
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   224
-}
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   225
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
   226
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
   227
handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"]