gameServer/Actions.hs
changeset 1921 2a09f7f786a0
parent 1879 bb114339eb4e
child 1923 956b6b3529bc
equal deleted inserted replaced
1920:302835d554d8 1921:2a09f7f786a0
    27 	| ProtocolError String
    27 	| ProtocolError String
    28 	| Warning String
    28 	| Warning String
    29 	| ByeClient String
    29 	| ByeClient String
    30 	| KickClient Int -- clID
    30 	| KickClient Int -- clID
    31 	| KickRoomClient Int -- clID
    31 	| KickRoomClient Int -- clID
       
    32 	| BanClient String -- nick
    32 	| RemoveClientTeams Int -- clID
    33 	| RemoveClientTeams Int -- clID
    33 	| BanClient String -- nick
       
    34 	| ModifyClient (ClientInfo -> ClientInfo)
    34 	| ModifyClient (ClientInfo -> ClientInfo)
    35 	| ModifyRoom (RoomInfo -> RoomInfo)
    35 	| ModifyRoom (RoomInfo -> RoomInfo)
    36 	| AddRoom String String
    36 	| AddRoom String String
    37 	| CheckRegistered
    37 	| CheckRegistered
    38 	| ProcessAccountInfo AccountInfo
    38 	| ProcessAccountInfo AccountInfo
   250 		client = clients ! clID
   250 		client = clients ! clID
   251 		rmTeamMsg = toEngineMsg $ 'F' : teamName
   251 		rmTeamMsg = toEngineMsg $ 'F' : teamName
   252 
   252 
   253 
   253 
   254 processAction (clID, serverInfo, clients, rooms) (CheckRegistered) = do
   254 processAction (clID, serverInfo, clients, rooms) (CheckRegistered) = do
   255 	writeChan (dbQueries serverInfo) $ CheckAccount clID (nick client)
   255 	writeChan (dbQueries serverInfo) $ CheckAccount client
   256 	return (clID, serverInfo, clients, rooms)
   256 	return (clID, serverInfo, clients, rooms)
   257 	where
   257 	where
   258 		client = clients ! clID
   258 		client = clients ! clID
   259 
   259 
   260 
   260 
   270 			writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"]
   270 			writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"]
   271 			return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd, isAdministrator = isAdmin}) clID clients, rooms)
   271 			return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd, isAdministrator = isAdmin}) clID clients, rooms)
   272 		Guest -> do
   272 		Guest -> do
   273 			infoM "Clients" $ show clID ++ " is guest"
   273 			infoM "Clients" $ show clID ++ " is guest"
   274 			processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True}) clID clients, rooms) MoveToLobby
   274 			processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True}) clID clients, rooms) MoveToLobby
       
   275 		Admin -> do
       
   276 			infoM "Clients" $ show clID ++ " is admin"
       
   277 			foldM processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True, isAdministrator = True}) clID clients, rooms) [MoveToLobby, AnswerThisClient ["ADMIN_ACCESS"]]
   275 
   278 
   276 
   279 
   277 processAction (clID, serverInfo, clients, rooms) (MoveToLobby) = do
   280 processAction (clID, serverInfo, clients, rooms) (MoveToLobby) = do
   278 	foldM processAction (clID, serverInfo, clients, rooms) $
   281 	foldM processAction (clID, serverInfo, clients, rooms) $
   279 		(RoomAddThisClient 0)
   282 		(RoomAddThisClient 0)
   288 
   291 
   289 
   292 
   290 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = do
   293 processAction (clID, serverInfo, clients, rooms) (KickClient kickID) = do
   291 	liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked")
   294 	liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ ByeClient "Kicked")
   292 
   295 
       
   296 processAction (clID, serverInfo, clients, rooms) (BanClient banNick) = do
       
   297 	return (clID, serverInfo, clients, rooms)
       
   298 
   293 
   299 
   294 processAction (clID, serverInfo, clients, rooms) (KickRoomClient kickID) = do
   300 processAction (clID, serverInfo, clients, rooms) (KickRoomClient kickID) = do
   295 	writeChan (sendChan $ clients ! kickID) ["KICKED"]
   301 	writeChan (sendChan $ clients ! kickID) ["KICKED"]
   296 	liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ RoomRemoveThisClient)
   302 	liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ RoomRemoveThisClient)
   297 
   303