56 |
56 |
57 processAction (AnswerClients chans msg) = |
57 processAction (AnswerClients chans msg) = |
58 liftIO $ mapM_ (flip writeChan msg) chans |
58 liftIO $ mapM_ (flip writeChan msg) chans |
59 |
59 |
60 |
60 |
61 {- |
61 processAction SendServerMessage = do |
62 processAction (clID, serverInfo, rnc) SendServerMessage = do |
62 chan <- client's sendChan |
63 writeChan (sendChan $ clients ! clID) ["SERVER_MESSAGE", message serverInfo] |
63 protonum <- client's clientProto |
64 return (clID, serverInfo, rnc) |
64 si <- liftM serverInfo get |
65 where |
65 let message = if protonum < latestReleaseVersion si then |
66 client = clients ! clID |
|
67 message si = if clientProto client < latestReleaseVersion si then |
|
68 serverMessageForOldVersions si |
66 serverMessageForOldVersions si |
69 else |
67 else |
70 serverMessage si |
68 serverMessage si |
|
69 liftIO $ writeChan chan ["SERVER_MESSAGE", message] |
|
70 {- |
71 |
71 |
72 processAction (clID, serverInfo, rnc) SendServerVars = do |
72 processAction (clID, serverInfo, rnc) SendServerVars = do |
73 writeChan (sendChan $ clients ! clID) ("SERVER_VARS" : vars) |
73 writeChan (sendChan $ clients ! clID) ("SERVER_VARS" : vars) |
74 return (clID, serverInfo, rnc) |
74 return (clID, serverInfo, rnc) |
75 where |
75 where |
79 "MOTD_OLD", serverMessageForOldVersions serverInfo, |
79 "MOTD_OLD", serverMessageForOldVersions serverInfo, |
80 "LATEST_PROTO", show $ latestReleaseVersion serverInfo |
80 "LATEST_PROTO", show $ latestReleaseVersion serverInfo |
81 ] |
81 ] |
82 |
82 |
83 |
83 |
84 processAction (clID, serverInfo, rnc) (ProtocolError msg) = do |
84 -} |
85 writeChan (sendChan $ clients ! clID) ["ERROR", msg] |
85 |
86 return (clID, serverInfo, rnc) |
86 processAction (ProtocolError msg) = do |
87 |
87 chan <- client's sendChan |
88 |
88 liftIO $ writeChan chan ["ERROR", msg] |
89 processAction (clID, serverInfo, rnc) (Warning msg) = do |
89 |
90 writeChan (sendChan $ clients ! clID) ["WARNING", msg] |
90 |
91 return (clID, serverInfo, rnc) |
91 processAction (Warning msg) = do |
92 -} |
92 chan <- client's sendChan |
|
93 liftIO $ writeChan chan ["WARNING", msg] |
93 |
94 |
94 processAction (ByeClient msg) = do |
95 processAction (ByeClient msg) = do |
95 (Just ci) <- gets clientIndex |
96 (Just ci) <- gets clientIndex |
96 rnc <- gets roomsClients |
97 rnc <- gets roomsClients |
97 ri <- clientRoomA |
98 ri <- clientRoomA |
98 when (ri /= lobbyId) $ do |
99 when (ri /= lobbyId) $ do |
99 processAction $ RoomRemoveThisClient ("quit: " `B.append` msg) |
100 processAction $ RoomRemoveThisClient ("quit: " `B.append` msg) |
100 return () |
101 return () |
101 |
102 |
102 chan <- clients sendChan |
103 chan <- client's sendChan |
103 |
104 |
104 liftIO $ do |
105 liftIO $ do |
105 infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) |
106 infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) |
106 |
107 |
107 |
108 |
312 |
313 |
313 |
314 |
314 processAction (clID, serverInfo, rnc) (Dump) = do |
315 processAction (clID, serverInfo, rnc) (Dump) = do |
315 writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms] |
316 writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms] |
316 return (clID, serverInfo, rnc) |
317 return (clID, serverInfo, rnc) |
317 |
318 -} |
318 |
319 |
319 processAction (clID, serverInfo, rnc) (ProcessAccountInfo info) = |
320 processAction (ProcessAccountInfo info) = |
320 case info of |
321 case info of |
321 HasAccount passwd isAdmin -> do |
322 HasAccount passwd isAdmin -> do |
322 infoM "Clients" $ show clID ++ " has account" |
323 chan <- client's sendChan |
323 writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"] |
324 liftIO $ writeChan chan ["ASKPASSWORD"] |
324 return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd, isAdministrator = isAdmin}) clID rnc) |
|
325 Guest -> do |
325 Guest -> do |
326 infoM "Clients" $ show clID ++ " is guest" |
326 mapM_ processAction [ModifyClient (\cl -> cl{logonPassed = True}), MoveToLobby] |
327 processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True}) clID rnc) MoveToLobby |
|
328 Admin -> do |
327 Admin -> do |
329 infoM "Clients" $ show clID ++ " is admin" |
328 mapM processAction [ModifyClient (\cl -> cl{logonPassed = True, isAdministrator = True}), MoveToLobby] |
330 foldM processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True, isAdministrator = True}) clID rnc) [MoveToLobby, AnswerThisClient ["ADMIN_ACCESS"]] |
329 chan <- client's sendChan |
331 |
330 liftIO $ writeChan chan ["ADMIN_ACCESS"] |
332 |
331 |
333 processAction (clID, serverInfo, rnc) (MoveToLobby) = |
332 processAction MoveToLobby = do |
334 foldM processAction (clID, serverInfo, rnc) $ |
333 chan <- client's sendChan |
335 (RoomAddThisClient 0) |
334 lobbyNicks <- liftM (Prelude.map nick . Prelude.filter logonPassed) allClientsS |
336 : answerLobbyNicks |
335 mapM_ processAction $ |
|
336 -- (RoomAddThisClient 0) |
|
337 [AnswerClients [chan] ("LOBBY:JOINED" : lobbyNicks) | not $ Prelude.null lobbyNicks] |
337 ++ [SendServerMessage] |
338 ++ [SendServerMessage] |
338 |
339 |
339 -- ++ (answerServerMessage client clients) |
340 {- |
340 where |
|
341 lobbyNicks = Prelude.map nick $ Prelude.filter logonPassed $ elems clients |
|
342 answerLobbyNicks = [AnswerThisClient ("LOBBY:JOINED": lobbyNicks) | not $ Prelude.null lobbyNicks] |
|
343 |
|
344 |
341 |
345 processAction (clID, serverInfo, rnc) (KickClient kickID) = |
342 processAction (clID, serverInfo, rnc) (KickClient kickID) = |
346 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked") |
343 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked") |
347 |
344 |
348 |
345 |