gameServer/HWProtoNEState.hs
changeset 4991 90d1fb9fc2e1
parent 4989 4771fed9272e
child 5030 42746c5d4a80
equal deleted inserted replaced
4990:4b5d62ac01f7 4991:90d1fb9fc2e1
     1 {-# LANGUAGE OverloadedStrings #-}
     1 {-# LANGUAGE OverloadedStrings #-}
     2 module HWProtoNEState where
     2 module HWProtoNEState where
     3 
     3 
     4 import Data.Maybe
       
     5 import Data.List
       
     6 import Control.Monad.Reader
     4 import Control.Monad.Reader
     7 import qualified Data.ByteString.Char8 as B
     5 import qualified Data.ByteString.Char8 as B
     8 --------------------------------------
     6 --------------------------------------
     9 import CoreTypes
     7 import CoreTypes
    10 import Actions
     8 import Actions
    16 handleCmd_NotEntered ["NICK", newNick] = do
    14 handleCmd_NotEntered ["NICK", newNick] = do
    17     (ci, irnc) <- ask
    15     (ci, irnc) <- ask
    18     let cl = irnc `client` ci
    16     let cl = irnc `client` ci
    19     if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"]
    17     if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"]
    20         else
    18         else
    21         if haveSameNick irnc then if clientProto cl < 38 then return [ByeClient "Nickname is already in use"] else return [NoticeMessage NickAlreadyInUse]
    19         if illegalName newNick then return [ByeClient "Illegal nickname"]
    22             else
    20             else
    23             if illegalName newNick then return [ByeClient "Illegal nickname"]
    21             return $
    24                 else
    22                 ModifyClient (\c -> c{nick = newNick}) :
    25                 return $
    23                 AnswerClients [sendChan cl] ["NICK", newNick] :
    26                     ModifyClient (\c -> c{nick = newNick}) :
    24                 [CheckRegistered | clientProto cl /= 0]
    27                     AnswerClients [sendChan cl] ["NICK", newNick] :
       
    28                     [CheckRegistered | clientProto cl /= 0]
       
    29     where
       
    30     haveSameNick irnc = isJust . find (== newNick) . map (nick . client irnc) $ allClients irnc
       
    31 
    25 
    32 handleCmd_NotEntered ["PROTO", protoNum] = do
    26 handleCmd_NotEntered ["PROTO", protoNum] = do
    33     (ci, irnc) <- ask
    27     (ci, irnc) <- ask
    34     let cl = irnc `client` ci
    28     let cl = irnc `client` ci
    35     if clientProto cl > 0 then return [ProtocolError "Protocol already known"]
    29     if clientProto cl > 0 then return [ProtocolError "Protocol already known"]