1 {-# LANGUAGE OverloadedStrings #-} |
|
2 module HWProtoNEState where |
1 module HWProtoNEState where |
3 |
2 |
4 import qualified Data.IntMap as IntMap |
3 import qualified Data.IntMap as IntMap |
5 import Data.Maybe |
4 import Data.Maybe |
6 import Data.List |
5 import Data.List |
7 import Data.Word |
6 import Data.Word |
8 import Control.Monad.Reader |
|
9 import qualified Data.ByteString.Char8 as B |
|
10 -------------------------------------- |
7 -------------------------------------- |
11 import CoreTypes |
8 import CoreTypes |
12 import Actions |
9 import Actions |
13 import Utils |
10 import Utils |
14 import RoomsAndClients |
|
15 |
11 |
16 handleCmd_NotEntered :: CmdHandler |
12 handleCmd_NotEntered :: CmdHandler |
17 |
13 |
18 handleCmd_NotEntered ["NICK", newNick] = do |
14 handleCmd_NotEntered clID clients _ ["NICK", newNick] |
19 (ci, irnc) <- ask |
15 | not . null $ nick client = [ProtocolError "Nickname already chosen"] |
20 let cl = irnc `client` ci |
16 | haveSameNick = [AnswerThisClient ["WARNING", "Nickname already in use"], ByeClient ""] |
21 if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"] |
17 | illegalName newNick = [ByeClient "Illegal nickname"] |
22 else |
18 | otherwise = |
23 if haveSameNick irnc (nick cl) then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""] |
19 ModifyClient (\c -> c{nick = newNick}) : |
24 else |
20 AnswerThisClient ["NICK", newNick] : |
25 if illegalName newNick then return [ByeClient "Illegal nickname"] |
21 [CheckRegistered | clientProto client /= 0] |
26 else |
|
27 return $ |
|
28 ModifyClient (\c -> c{nick = newNick}) : |
|
29 AnswerClients [sendChan cl] ["NICK", newNick] : |
|
30 [CheckRegistered | clientProto cl /= 0] |
|
31 where |
22 where |
32 haveSameNick irnc clNick = isJust $ find (\cl -> newNick == clNick) $ map (client irnc) $ allClients irnc |
23 client = clients IntMap.! clID |
33 |
24 haveSameNick = isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients |
34 handleCmd_NotEntered ["PROTO", protoNum] = do |
|
35 (ci, irnc) <- ask |
|
36 let cl = irnc `client` ci |
|
37 if clientProto cl > 0 then return [ProtocolError "Protocol already known"] |
|
38 else |
|
39 if parsedProto == 0 then return [ProtocolError "Bad number"] |
|
40 else |
|
41 return $ |
|
42 ModifyClient (\c -> c{clientProto = parsedProto}) : |
|
43 AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] : |
|
44 [CheckRegistered | not . B.null $ nick cl] |
|
45 where |
|
46 parsedProto = case B.readInt protoNum of |
|
47 Just (i, t) | B.null t -> fromIntegral i |
|
48 otherwise -> 0 |
|
49 |
25 |
50 |
26 |
51 handleCmd_NotEntered ["PASSWORD", passwd] = do |
27 handleCmd_NotEntered clID clients _ ["PROTO", protoNum] |
52 (ci, irnc) <- ask |
28 | clientProto client > 0 = [ProtocolError "Protocol already known"] |
53 let cl = irnc `client` ci |
29 | parsedProto == 0 = [ProtocolError "Bad number"] |
|
30 | otherwise = |
|
31 ModifyClient (\c -> c{clientProto = parsedProto}) : |
|
32 AnswerThisClient ["PROTO", show parsedProto] : |
|
33 [CheckRegistered | (not . null) (nick client)] |
|
34 where |
|
35 client = clients IntMap.! clID |
|
36 parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
54 |
37 |
55 if passwd == webPassword cl then |
|
56 return $ JoinLobby : [AnswerClients [sendChan cl] ["ADMIN_ACCESS"] | isAdministrator cl] |
|
57 else |
|
58 return [ByeClient "Authentication failed"] |
|
59 |
38 |
60 {- |
39 handleCmd_NotEntered clID clients _ ["PASSWORD", passwd] = |
|
40 if passwd == webPassword client then |
|
41 [ModifyClient (\cl -> cl{logonPassed = True}), |
|
42 MoveToLobby] ++ adminNotice |
|
43 else |
|
44 [ByeClient "Authentication failed"] |
|
45 where |
|
46 client = clients IntMap.! clID |
|
47 adminNotice = [AnswerThisClient ["ADMIN_ACCESS"] | isAdministrator client] |
|
48 |
61 |
49 |
62 handleCmd_NotEntered clID clients _ ["DUMP"] = |
50 handleCmd_NotEntered clID clients _ ["DUMP"] = |
63 if isAdministrator (clients IntMap.! clID) then [Dump] else [] |
51 if isAdministrator (clients IntMap.! clID) then [Dump] else [] |
64 -} |
|
65 |
52 |
66 handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"] |
53 |
|
54 handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"] |