gameServer/HWProtoNEState.hs
author unc0rr
Fri, 01 May 2009 09:01:44 +0000
changeset 2021 a591afb43768
parent 1879 bb114339eb4e
child 2150 45b695f3a7b9
permissions -rw-r--r--
Some changes in try to fix issue when you enter room with painted map, but frontend shows generated one (most probably bug is triggered by template filters) Untested.
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
handleCmd_NotEntered clID clients _ ["NICK", newNick] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
	if not . null $ nick client then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
		[ProtocolError "Nick already chosen"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
	else if haveSameNick then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
		[AnswerThisClient ["WARNING", "Nick collision"]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
		++ [ByeClient ""]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
		[ModifyClient (\c -> c{nick = newNick}),
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
		AnswerThisClient ["NICK", newNick]]
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1834
diff changeset
    23
		++ checkPassword
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
		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
    27
		checkPassword = if clientProto client /= 0 then [CheckRegistered] else []
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
handleCmd_NotEntered clID clients _ ["PROTO", protoNum] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
	if clientProto client > 0 then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
		[ProtocolError "Protocol already known"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
	else if parsedProto == 0 then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
		[ProtocolError "Bad number"]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
		[ModifyClient (\c -> c{clientProto = parsedProto}),
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
		AnswerThisClient ["PROTO", show parsedProto]]
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1834
diff changeset
    38
		++ checkPassword
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
		parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1834
diff changeset
    42
		checkPassword = if (not . null) (nick client) then [CheckRegistered] else []
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1834
diff changeset
    43
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1847
diff changeset
    44
1844
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    45
handleCmd_NotEntered clID clients _ ["PASSWORD", passwd] =
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    46
	if passwd == webPassword client then
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    47
		[ModifyClient (\cl -> cl{logonPassed = True}),
1847
2178c0fc838c Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents: 1844
diff changeset
    48
		MoveToLobby] ++ adminNotice
1844
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    49
	else
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    50
		[ByeClient "Authentication failed"]
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    51
	where
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    52
		client = clients IntMap.! clID
1847
2178c0fc838c Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents: 1844
diff changeset
    53
		adminNotice = if isAdministrator client then [AnswerThisClient ["ADMIN_ACCESS"]] else []
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
handleCmd_NotEntered _ _ _ ["DUMP"] =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
	[Dump]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    59
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"]