gameServer/HWProtoNEState.hs
author unc0rr
Fri, 12 Nov 2010 20:42:36 +0300
branch0.9.14
changeset 4247 b9fe93f187c4
parent 4242 5e3c5fe2cb14
child 4295 1f5604cd99be
child 4334 82cfbbab73da
permissions -rw-r--r--
Make server listen on ipv4 interface only
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module HWProtoNEState where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
import qualified Data.IntMap as IntMap
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
     4
import Maybe
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Data.List
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Data.Word
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
handleCmd_NotEntered :: CmdHandler
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    14
handleCmd_NotEntered clID clients _ ["NICK", newNick]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    15
    | not . null $ nick client = [ProtocolError "Nickname already chosen"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    16
    | haveSameNick = [AnswerThisClient ["WARNING", "Nickname already in use"], ByeClient ""]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    17
    | illegalName newNick = [ByeClient "Illegal nickname"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    18
    | otherwise =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    19
        ModifyClient (\c -> c{nick = newNick}) :
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    20
        AnswerThisClient ["NICK", newNick] :
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    21
        [CheckRegistered | clientProto client /= 0]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    22
    where
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    23
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    24
        haveSameNick = isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1834
diff changeset
    25
3536
7d99655130ff Partially reimplement joining rooms
unc0rr
parents: 3500
diff changeset
    26
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    27
handleCmd_NotEntered clID clients _ ["PROTO", protoNum]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    28
    | clientProto client > 0 = [ProtocolError "Protocol already known"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    29
    | parsedProto == 0 = [ProtocolError "Bad number"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    30
    | otherwise =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    31
        ModifyClient (\c -> c{clientProto = parsedProto}) :
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    32
        AnswerThisClient ["PROTO", show parsedProto] :
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    33
        [CheckRegistered | (not . null) (nick client)]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    34
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    35
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    36
        parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1847
diff changeset
    37
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    39
handleCmd_NotEntered clID clients _ ["PASSWORD", passwd] =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    40
    if passwd == webPassword client then
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    41
        [ModifyClient (\cl -> cl{logonPassed = True}),
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    42
        MoveToLobby] ++ adminNotice
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    43
    else
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    44
        [ByeClient "Authentication failed"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    45
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    46
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    47
        adminNotice = [AnswerThisClient ["ADMIN_ACCESS"] | isAdministrator client]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    48
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
2868
ccb20ecd3503 Some debug stuff
unc0rr
parents: 2867
diff changeset
    50
handleCmd_NotEntered clID clients _ ["DUMP"] =
ccb20ecd3503 Some debug stuff
unc0rr
parents: 2867
diff changeset
    51
    if isAdministrator (clients IntMap.! clID) then [Dump] else []
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    52
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3671
diff changeset
    54
handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"]