Implement kick from server by administrator
authorunc0rr
Thu, 05 Mar 2009 19:53:40 +0000
changeset 1862 7f303aa066da
parent 1861 98de5dc5fda7
child 1863 705c01571196
Implement kick from server by administrator
gameServer/Actions.hs
gameServer/HWProtoCore.hs
gameServer/HWProtoLobbyState.hs
--- a/gameServer/Actions.hs	Thu Mar 05 14:54:02 2009 +0000
+++ b/gameServer/Actions.hs	Thu Mar 05 19:53:40 2009 +0000
@@ -27,6 +27,7 @@
 	| ProtocolError String
 	| Warning String
 	| ByeClient String
+	| KickClient Int -- clID
 	| ModifyClient (ClientInfo -> ClientInfo)
 	| ModifyRoom (RoomInfo -> RoomInfo)
 	| AddRoom String String
@@ -36,6 +37,7 @@
 
 type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action]
 
+replaceID a (b, c, d, e) = (a, c, d, e)
 
 processAction :: (Int, ServerInfo, Clients, Rooms) -> Action -> IO (Int, ServerInfo, Clients, Rooms)
 
@@ -281,3 +283,5 @@
 					[]
 
 
+processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = do
+	liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked")
\ No newline at end of file
--- a/gameServer/HWProtoCore.hs	Thu Mar 05 14:54:02 2009 +0000
+++ b/gameServer/HWProtoCore.hs	Thu Mar 05 19:53:40 2009 +0000
@@ -1,6 +1,8 @@
 module HWProtoCore where
 
 import qualified Data.IntMap as IntMap
+import Data.Foldable
+import Maybe
 --------------------------------------
 import CoreTypes
 import Actions
@@ -9,7 +11,7 @@
 import HWProtoLobbyState
 import HWProtoInRoomState
 
-handleCmd:: CmdHandler
+handleCmd, handleCmd_loggedin :: CmdHandler
 
 handleCmd clID _ _ ["PING"] = [AnswerThisClient ["PONG"]]
 
@@ -24,13 +26,38 @@
 		clientTeams = filter (\t -> teamowner t == nick client) $ teams room
 		removeClientTeams = map (RemoveTeam . teamname) clientTeams
 
+
 handleCmd clID clients rooms cmd =
 	if not $ logonPassed client then
 		handleCmd_NotEntered clID clients rooms cmd
-	else if roomID client == 0 then
+	else
+		handleCmd_loggedin clID clients rooms cmd
+	where
+		client = clients IntMap.! clID
+
+
+handleCmd_loggedin clID clients rooms ["INFO", asknick] =
+	if noSuchClient then
+		[]
+	else
+		[AnswerThisClient
+			["INFO",
+			nick client,
+			"[" ++ host client ++ "]",
+			protoNumber2ver $ clientProto client,
+			roomInfo]]
+	where
+		maybeClient = find (\cl -> asknick == nick cl) clients
+		noSuchClient = isNothing maybeClient
+		client = fromJust maybeClient
+		room = rooms IntMap.! roomID client
+		roomInfo = if roomID client /= 0 then "room " ++ (name room) else "lobby"
+
+
+handleCmd_loggedin clID clients rooms cmd =
+	if roomID client == 0 then
 		handleCmd_lobby clID clients rooms cmd
 	else
 		handleCmd_inRoom clID clients rooms cmd
 	where
 		client = clients IntMap.! clID
-
--- a/gameServer/HWProtoLobbyState.hs	Thu Mar 05 14:54:02 2009 +0000
+++ b/gameServer/HWProtoLobbyState.hs	Thu Mar 05 19:53:40 2009 +0000
@@ -34,11 +34,13 @@
 				show $ gameinprogress room
 				]
 
+
 handleCmd_lobby clID clients _ ["CHAT", msg] =
 	[AnswerOthersInRoom ["CHAT", clientNick, msg]]
 	where
 		clientNick = nick $ clients IntMap.! clID
 
+
 handleCmd_lobby clID clients rooms ["CREATE", newRoom, roomPassword] =
 	if haveSameRoom then
 		[Warning "Room exists"]
@@ -51,9 +53,11 @@
 		clientNick = nick $ clients IntMap.! clID
 		haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms
 
+
 handleCmd_lobby clID clients rooms ["CREATE", newRoom] =
 	handleCmd_lobby clID clients rooms ["CREATE", newRoom, ""]
 
+
 handleCmd_lobby clID clients rooms ["JOIN", roomName, roomPassword] =
 	if noSuchRoom then
 		[Warning "No such room"]
@@ -100,7 +104,28 @@
 				answerAllTeams (teams jRoom)
 
 
-handleCmd_lobby client clients rooms ["JOIN", roomName] =
-	handleCmd_lobby client clients rooms ["JOIN", roomName, ""]
+handleCmd_lobby clID clients rooms ["JOIN", roomName] =
+	handleCmd_lobby clID clients rooms ["JOIN", roomName, ""]
+
+
+handleCmd_lobby clID clients rooms ["KICK", kickNick] =
+	if not $ isAdministrator client then
+		[]
+	else
+		if noSuchClient then
+			[]
+		else
+			if kickID == clID then
+				[]
+			else
+				[KickClient kickID]
+	where
+		client = clients IntMap.! clID
+		maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
+		noSuchClient = isNothing maybeClient
+		kickID = clientUID $ fromJust maybeClient
+	--	room = rooms IntMap.! roomID client
+	--	roomInfo = if roomID client /= 0 then "room " ++ (name room) else "lobby"
+
 
 handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"]