gameServer/HWProtoNEState.hs
author nemo
Sun, 27 Jul 2014 22:47:52 -0400
changeset 10370 8676ef16c594
parent 10212 5fb3bb2de9d2
child 10460 8dcea9087d75
permissions -rw-r--r--
Using blended makes smilies and CJK less hideous.

{-# LANGUAGE OverloadedStrings, CPP #-}
module HWProtoNEState where

import Control.Monad.Reader
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as B
import Data.Digest.Pure.SHA
--------------------------------------
import CoreTypes
import Utils
import RoomsAndClients
import HandlerUtils

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 $ loc "Nickname already chosen"]
        else
        if illegalName newNick then return [ByeClient $ loc "Illegal nickname"]
            else
            return $
                ModifyClient (\c -> c{nick = newNick}) :
                AnswerClients [sendChan cl] ["NICK", newNick] :
                [CheckRegistered | clientProto cl /= 0]

handleCmd_NotEntered ["PROTO", protoNum] = do
    (ci, irnc) <- ask
    let cl = irnc `client` ci
    if clientProto cl > 0 then return [ProtocolError $ loc "Protocol already known"]
        else
        if parsedProto == 0 then return [ProtocolError $ loc "Bad number"]
            else
            return $
                ModifyClient (\c -> c{clientProto = parsedProto}) :
                AnswerClients [sendChan cl] ["PROTO", showB parsedProto] :
                [CheckRegistered | not . B.null $ nick cl]
    where
        parsedProto = readInt_ protoNum


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

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


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

    let clientHash = h [clientSalt, serverSalt cl, webPassword cl, showB $ clientProto cl, "!hedgewars"]
    let serverHash = h [serverSalt cl, clientSalt, webPassword cl, showB $ clientProto cl, "!hedgewars"]

    if passwd == clientHash then
        return [
            AnswerClients [sendChan cl] ["SERVER_AUTH", serverHash] 
            , JoinLobby
            ]
        else
        return [ByeClient "Authentication failed"]
    where
        h = B.pack . showDigest . sha1 . BL.fromChunks

#if defined(OFFICIAL_SERVER)
handleCmd_NotEntered ["CHECKER", protoNum, newNick, password] = do
    (ci, irnc) <- ask
    let cl = irnc `client` ci

    if parsedProto == 0 then return [ProtocolError $ loc "Bad number"]
        else
        return $ [
            ModifyClient (\c -> c{clientProto = parsedProto, nick = newNick, webPassword = password, isChecker = True})
            , CheckRegistered]
    where
        parsedProto = readInt_ protoNum
#endif

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