gameServer/HWProtoNEState.hs
author nemo
Tue, 08 Sep 2009 19:44:49 +0000
changeset 2357 babe1a55e284
parent 2352 7eaf82cf0890
child 2747 7889a3a9724f
permissions -rw-r--r--
Add an empty weapon to avoid selection of weapons which aren't yet ready. Might all be useful to switch to amNothing in certain situations, like after using up all ropes, instead of bazooka.
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]
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    15
	| not . null $ nick client = [ProtocolError "Nickname already chosen"]
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    16
	| haveSameNick = [AnswerThisClient ["WARNING", "Nickname collision"], ByeClient ""]
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    17
	| illegalName newNick = [ByeClient "Illegal nickname"]
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    18
	| otherwise =
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    19
		ModifyClient (\c -> c{nick = newNick}) :
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    20
		AnswerThisClient ["NICK", newNick] :
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    21
		[CheckRegistered | clientProto client /= 0]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
		haveSameNick = isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients
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]
ba7a0813c532 Some fixes suggested by hlint
unc0rr
parents: 2155
diff changeset
    28
	| clientProto client > 0 = [ProtocolError "Protocol already known"]
ba7a0813c532 Some fixes suggested by hlint
unc0rr
parents: 2155
diff changeset
    29
	| parsedProto == 0 = [ProtocolError "Bad number"]
ba7a0813c532 Some fixes suggested by hlint
unc0rr
parents: 2155
diff changeset
    30
	| otherwise =
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    31
		ModifyClient (\c -> c{clientProto = parsedProto}) :
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    32
		AnswerThisClient ["PROTO", show parsedProto] :
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2349
diff changeset
    33
		[CheckRegistered | (not . null) (nick client)]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
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] =
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    40
	if passwd == webPassword client then
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    41
		[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
    42
		MoveToLobby] ++ adminNotice
1844
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    43
	else
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    44
		[ByeClient "Authentication failed"]
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    45
	where
81abed9d4c11 Ask user password and send it to server
unc0rr
parents: 1841
diff changeset
    46
		client = clients IntMap.! clID
2349
ba7a0813c532 Some fixes suggested by hlint
unc0rr
parents: 2155
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
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
    50
--handleCmd_NotEntered _ _ _ ["DUMP"] =
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2150
diff changeset
    51
--	[Dump]
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)"]