gameServer/HWProtoNEState.hs
author sheepluva
Thu, 21 Mar 2013 15:01:27 +0100
changeset 8763 988901d27abf
parent 8401 87410ae372f6
child 10076 b235e520ea21
permissions -rw-r--r--
don't poison the dead, it's not cool. (poisoning hogs during their death animation would cause them to still be poisoned after resurrect) thanks to CheezeMonkey for pointing this out
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8372
3c193ec03e09 Logon procedure for checkers, introduce invisible clients
unc0rr
parents: 8371
diff changeset
     1
{-# LANGUAGE OverloadedStrings, CPP #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
module HWProtoNEState where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
     4
import Control.Monad.Reader
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
     5
import qualified Data.ByteString.Char8 as B
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Utils
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    10
import RoomsAndClients
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    12
handleCmd_NotEntered :: CmdHandler
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    14
handleCmd_NotEntered ["NICK", newNick] = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    15
    (ci, irnc) <- ask
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    16
    let cl = irnc `client` ci
8401
87410ae372f6 Server messages localization using Qt's l10n subsystem:
unc0rr
parents: 8372
diff changeset
    17
    if not . B.null $ nick cl then return [ProtocolError $ loc "Nickname already chosen"]
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    18
        else
8401
87410ae372f6 Server messages localization using Qt's l10n subsystem:
unc0rr
parents: 8372
diff changeset
    19
        if illegalName newNick then return [ByeClient $ loc "Illegal nickname"]
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    20
            else
4991
90d1fb9fc2e1 Fix check for duplicated nickname
unc0rr
parents: 4989
diff changeset
    21
            return $
90d1fb9fc2e1 Fix check for duplicated nickname
unc0rr
parents: 4989
diff changeset
    22
                ModifyClient (\c -> c{nick = newNick}) :
90d1fb9fc2e1 Fix check for duplicated nickname
unc0rr
parents: 4989
diff changeset
    23
                AnswerClients [sendChan cl] ["NICK", newNick] :
90d1fb9fc2e1 Fix check for duplicated nickname
unc0rr
parents: 4989
diff changeset
    24
                [CheckRegistered | clientProto cl /= 0]
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    25
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    26
handleCmd_NotEntered ["PROTO", protoNum] = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    27
    (ci, irnc) <- ask
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    28
    let cl = irnc `client` ci
8401
87410ae372f6 Server messages localization using Qt's l10n subsystem:
unc0rr
parents: 8372
diff changeset
    29
    if clientProto cl > 0 then return [ProtocolError $ loc "Protocol already known"]
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    30
        else
8401
87410ae372f6 Server messages localization using Qt's l10n subsystem:
unc0rr
parents: 8372
diff changeset
    31
        if parsedProto == 0 then return [ProtocolError $ loc "Bad number"]
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    32
            else
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    33
            return $
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    34
                ModifyClient (\c -> c{clientProto = parsedProto}) :
5030
42746c5d4a80 Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents: 4991
diff changeset
    35
                AnswerClients [sendChan cl] ["PROTO", showB parsedProto] :
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    36
                [CheckRegistered | not . B.null $ nick cl]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    37
    where
5090
2922455e606e Use readInt_
unc0rr
parents: 5030
diff changeset
    38
        parsedProto = readInt_ protoNum
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1834
diff changeset
    39
3536
7d99655130ff Partially reimplement joining rooms
unc0rr
parents: 3500
diff changeset
    40
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    41
handleCmd_NotEntered ["PASSWORD", passwd] = do
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    42
    (ci, irnc) <- ask
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    43
    let cl = irnc `client` ci
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1847
diff changeset
    44
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    45
    if passwd == webPassword cl then
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    46
        return $ JoinLobby : [AnswerClients [sendChan cl] ["ADMIN_ACCESS"] | isAdministrator cl]
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    47
        else
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    48
        return [ByeClient "Authentication failed"]
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1847
diff changeset
    49
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
8372
3c193ec03e09 Logon procedure for checkers, introduce invisible clients
unc0rr
parents: 8371
diff changeset
    51
#if defined(OFFICIAL_SERVER)
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    52
handleCmd_NotEntered ["CHECKER", protoNum, newNick, password] = do
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    53
    (ci, irnc) <- ask
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    54
    let cl = irnc `client` ci
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    55
8401
87410ae372f6 Server messages localization using Qt's l10n subsystem:
unc0rr
parents: 8372
diff changeset
    56
    if parsedProto == 0 then return [ProtocolError $ loc "Bad number"]
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    57
        else
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    58
        return $ [
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    59
            ModifyClient (\c -> c{clientProto = parsedProto, nick = newNick, webPassword = password, isChecker = True})
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    60
            , CheckRegistered]
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    61
    where
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    62
        parsedProto = readInt_ protoNum
8372
3c193ec03e09 Logon procedure for checkers, introduce invisible clients
unc0rr
parents: 8371
diff changeset
    63
#endif
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 5090
diff changeset
    64
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4242
diff changeset
    65
handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"]