netserver/HWProto.hs
author unc0rr
Mon, 29 Sep 2008 22:14:23 +0000
changeset 1301 c6fe8a4bfd34
parent 1083 3448dd03483f
child 1302 4290ba4a14ca
permissions -rw-r--r--
Fix a bug screwing team selection up in network game (REMOVETEAM message doesn't have teamID, and after removing the team QMap still contains old info, when add and remove team with the same name, total hedgehogs number will be decreased by first team hh number)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
890
1d8c4a5ec622 - Improve server core
unc0rr
parents:
diff changeset
     1
module HWProto where
1d8c4a5ec622 - Improve server core
unc0rr
parents:
diff changeset
     2
1d8c4a5ec622 - Improve server core
unc0rr
parents:
diff changeset
     3
import IO
896
93df8ac94382 Handle password parameter on JOIN
unc0rr
parents: 895
diff changeset
     4
import Data.List
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
     5
import Data.Word
890
1d8c4a5ec622 - Improve server core
unc0rr
parents:
diff changeset
     6
import Miscutils
896
93df8ac94382 Handle password parameter on JOIN
unc0rr
parents: 895
diff changeset
     7
import Maybe (fromMaybe, fromJust)
890
1d8c4a5ec622 - Improve server core
unc0rr
parents:
diff changeset
     8
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
     9
-- Main state-independent cmd handler
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    10
handleCmd :: CmdHandler
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    11
handleCmd client _ rooms ("QUIT":xs) =
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    12
	if null (room client) then
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    13
		(noChangeClients, noChangeRooms, clientOnly, ["QUIT"])
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    14
	else if isMaster client then
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    15
		(noChangeClients, removeRoom (room client), sameRoom, ["ROOMABANDONED"]) -- core disconnects clients on ROOMABANDONED command
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    16
	else
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    17
		(noChangeClients, noChangeRooms, sameRoom, ["QUIT", nick client])
895
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    18
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    19
-- check state and call state-dependent commmand handlers
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    20
handleCmd client clients rooms cmd =
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    21
	if null (nick client) || protocol client == 0 then
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    22
		handleCmd_noInfo client clients rooms cmd
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    23
	else if null (room client) then
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    24
		handleCmd_noRoom client clients rooms cmd
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    25
	else
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    26
		handleCmd_inRoom client clients rooms cmd
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    27
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    28
-- 'no info' state - need to get protocol number and nickname
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    29
handleCmd_noInfo :: CmdHandler
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    30
handleCmd_noInfo client clients _ ["NICK", newNick] =
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    31
	if not . null $ nick client then
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    32
		(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "The nick already chosen"])
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    33
	else if haveSameNick then
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    34
		(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "Choose another nick"])
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    35
	else
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    36
		(modifyClient client{nick = newNick}, noChangeRooms, clientOnly, ["NICK", newNick])
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    37
	where
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    38
		haveSameNick = not . null $ filter (\cl -> newNick == nick cl) clients
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    39
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    40
handleCmd_noInfo client _ _ ["PROTO", protoNum] =
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    41
	if protocol client > 0 then
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    42
		(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "Protocol number already known"])
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    43
	else if parsedProto == 0 then
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    44
		(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "Bad input"])
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    45
	else
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    46
		(modifyClient client{protocol = parsedProto}, noChangeRooms, clientOnly, ["PROTO", show parsedProto])
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    47
	where
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    48
		parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    49
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    50
handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    51
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    52
-- 'noRoom' clients state command handlers
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    53
handleCmd_noRoom :: CmdHandler
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    54
handleCmd_noRoom client _ rooms ["LIST"] =
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    55
		(noChangeClients, noChangeRooms, clientOnly, ["ROOMS"] ++ map name rooms)
903
d4e5d8cbe449 Implement LIST command
unc0rr
parents: 902
diff changeset
    56
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    57
handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] =
895
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    58
	if haveSameRoom then
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    59
		(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "There's already a room with that name"])
895
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    60
	else
1083
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    61
		(modifyClient client{room = newRoom, isMaster = True}, addRoom (RoomInfo newRoom roomPassword []), clientOnly, ["JOINED", nick client])
895
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    62
	where
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    63
		haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    64
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    65
handleCmd_noRoom client clients rooms ["CREATE", newRoom] =
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    66
	handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    67
	
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    68
handleCmd_noRoom client _ rooms ["JOIN", roomName, roomPassword] =
902
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    69
	if noSuchRoom then
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    70
		(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "There's no room with that name"])
902
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    71
	else if roomPassword /= password (roomByName roomName rooms) then
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    72
		(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "Wrong password"])
895
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    73
	else
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    74
		(modifyClient client{room = roomName}, noChangeRooms, fromRoom roomName, ["JOINED", nick client])
895
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    75
	where
902
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    76
		noSuchRoom = null $ filter (\room -> roomName == name room) rooms
895
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    77
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    78
handleCmd_noRoom client clients rooms ["JOIN", roomName] =
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    79
	handleCmd_noRoom client clients rooms ["JOIN", roomName, ""]
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 893
diff changeset
    80
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    81
handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)
895
6aee2f335726 - Remove old hwserv code
unc0rr
parents: 894
diff changeset
    82
897
35d91fa3753b 'In room' state stub
unc0rr
parents: 896
diff changeset
    83
-- 'inRoom' clients state command handlers
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    84
handleCmd_inRoom :: CmdHandler
897
35d91fa3753b 'In room' state stub
unc0rr
parents: 896
diff changeset
    85
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    86
handleCmd_inRoom client _ _ ["CHAT_STRING", _, msg] = (noChangeClients, noChangeRooms, othersInRoom, ["CHAT_STRING", nick client, msg])
893
149244d86bf1 - Some improvements in core
unc0rr
parents: 892
diff changeset
    87
1083
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    88
handleCmd_inRoom client clients rooms ["CONFIG_PARAM", paramName, value] =
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    89
	(noChangeClients, noChangeRooms, othersInRoom, ["CONFIG_PARAM", paramName, value])
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    90
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    91
handleCmd_inRoom client clients rooms ["CONFIG_PARAM", paramName, value1, value2] =
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    92
	(noChangeClients, noChangeRooms, othersInRoom, ["CONFIG_PARAM", paramName, value1, value2])
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    93
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    94
handleCmd_inRoom client clients rooms ["ADDTEAM:", teamName, teamColor, graveName, fortName, teamLevel, hh0, hh1, hh2, hh3, hh4, hh5, hh6, hh7] =
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    95
	(noChangeClients, noChangeRooms, othersInRoom, ["TEAM_ACCEPTED", "1", teamName])
893
149244d86bf1 - Some improvements in core
unc0rr
parents: 892
diff changeset
    96
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 903
diff changeset
    97
handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)