gameServer/HWProtoCore.hs
author unc0rr
Thu, 05 Mar 2009 19:53:40 +0000
changeset 1862 7f303aa066da
parent 1841 fba7210b438b
child 1879 bb114339eb4e
permissions -rw-r--r--
Implement kick from server by administrator
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module HWProtoCore where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
import qualified Data.IntMap as IntMap
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
     4
import Data.Foldable
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
     5
import Maybe
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import HWProtoNEState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import HWProtoLobbyState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import HWProtoInRoomState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    14
handleCmd, handleCmd_loggedin :: CmdHandler
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
handleCmd clID _ _ ["PING"] = [AnswerThisClient ["PONG"]]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
1814
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    18
handleCmd clID clients rooms ("QUIT" : xs) =
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    19
	(if isMaster client then [RemoveRoom] else removeClientTeams)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
	++ [ByeClient msg]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
		client = clients IntMap.! clID
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
		clientNick = nick client
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
		msg = if not $ null xs then head xs else ""
1814
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    25
		room = rooms IntMap.! (roomID client)
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    26
		clientTeams = filter (\t -> teamowner t == nick client) $ teams room
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1811
diff changeset
    27
		removeClientTeams = map (RemoveTeam . teamname) clientTeams
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    29
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
handleCmd clID clients rooms cmd =
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1814
diff changeset
    31
	if not $ logonPassed client then
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
		handleCmd_NotEntered clID clients rooms cmd
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    33
	else
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    34
		handleCmd_loggedin clID clients rooms cmd
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    35
	where
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    36
		client = clients IntMap.! clID
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    37
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    38
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    39
handleCmd_loggedin clID clients rooms ["INFO", asknick] =
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    40
	if noSuchClient then
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    41
		[]
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    42
	else
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    43
		[AnswerThisClient
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    44
			["INFO",
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    45
			nick client,
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    46
			"[" ++ host client ++ "]",
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    47
			protoNumber2ver $ clientProto client,
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    48
			roomInfo]]
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    49
	where
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    50
		maybeClient = find (\cl -> asknick == nick cl) clients
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    51
		noSuchClient = isNothing maybeClient
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    52
		client = fromJust maybeClient
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    53
		room = rooms IntMap.! roomID client
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    54
		roomInfo = if roomID client /= 0 then "room " ++ (name room) else "lobby"
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    55
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    56
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    57
handleCmd_loggedin clID clients rooms cmd =
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    58
	if roomID client == 0 then
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    59
		handleCmd_lobby clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
	else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    61
		handleCmd_inRoom clID clients rooms cmd
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    62
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    63
		client = clients IntMap.! clID