author | mbait |
Mon, 10 May 2010 04:43:07 +0000 | |
changeset 3455 | f33e7ad2261c |
parent 3435 | 4e4f88a7bdf2 |
child 3458 | 11cd56019f00 |
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 |
||
3435 | 14 |
{- |
2352 | 15 |
handleCmd_NotEntered clID clients _ ["NICK", newNick] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
16 |
| 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
|
17 |
| 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
|
18 |
| illegalName newNick = [ByeClient "Illegal nickname"] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
19 |
| otherwise = |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
20 |
ModifyClient (\c -> c{nick = newNick}) : |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
21 |
AnswerThisClient ["NICK", newNick] : |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
22 |
[CheckRegistered | clientProto client /= 0] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
23 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
24 |
client = clients IntMap.! clID |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
25 |
haveSameNick = isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients |
1804 | 26 |
|
27 |
||
2349 | 28 |
handleCmd_NotEntered clID clients _ ["PROTO", protoNum] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
29 |
| clientProto client > 0 = [ProtocolError "Protocol already known"] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
30 |
| parsedProto == 0 = [ProtocolError "Bad number"] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
31 |
| otherwise = |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
32 |
ModifyClient (\c -> c{clientProto = parsedProto}) : |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
33 |
AnswerThisClient ["PROTO", show parsedProto] : |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
34 |
[CheckRegistered | (not . null) (nick client)] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
35 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
36 |
client = clients IntMap.! clID |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
37 |
parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1834
diff
changeset
|
38 |
|
1879 | 39 |
|
1844 | 40 |
handleCmd_NotEntered clID clients _ ["PASSWORD", passwd] = |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
41 |
if passwd == webPassword client then |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
42 |
[ModifyClient (\cl -> cl{logonPassed = True}), |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
43 |
MoveToLobby] ++ adminNotice |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
44 |
else |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
45 |
[ByeClient "Authentication failed"] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
46 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
47 |
client = clients IntMap.! clID |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
48 |
adminNotice = [AnswerThisClient ["ADMIN_ACCESS"] | isAdministrator client] |
1804 | 49 |
|
50 |
||
2868 | 51 |
handleCmd_NotEntered clID clients _ ["DUMP"] = |
52 |
if isAdministrator (clients IntMap.! clID) then [Dump] else [] |
|
3435 | 53 |
-} |
1804 | 54 |
|
3435 | 55 |
handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"] |