gameServer/HWProtoNEState.hs
author nemo
Thu, 01 Jul 2010 23:41:10 -0400
changeset 3608 c509bbc779e7
parent 3566 772a46ef8288
child 3671 a94d1dc4a8d9
permissions -rw-r--r--
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.

{-# LANGUAGE OverloadedStrings #-}
module HWProtoNEState where

import qualified Data.IntMap as IntMap
import Maybe
import Data.List
import Data.Word
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as B
--------------------------------------
import CoreTypes
import Actions
import Utils
import RoomsAndClients

handleCmd_NotEntered :: CmdHandler

handleCmd_NotEntered ["NICK", newNick] = do
    (ci, irnc) <- ask
    let cl = irnc `client` ci
    if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"]
        else
        if haveSameNick irnc (nick cl) then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""]
            else
            if illegalName newNick then return [ByeClient "Illegal nickname"]
                else
                return $
                    ModifyClient (\c -> c{nick = newNick}) :
                    AnswerClients [sendChan cl] ["NICK", newNick] :
                    [CheckRegistered | clientProto cl /= 0]
    where
    haveSameNick irnc clNick = isJust $ find (\cl -> newNick == clNick) $ map (client irnc) $ allClients irnc

handleCmd_NotEntered ["PROTO", protoNum] = do
    (ci, irnc) <- ask
    let cl = irnc `client` ci
    if clientProto cl > 0 then return [ProtocolError "Protocol already known"]
        else
        if parsedProto == 0 then return [ProtocolError "Bad number"]
            else
            return $
                ModifyClient (\c -> c{clientProto = parsedProto}) :
                AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] :
                [CheckRegistered | not . B.null $ nick cl]
    where
        parsedProto = case B.readInt protoNum of
                           Just (i, t) | B.null t -> fromIntegral i
                           otherwise -> 0


handleCmd_NotEntered ["PASSWORD", passwd] = do
    (ci, irnc) <- ask
    let cl = irnc `client` ci

    if passwd == webPassword cl then
        return $ JoinLobby : [AnswerClients [sendChan cl] ["ADMIN_ACCESS"] | isAdministrator cl]
        else
        return [ByeClient "Authentication failed"]

{-

handleCmd_NotEntered clID clients _ ["DUMP"] =
    if isAdministrator (clients IntMap.! clID) then [Dump] else []
-}

handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"]