gameServer/HWProtoNEState.hs
author nemo
Wed, 29 Dec 2010 16:21:30 -0500
changeset 4780 8571151411b3
parent 4568 f85243bf890e
child 4862 899b4e3d350a
permissions -rw-r--r--
add a couple of variables to speed up UID lookups. Based on the assumption new visual gears and gears will tend to be at the end of the list. Set them on successful lookup or script gear creation, clear on delete. Oh also pick up a couple of TrevInc's translation changes
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
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
     4
import Data.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
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    14
handleCmd_NotEntered clID clients _ ["NICK", newNick]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    15
    | not . null $ nick client = [ProtocolError "Nickname already chosen"]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    16
    | haveSameNick = [AnswerThisClient ["WARNING", "Nickname already in use"], ByeClient ""]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    17
    | illegalName newNick = [ByeClient "Illegal nickname"]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    18
    | otherwise =
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    19
        ModifyClient (\c -> c{nick = newNick}) :
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    20
        AnswerThisClient ["NICK", newNick] :
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
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
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    23
        client = clients IntMap.! clID
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
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
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    27
handleCmd_NotEntered clID clients _ ["PROTO", protoNum]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    28
    | clientProto client > 0 = [ProtocolError "Protocol already known"]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    29
    | parsedProto == 0 = [ProtocolError "Bad number"]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    30
    | otherwise =
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    31
        ModifyClient (\c -> c{clientProto = parsedProto}) :
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    32
        AnswerThisClient ["PROTO", show parsedProto] :
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    33
        [CheckRegistered | (not . null) (nick client)]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    34
    where
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    35
        client = clients IntMap.! clID
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
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
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    39
handleCmd_NotEntered clID clients _ ["PASSWORD", passwd] =
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    40
    if passwd == webPassword client then
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    41
        [ModifyClient (\cl -> cl{logonPassed = True}),
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    42
        MoveToLobby] ++ adminNotice
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    43
    else
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    44
        [ByeClient "Authentication failed"]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    45
    where
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    46
        client = clients IntMap.! clID
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    47
        adminNotice = [AnswerThisClient ["ADMIN_ACCESS"] | isAdministrator client]
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
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 []
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    52
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    54
handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"]