--- 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)"]