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