author | koda |
Wed, 08 Jul 2009 15:03:57 +0000 | |
changeset 2243 | b4764993f833 |
parent 2155 | d897222d3339 |
child 2349 | ba7a0813c532 |
permissions | -rw-r--r-- |
1804 | 1 |
module HWProtoNEState where |
2 |
||
3 |
import qualified Data.IntMap as IntMap |
|
4 |
import Maybe |
|
5 |
import Data.List |
|
6 |
import Data.Word |
|
7 |
-------------------------------------- |
|
8 |
import CoreTypes |
|
9 |
import Actions |
|
10 |
import Utils |
|
11 |
||
12 |
handleCmd_NotEntered :: CmdHandler |
|
13 |
||
14 |
handleCmd_NotEntered clID clients _ ["NICK", newNick] = |
|
15 |
if not . null $ nick client then |
|
2150
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
1879
diff
changeset
|
16 |
[ProtocolError "Nickname already chosen"] |
1804 | 17 |
else if haveSameNick then |
2150
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
1879
diff
changeset
|
18 |
[AnswerThisClient ["WARNING", "Nickname collision"]] |
1804 | 19 |
++ [ByeClient ""] |
2150
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
1879
diff
changeset
|
20 |
else if illegalName newNick then |
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
1879
diff
changeset
|
21 |
[ByeClient "Illegal nickname"] |
1804 | 22 |
else |
23 |
[ModifyClient (\c -> c{nick = newNick}), |
|
24 |
AnswerThisClient ["NICK", newNick]] |
|
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1834
diff
changeset
|
25 |
++ checkPassword |
1804 | 26 |
where |
27 |
client = clients IntMap.! clID |
|
28 |
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
|
29 |
checkPassword = if clientProto client /= 0 then [CheckRegistered] else [] |
1804 | 30 |
|
31 |
||
32 |
handleCmd_NotEntered clID clients _ ["PROTO", protoNum] = |
|
33 |
if clientProto client > 0 then |
|
34 |
[ProtocolError "Protocol already known"] |
|
35 |
else if parsedProto == 0 then |
|
36 |
[ProtocolError "Bad number"] |
|
37 |
else |
|
38 |
[ModifyClient (\c -> c{clientProto = parsedProto}), |
|
39 |
AnswerThisClient ["PROTO", show parsedProto]] |
|
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1834
diff
changeset
|
40 |
++ checkPassword |
1804 | 41 |
where |
42 |
client = clients IntMap.! clID |
|
43 |
parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
|
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1834
diff
changeset
|
44 |
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
|
45 |
|
1879 | 46 |
|
1844 | 47 |
handleCmd_NotEntered clID clients _ ["PASSWORD", passwd] = |
48 |
if passwd == webPassword client then |
|
49 |
[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
|
50 |
MoveToLobby] ++ adminNotice |
1844 | 51 |
else |
52 |
[ByeClient "Authentication failed"] |
|
53 |
where |
|
54 |
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
|
55 |
adminNotice = if isAdministrator client then [AnswerThisClient ["ADMIN_ACCESS"]] else [] |
1804 | 56 |
|
57 |
||
2155
d897222d3339
Implement ability for server admin to clear accounts cache
unc0rr
parents:
2150
diff
changeset
|
58 |
--handleCmd_NotEntered _ _ _ ["DUMP"] = |
d897222d3339
Implement ability for server admin to clear accounts cache
unc0rr
parents:
2150
diff
changeset
|
59 |
-- [Dump] |
1804 | 60 |
|
61 |
||
62 |
handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"] |