gameServer/HWProtoCore.hs
author unc0rr
Sat, 29 Jan 2011 21:33:24 +0300
branchserver_refactor
changeset 4612 e82758d6f924
parent 4337 85e02b1a8e8f
child 4614 26661bf28dd5
permissions -rw-r--r--
- Reactivate pings timer, reimplement PING handler - Reimplement 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 HWProtoCore where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
     4
import Control.Monad.Reader
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
     5
import Data.Maybe
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
     6
import Data.List
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
     7
import qualified Data.ByteString.Char8 as B
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import HWProtoNEState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import HWProtoLobbyState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import HWProtoInRoomState
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
    14
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
    15
import RoomsAndClients
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    16
import Utils
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    18
handleCmd, handleCmd_loggedin :: CmdHandler
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
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
    20
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
    21
handleCmd ["PING"] = answerClient ["PONG"]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
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
    23
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
    24
handleCmd ("QUIT" : xs) = return [ByeClient msg]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    25
    where
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    26
        msg = if not $ null xs then head xs else "bye"
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    27
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    29
handleCmd ["PONG"] = do
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    30
    cl <- thisClient
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    31
    if pingsQueue cl == 0 then
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    32
        return [ProtocolError "Protocol violation"]
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    33
        else
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    34
        return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})]
1928
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    35
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
    36
handleCmd cmd = 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
    37
    (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
    38
    if logonPassed (irnc `client` ci) 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
    39
        handleCmd_loggedin cmd
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
        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
    41
        handleCmd_NotEntered cmd
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    42
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    43
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    44
handleCmd_loggedin ["INFO", asknick] = do
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    45
    (_, rnc) <- ask
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    46
    let allClientIDs = allClients rnc
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    47
    let maybeClientId = find (\clId -> asknick == nick (client rnc clId)) allClientIDs
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    48
    let noSuchClient = isNothing maybeClientId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    49
    let clientId = fromJust maybeClientId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    50
    let cl = rnc `client` fromJust maybeClientId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    51
    let roomId = clientRoom rnc clientId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    52
    let clRoom = room rnc roomId
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    53
    let roomMasterSign = if isMaster cl then "@" else ""
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    54
    let adminSign = if isAdministrator cl then "@" else ""
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    55
    let roomInfo = if roomId /= lobbyId then roomMasterSign `B.append` "room " `B.append` (name clRoom) else adminSign `B.append` "lobby"
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    56
    let roomStatus = if gameinprogress clRoom then
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    57
            if teamsInGame cl > 0 then "(playing)" else "(spectating)"
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    58
            else
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    59
            ""
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    60
    if noSuchClient then
4612
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    61
        return []
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    62
        else
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    63
        answerClient [
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    64
            "INFO",
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    65
            nick cl,
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    66
            "[" `B.append` host cl `B.append` "]",
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    67
            protoNumber2ver $ clientProto cl,
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    68
            "[" `B.append` roomInfo `B.append` "]" `B.append` roomStatus
e82758d6f924 - Reactivate pings timer, reimplement PING handler
unc0rr
parents: 4337
diff changeset
    69
            ]
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    70
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
    71
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_loggedin cmd = 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, rnc) <- 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
    if clientRoom rnc ci == lobbyId 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
    75
        handleCmd_lobby cmd
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
        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
    77
        handleCmd_inRoom cmd