hedgewars: gameServer/HWProtoLobbyState.hs@1f5604cd99be (annotated)

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	1	{-# LANGUAGE OverloadedStrings #-}
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	2	module HWProtoLobbyState where
4e78ad846fb6 New game server: unc0rr parents: diff changeset	3
4e78ad846fb6 New game server: unc0rr parents: diff changeset	4	import qualified Data.Map as Map
4e78ad846fb6 New game server: unc0rr parents: diff changeset	5	import qualified Data.IntSet as IntSet
1813 cfe1481e0247 Removeteam action unc0rr parents: 1811 diff changeset	6	import qualified Data.Foldable as Foldable
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	7	import Data.Maybe
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	8	import Data.List
3260 b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	9	import Data.Word
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 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	11	import qualified Data.ByteString.Char8 as B
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	12	--------------------------------------
4e78ad846fb6 New game server: unc0rr parents: diff changeset	13	import CoreTypes
4e78ad846fb6 New game server: unc0rr parents: diff changeset	14	import Actions
4e78ad846fb6 New game server: unc0rr parents: diff changeset	15	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	16	import HandlerUtils
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	17	import RoomsAndClients
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	18
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	19	{-answerAllTeams protocol teams = concatMap toAnswer teams
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	20	where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	21	toAnswer team =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	22	[AnswerThisClient $ teamToNet protocol team,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	23	AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	24	AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]]
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	-}
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	26	handleCmd_lobby :: CmdHandler
4e78ad846fb6 New game server: unc0rr parents: diff changeset	27
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	28
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	29	handleCmd_lobby ["LIST"] = 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	30	(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	31	let cl = irnc `client` ci
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	rooms <- allRoomInfos
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	let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
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	return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	35	where
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	roomInfo irnc room = [
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	showB $ gameinprogress room,
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	38	name room,
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	39	showB $ playersIn room,
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	40	showB $ length $ teams room,
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	nick $ irnc `client` masterID room,
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	42	head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	43	head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	44	head (Map.findWithDefault ["Default"] "AMMO" (params room))
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	45	]
3501 a3159a410e5c Reimplement more core actions unc0rr parents: 3500 diff changeset	46
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	47
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	handleCmd_lobby ["CHAT", msg] = 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	49	n <- clientNick
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	50	s <- roomOthersChans
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	51	return [AnswerClients s ["CHAT", n, msg]]
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	52
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	53	handleCmd_lobby ["CREATE_ROOM", newRoom, roomPassword]
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	54	\| illegalName newRoom = return [Warning "Illegal room name"]
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	55	\| otherwise = 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	56	rs <- allRoomInfos
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	57	cl <- thisClient
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	58	return $ if isJust $ find (\room -> newRoom == name room) rs 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	59	[Warning "Room exists"]
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	60	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	61	[
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	62	AddRoom newRoom roomPassword,
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	63	AnswerClients [sendChan cl] ["NOT_READY", 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	64	]
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
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	66
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	67	handleCmd_lobby ["CREATE_ROOM", newRoom] =
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	68	handleCmd_lobby ["CREATE_ROOM", newRoom, ""]
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	69
3536 7d99655130ff Partially reimplement joining rooms unc0rr parents: 3502 diff changeset	70
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	71	handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = 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	72	(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	73	let ris = allRooms irnc
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	74	cl <- thisClient
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	75	let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
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	76	let jRI = fromJust maybeRI
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	77	let jRoom = irnc `room` jRI
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	78	let jRoomClients = map (client irnc) $! roomClients irnc jRI -- no lazyness here!
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	79	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	80	if isNothing maybeRI 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	81	[Warning "No such rooms"]
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	82	else if isRestrictedJoins jRoom 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	83	[Warning "Joining restricted"]
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	84	else if roomPassword /= password jRoom 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	85	[Warning "Wrong password"]
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	86	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	87	[
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	88	MoveToRoom jRI,
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	89	AnswerClients (map sendChan $ cl : jRoomClients) ["NOT_READY", 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	90	]
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	91	++ [ AnswerClients [sendChan cl] $ "JOINED" : map nick jRoomClients \| playersIn jRoom /= 0]
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	92	++ (map (readynessMessage cl) jRoomClients)
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	93
3536 7d99655130ff Partially reimplement joining rooms unc0rr parents: 3502 diff changeset	94	where
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	95	readynessMessage cl c = AnswerClients [sendChan cl] [if isReady c then "READY" else "NOT_READY", nick c]
3536 7d99655130ff Partially reimplement joining rooms unc0rr parents: 3502 diff changeset	96
7d99655130ff Partially reimplement joining rooms unc0rr parents: 3502 diff changeset	97
7d99655130ff Partially reimplement joining rooms unc0rr parents: 3502 diff changeset	98
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	99	{-
1862 7f303aa066da Implement kick from server by administrator unc0rr parents: 1815 diff changeset	100
2352 7eaf82cf0890 Fixes suggested by hlint tool unc0rr parents: 2155 diff changeset	101	handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword]
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	102	\| noSuchRoom = [Warning "No such room"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	103	\| isRestrictedJoins jRoom = [Warning "Joining restricted"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	104	\| roomPassword /= password jRoom = [Warning "Wrong password"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	105	\| otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	106	[RoomRemoveThisClient "", -- leave lobby
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	107	RoomAddThisClient rID] -- join room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	108	++ answerNicks
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	109	++ answerReady
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	110	++ [AnswerThisRoom ["NOT_READY", nick client]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	111	++ answerFullConfig
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	112	++ answerTeams
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	113	++ watchRound
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	114	where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	115	answerNicks =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	116	[AnswerThisClient $ "JOINED" :
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	117	map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs \| playersIn jRoom /= 0]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	118	answerReady = map
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	119	((\ c ->
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	120	AnswerThisClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	121	[if isReady c then "READY" else "NOT_READY", nick c])
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	122	. (\ clID -> clients IntMap.! clID))
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	123	roomClientsIDs
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	124
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	125	toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
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	126
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	127	answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	128	(leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
1813 cfe1481e0247 Removeteam action unc0rr parents: 1811 diff changeset	129
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	130	watchRound = if not $ gameinprogress jRoom then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	131	[]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	132	else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	133	[AnswerThisClient ["RUN_GAME"],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	134	AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
1813 cfe1481e0247 Removeteam action unc0rr parents: 1811 diff changeset	135
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	136	answerTeams = if gameinprogress jRoom then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	137	answerAllTeams (clientProto client) (teamsAtStart jRoom)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	138	else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	139	answerAllTeams (clientProto client) (teams jRoom)
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	140	-}
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	141
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	142	handleCmd_lobby ["JOIN_ROOM", roomName] =
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	143	handleCmd_lobby ["JOIN_ROOM", roomName, ""]
3425 ead2ed20dfd4 Start the server refactoring unc0rr parents: 3283 diff changeset	144
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	145	{-
2961 3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	146	handleCmd_lobby clID clients rooms ["FOLLOW", asknick] =
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	147	if noSuchClient \|\| roomID followClient == 0 then
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	148	[]
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	149	else
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	150	handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName]
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	151	where
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	152	maybeClient = Foldable.find (\cl -> asknick == nick cl) clients
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	153	noSuchClient = isNothing maybeClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	154	followClient = fromJust maybeClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	155	roomName = name $ rooms IntMap.! roomID followClient
3e057dfa601f Fix "FOLLOW" command handler and place it into proper file unc0rr parents: 2867 diff changeset	156
1862 7f303aa066da Implement kick from server by administrator unc0rr parents: 1815 diff changeset	157
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	158	---------------------------
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	159	-- Administrator's stuff --
1862 7f303aa066da Implement kick from server by administrator unc0rr parents: 1815 diff changeset	160
7f303aa066da Implement kick from server by administrator unc0rr parents: 1815 diff changeset	161	handleCmd_lobby clID clients rooms ["KICK", kickNick] =
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	162	[KickClient kickID \| isAdministrator client && (not noSuchClient) && kickID /= clID]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	163	where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	164	client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	165	maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	166	noSuchClient = isNothing maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	167	kickID = clientUID $ fromJust maybeClient
1866 36aa0ca6e8af Cut the length of most used net packet unc0rr parents: 1862 diff changeset	168
36aa0ca6e8af Cut the length of most used net packet unc0rr parents: 1862 diff changeset	169
36aa0ca6e8af Cut the length of most used net packet unc0rr parents: 1862 diff changeset	170	handleCmd_lobby clID clients rooms ["BAN", banNick] =
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	171	if not $ isAdministrator client then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	172	[]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	173	else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	174	BanClient banNick : handleCmd_lobby clID clients rooms ["KICK", banNick]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	175	where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	176	client = clients IntMap.! clID
1862 7f303aa066da Implement kick from server by administrator unc0rr parents: 1815 diff changeset	177
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	178
3283 18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	179
18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	180	handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "MOTD_NEW", newMessage] =
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	181	[ModifyServerInfo (\si -> si{serverMessage = newMessage}) \| isAdministrator client]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	182	where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	183	client = clients IntMap.! clID
1925 ec923e56c444 Allow admin to set server's motd unc0rr parents: 1905 diff changeset	184
3283 18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	185	handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "MOTD_OLD", newMessage] =
3260 b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	186	[ModifyServerInfo (\si -> si{serverMessageForOldVersions = newMessage}) \| isAdministrator client]
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	187	where
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	188	client = clients IntMap.! clID
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	189
3283 18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	190	handleCmd_lobby clID clients rooms ["SET_SERVER_VAR", "LATEST_PROTO", protoNum] =
3260 b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	191	[ModifyServerInfo (\si -> si{latestReleaseVersion = fromJust readNum}) \| isAdministrator client && isJust readNum]
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	192	where
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	193	client = clients IntMap.! clID
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring) unc0rr parents: 2961 diff changeset	194	readNum = maybeRead protoNum :: Maybe Word16
1925 ec923e56c444 Allow admin to set server's motd unc0rr parents: 1905 diff changeset	195
3283 18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	196	handleCmd_lobby clID clients rooms ["GET_SERVER_VAR"] =
18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	197	[SendServerVars \| isAdministrator client]
18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	198	where
18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	199	client = clients IntMap.! clID
18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	200
18ee933a5864 Some stuff for game server administration task unc0rr parents: 3277 diff changeset	201
2155 d897222d3339 Implement ability for server admin to clear accounts cache unc0rr parents: 2150 diff changeset	202	handleCmd_lobby clID clients rooms ["CLEAR_ACCOUNTS_CACHE"] =
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	203	[ClearAccountsCache \| isAdministrator client]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	204	where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2408 diff changeset	205	client = clients IntMap.! clID
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	206	-}
2155 d897222d3339 Implement ability for server admin to clear accounts cache unc0rr parents: 2150 diff changeset	207
d897222d3339 Implement ability for server admin to clear accounts cache unc0rr parents: 2150 diff changeset	208
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	209	handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"]

author	nemo
	Fri, 12 Nov 2010 18:57:36 -0500
changeset 4295	1f5604cd99be
parent 4242	5e3c5fe2cb14
child 4337	85e02b1a8e8f
permissions	-rw-r--r--