gameServer/HWProtoNEState.hs
author sheepluva
Sun, 06 Feb 2011 11:39:11 +0100
changeset 4929 3dca560e6510
parent 4904 0eab727d4717
child 4932 f11d80bac7ed
permissions -rw-r--r--
I need this export in order to not have the wrapper.c fail to find Game() on linux From this point on compilation and usage of library should work on linux, at least does for me :P

{-# LANGUAGE OverloadedStrings #-}
module HWProtoNEState where

import qualified Data.IntMap as IntMap
import Data.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 then return [NoticeMessage NickAlreadyInUse]
            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 = isJust . find (== newNick) . map (nick . 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 _ = return [ProtocolError "Incorrect command (state: not entered)"]