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
onLoginFinished :: Int -> String -> Word16 -> Clients -> [Action]
+ − 15
onLoginFinished clID clientNick clProto clients =
+ − 16
if (null $ clientNick) || (clProto == 0) then
+ − 17
[]
+ − 18
else
+ − 19
(RoomAddThisClient 0)
+ − 20
: answerLobbyNicks
+ − 21
-- ++ (answerServerMessage client clients)
+ − 22
where
+ − 23
lobbyNicks = filter (\n -> (not (null n))) $ map nick $ IntMap.elems clients
+ − 24
answerLobbyNicks = if not $ null lobbyNicks then
+ − 25
[AnswerThisClient (["LOBBY:JOINED"] ++ lobbyNicks)]
+ − 26
else
+ − 27
[]
+ − 28
+ − 29
+ − 30
handleCmd_NotEntered clID clients _ ["NICK", newNick] =
+ − 31
if not . null $ nick client then
+ − 32
[ProtocolError "Nick already chosen"]
+ − 33
else if haveSameNick then
+ − 34
[AnswerThisClient ["WARNING", "Nick collision"]]
+ − 35
++ [ByeClient ""]
+ − 36
else
+ − 37
[ModifyClient (\c -> c{nick = newNick}),
+ − 38
AnswerThisClient ["NICK", newNick]]
+ − 39
++ (onLoginFinished clID newNick (clientProto client) clients)
+ − 40
where
+ − 41
client = clients IntMap.! clID
+ − 42
haveSameNick = isJust $ find (\cl -> newNick == nick cl) $ IntMap.elems clients
+ − 43
+ − 44
+ − 45
handleCmd_NotEntered clID clients _ ["PROTO", protoNum] =
+ − 46
if clientProto client > 0 then
+ − 47
[ProtocolError "Protocol already known"]
+ − 48
else if parsedProto == 0 then
+ − 49
[ProtocolError "Bad number"]
+ − 50
else
+ − 51
[ModifyClient (\c -> c{clientProto = parsedProto}),
+ − 52
AnswerThisClient ["PROTO", show parsedProto]]
+ − 53
++ (onLoginFinished clID (nick client) parsedProto clients)
+ − 54
where
+ − 55
client = clients IntMap.! clID
+ − 56
parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
+ − 57
+ − 58
+ − 59
handleCmd_NotEntered _ _ _ ["DUMP"] =
+ − 60
[Dump]
+ − 61
+ − 62
+ − 63
handleCmd_NotEntered clID _ _ _ = [ProtocolError "Incorrect command (state: not entered)"]