author | nemo |
Sun, 20 Mar 2011 12:52:36 -0400 | |
changeset 5031 | e26f430be1ed |
parent 4991 | 90d1fb9fc2e1 |
child 5030 | 42746c5d4a80 |
permissions | -rw-r--r-- |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
1 |
{-# LANGUAGE OverloadedStrings #-} |
1804 | 2 |
module HWProtoNEState where |
3 |
||
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
4 |
import Control.Monad.Reader |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
5 |
import qualified Data.ByteString.Char8 as B |
1804 | 6 |
-------------------------------------- |
7 |
import CoreTypes |
|
8 |
import Actions |
|
9 |
import Utils |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
10 |
import RoomsAndClients |
1804 | 11 |
|
4989 | 12 |
handleCmd_NotEntered :: CmdHandler |
1804 | 13 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
14 |
handleCmd_NotEntered ["NICK", newNick] = do |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
15 |
(ci, irnc) <- ask |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
16 |
let cl = irnc `client` ci |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
17 |
if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
18 |
else |
4991 | 19 |
if illegalName newNick then return [ByeClient "Illegal nickname"] |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
20 |
else |
4991 | 21 |
return $ |
22 |
ModifyClient (\c -> c{nick = newNick}) : |
|
23 |
AnswerClients [sendChan cl] ["NICK", newNick] : |
|
24 |
[CheckRegistered | clientProto cl /= 0] |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
25 |
|
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
26 |
handleCmd_NotEntered ["PROTO", protoNum] = do |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
27 |
(ci, irnc) <- ask |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
28 |
let cl = irnc `client` ci |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
29 |
if clientProto cl > 0 then return [ProtocolError "Protocol already known"] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
30 |
else |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
31 |
if parsedProto == 0 then return [ProtocolError "Bad number"] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
32 |
else |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
33 |
return $ |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
34 |
ModifyClient (\c -> c{clientProto = parsedProto}) : |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
35 |
AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] : |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
36 |
[CheckRegistered | not . B.null $ nick cl] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
37 |
where |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
38 |
parsedProto = case B.readInt protoNum of |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
39 |
Just (i, t) | B.null t -> fromIntegral i |
4932 | 40 |
_ -> 0 |
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1834
diff
changeset
|
41 |
|
3536 | 42 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
43 |
handleCmd_NotEntered ["PASSWORD", passwd] = do |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
44 |
(ci, irnc) <- ask |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
45 |
let cl = irnc `client` ci |
1879 | 46 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
47 |
if passwd == webPassword cl then |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
48 |
return $ JoinLobby : [AnswerClients [sendChan cl] ["ADMIN_ACCESS"] | isAdministrator cl] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
49 |
else |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
50 |
return [ByeClient "Authentication failed"] |
1879 | 51 |
|
1804 | 52 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
53 |
handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"] |