gameServer/HWProtoNEState.hs
author koda
Sat, 20 Mar 2010 15:16:59 +0000
changeset 3025 01682ec58eb0
parent 2868 ccb20ecd3503
child 3435 4e4f88a7bdf2
permissions -rw-r--r--
update project for ipad target relocate objects (windbar, fps, timer) so that window size doesn't matter move touch input in its custom controller rather than hack sdl one
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import Maybe
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
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    14
handleCmd_NotEntered clID clients _ ["NICK", newNick]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    15
    | not . null $ nick client = [ProtocolError "Nickname already chosen"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    16
    | haveSameNick = [AnswerThisClient ["WARNING", "Nickname already in use"], ByeClient ""]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    17
    | illegalName newNick = [ByeClient "Illegal nickname"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    18
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    19
        ModifyClient (\c -> c{nick = newNick}) :
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    20
        AnswerThisClient ["NICK", newNick] :
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    21
        [CheckRegistered | clientProto client /= 0]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    22
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    23
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    24
        haveSameNick = isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
2349
ba7a0813c532 Some fixes suggested by hlint
unc0rr
parents: 2155
diff changeset
    27
handleCmd_NotEntered clID clients _ ["PROTO", protoNum]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    28
    | clientProto client > 0 = [ProtocolError "Protocol already known"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    29
    | parsedProto == 0 = [ProtocolError "Bad number"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    30
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    31
        ModifyClient (\c -> c{clientProto = parsedProto}) :
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    32
        AnswerThisClient ["PROTO", show parsedProto] :
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    33
        [CheckRegistered | (not . null) (nick client)]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    34
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    35
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    36
        parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1834
diff changeset
    37
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1847
diff changeset
    38
1844
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    39
handleCmd_NotEntered clID clients _ ["PASSWORD", passwd] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    40
    if passwd == webPassword client then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    41
        [ModifyClient (\cl -> cl{logonPassed = True}),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    42
        MoveToLobby] ++ adminNotice
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    43
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    44
        [ByeClient "Authentication failed"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    45
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    46
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    47
        adminNotice = [AnswerThisClient ["ADMIN_ACCESS"] | isAdministrator client]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
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 []
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"]