9 import Monad |
9 import Monad |
10 import Data.Time |
10 import Data.Time |
11 import Maybe |
11 import Maybe |
12 import Control.Monad.Reader |
12 import Control.Monad.Reader |
13 import Control.Monad.State |
13 import Control.Monad.State |
14 import Data.ByteString.Char8 as B |
14 import qualified Data.ByteString.Char8 as B |
15 ----------------------------- |
15 ----------------------------- |
16 import CoreTypes |
16 import CoreTypes |
17 import Utils |
17 import Utils |
18 import ClientIO |
18 import ClientIO |
19 import ServerState |
19 import ServerState |
20 |
20 |
21 data Action = |
21 data Action = |
22 AnswerClients [ClientChan] [ByteString] |
22 AnswerClients [ClientChan] [B.ByteString] |
23 | SendServerMessage |
23 | SendServerMessage |
24 | SendServerVars |
24 | SendServerVars |
25 | RoomAddThisClient RoomIndex -- roomID |
25 | MoveToRoom RoomIndex |
26 | RoomRemoveThisClient ByteString |
26 | RoomRemoveThisClient B.ByteString |
27 | RemoveTeam ByteString |
27 | RemoveTeam B.ByteString |
28 | RemoveRoom |
28 | RemoveRoom |
29 | UnreadyRoomClients |
29 | UnreadyRoomClients |
30 | MoveToLobby |
30 | JoinLobby |
31 | ProtocolError ByteString |
31 | ProtocolError B.ByteString |
32 | Warning ByteString |
32 | Warning B.ByteString |
33 | ByeClient ByteString |
33 | ByeClient B.ByteString |
34 | KickClient ClientIndex -- clID |
34 | KickClient ClientIndex |
35 | KickRoomClient ClientIndex -- clID |
35 | KickRoomClient ClientIndex |
36 | BanClient ByteString -- nick |
36 | BanClient B.ByteString -- nick |
37 | RemoveClientTeams ClientIndex -- clID |
37 | RemoveClientTeams ClientIndex |
38 | ModifyClient (ClientInfo -> ClientInfo) |
38 | ModifyClient (ClientInfo -> ClientInfo) |
39 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
39 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) |
40 | ModifyRoom (RoomInfo -> RoomInfo) |
40 | ModifyRoom (RoomInfo -> RoomInfo) |
41 | ModifyServerInfo (ServerInfo -> ServerInfo) |
41 | ModifyServerInfo (ServerInfo -> ServerInfo) |
42 | AddRoom ByteString ByteString |
42 | AddRoom B.ByteString B.ByteString |
43 | CheckRegistered |
43 | CheckRegistered |
44 | ClearAccountsCache |
44 | ClearAccountsCache |
45 | ProcessAccountInfo AccountInfo |
45 | ProcessAccountInfo AccountInfo |
46 | Dump |
46 | Dump |
47 | AddClient ClientInfo |
47 | AddClient ClientInfo |
48 | PingAll |
48 | PingAll |
49 | StatsAction |
49 | StatsAction |
50 |
50 |
51 type CmdHandler = [ByteString] -> Reader (ClientIndex, IRnC) [Action] |
51 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
52 |
52 |
53 |
53 |
54 processAction :: Action -> StateT ServerState IO () |
54 processAction :: Action -> StateT ServerState IO () |
55 |
55 |
56 |
56 |
152 {- |
152 {- |
153 |
153 |
154 processAction (clID, serverInfo, rnc) (ModifyServerInfo func) = |
154 processAction (clID, serverInfo, rnc) (ModifyServerInfo func) = |
155 return (clID, func serverInfo, rnc) |
155 return (clID, func serverInfo, rnc) |
156 |
156 |
157 |
157 -} |
158 processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) = |
158 |
159 processAction ( |
159 processAction (MoveToRoom rId) = do |
160 clID, |
160 (Just ci) <- gets clientIndex |
161 serverInfo, |
161 rnc <- gets roomsClients |
162 adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients, |
162 liftIO $ do |
163 adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $ |
163 modifyClient rnc (\cl -> cl{teamsInGame = 0}) ci |
164 adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r)}) 0 rooms |
164 modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) rId |
165 ) joinMsg |
165 |
166 where |
166 chans <- liftM (map sendChan) $ roomClientsS rId |
167 client = clients ! clID |
167 liftio movetoroom |
168 joinMsg = if rID == 0 then |
168 clNick <- client's nick |
169 AnswerAllOthers ["LOBBY:JOINED", nick client] |
169 |
170 else |
170 processAction $ AnswerClients chans ["JOINED", clNick] |
171 AnswerThisRoom ["JOINED", nick client] |
171 |
172 |
172 {- |
173 |
|
174 processAction (clID, serverInfo, rnc) (RoomRemoveThisClient msg) = do |
173 processAction (clID, serverInfo, rnc) (RoomRemoveThisClient msg) = do |
175 (_, _, newClients, newRooms) <- |
174 (_, _, newClients, newRooms) <- |
176 if roomID client /= 0 then |
175 if roomID client /= 0 then |
177 if isMaster client then |
176 if isMaster client then |
178 if (gameinprogress room) && (playersIn room > 1) then |
177 if (gameinprogress room) && (playersIn room > 1) then |
218 ) |
217 ) |
219 newRoomName = nick newMasterClient |
218 newRoomName = nick newMasterClient |
220 otherPlayersSet = IntSet.delete clID (playersIDs room) |
219 otherPlayersSet = IntSet.delete clID (playersIDs room) |
221 newMasterId = IntSet.findMin otherPlayersSet |
220 newMasterId = IntSet.findMin otherPlayersSet |
222 newMasterClient = clients ! newMasterId |
221 newMasterClient = clients ! newMasterId |
223 |
222 -} |
224 |
223 |
225 processAction (clID, serverInfo, rnc) (AddRoom roomName roomPassword) = do |
224 processAction (AddRoom roomName roomPassword) = do |
226 let newServerInfo = serverInfo {nextRoomID = newID} |
225 (ServerState (Just clId) _ rnc) <- get |
|
226 proto <- liftIO $ client'sM rnc clientProto clId |
|
227 |
227 let room = newRoom{ |
228 let room = newRoom{ |
228 roomUID = newID, |
229 masterID = clId, |
229 masterID = clID, |
|
230 name = roomName, |
230 name = roomName, |
231 password = roomPassword, |
231 password = roomPassword, |
232 roomProto = (clientProto client) |
232 roomProto = proto |
233 } |
233 } |
234 |
234 |
235 processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "ADD", roomName] |
235 rId <- liftIO $ addRoom rnc room |
236 |
236 |
237 processAction ( |
237 chans <- liftM (map sendChan) $ roomClientsS lobbyId |
238 clID, |
238 |
239 newServerInfo, |
239 mapM_ processAction [ |
240 adjust (\cl -> cl{isMaster = True}) clID clients, |
240 AnswerClients chans ["ROOM", "ADD", roomName] |
241 insert newID room rooms |
241 , ModifyClient (\cl -> cl{isMaster = True}) |
242 ) $ RoomAddThisClient newID |
242 , MoveToRoom rId] |
243 where |
243 |
244 newID = (nextRoomID serverInfo) - 1 |
244 {- |
245 client = clients ! clID |
|
246 |
|
247 |
|
248 processAction (clID, serverInfo, rnc) (RemoveRoom) = do |
245 processAction (clID, serverInfo, rnc) (RemoveRoom) = do |
249 processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "DEL", name room] |
246 processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "DEL", name room] |
250 processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["ROOMABANDONED", name room] |
247 processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["ROOMABANDONED", name room] |
251 return (clID, |
248 return (clID, |
252 serverInfo, |
249 serverInfo, |
321 case info of |
318 case info of |
322 HasAccount passwd isAdmin -> do |
319 HasAccount passwd isAdmin -> do |
323 chan <- client's sendChan |
320 chan <- client's sendChan |
324 liftIO $ writeChan chan ["ASKPASSWORD"] |
321 liftIO $ writeChan chan ["ASKPASSWORD"] |
325 Guest -> do |
322 Guest -> do |
326 mapM_ processAction [ModifyClient (\cl -> cl{logonPassed = True}), MoveToLobby] |
323 processAction JoinLobby |
327 Admin -> do |
324 Admin -> do |
328 mapM processAction [ModifyClient (\cl -> cl{logonPassed = True, isAdministrator = True}), MoveToLobby] |
325 mapM processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby] |
329 chan <- client's sendChan |
326 chan <- client's sendChan |
330 liftIO $ writeChan chan ["ADMIN_ACCESS"] |
327 liftIO $ writeChan chan ["ADMIN_ACCESS"] |
331 |
328 |
332 processAction MoveToLobby = do |
329 |
|
330 processAction JoinLobby = do |
333 chan <- client's sendChan |
331 chan <- client's sendChan |
334 lobbyNicks <- liftM (Prelude.map nick . Prelude.filter logonPassed) allClientsS |
332 clientNick <- client's nick |
|
333 (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) allClientsS |
335 mapM_ processAction $ |
334 mapM_ processAction $ |
336 -- (RoomAddThisClient 0) |
335 (AnswerClients clientsChans ["LOBBY:JOINED", clientNick]) |
337 [AnswerClients [chan] ("LOBBY:JOINED" : lobbyNicks) | not $ Prelude.null lobbyNicks] |
336 : [AnswerClients [chan] ("LOBBY:JOINED" : lobbyNicks) | not $ Prelude.null lobbyNicks] |
338 ++ [SendServerMessage] |
337 ++ [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage] |
339 |
338 |
340 {- |
339 {- |
|
340 processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) = |
|
341 processAction ( |
|
342 clID, |
|
343 serverInfo, |
|
344 adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients, |
|
345 adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $ |
|
346 adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r)}) 0 rooms |
|
347 ) joinMsg |
|
348 where |
|
349 client = clients ! clID |
|
350 joinMsg = if rID == 0 then |
|
351 AnswerAllOthers ["LOBBY:JOINED", nick client] |
|
352 else |
|
353 AnswerThisRoom ["JOINED", nick client] |
341 |
354 |
342 processAction (clID, serverInfo, rnc) (KickClient kickID) = |
355 processAction (clID, serverInfo, rnc) (KickClient kickID) = |
343 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked") |
356 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked") |
344 |
357 |
345 |
358 |