46 | PingAll |
47 | PingAll |
47 | StatsAction |
48 | StatsAction |
48 |
49 |
49 type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action] |
50 type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action] |
50 |
51 |
|
52 data ActionsState = ActionsState { |
|
53 clientIndex :: Maybe ClientIndex, |
|
54 serverInfo :: ServerInfo, |
|
55 roomsClients :: MRnC |
|
56 } |
|
57 |
|
58 clientRoomA :: StateT ActionsState IO RoomIndex |
|
59 clientRoomA = do |
|
60 (Just ci) <- gets clientIndex |
|
61 rnc <- gets roomsClients |
|
62 liftIO $ clientRoomM rnc ci |
|
63 |
51 replaceID a (b, c, d, e) = (a, c, d, e) |
64 replaceID a (b, c, d, e) = (a, c, d, e) |
52 |
65 |
53 processAction :: (ClientIndex, ServerInfo, MRnC) -> Action -> IO (ClientIndex, ServerInfo) |
66 processAction :: Action -> StateT ActionsState IO () |
54 |
67 |
55 |
68 |
56 processAction (ci, serverInfo, rnc) (AnswerClients chans msg) = do |
69 processAction (AnswerClients chans msg) = |
57 mapM_ (flip writeChan msg) chans |
70 liftIO $ mapM_ (flip writeChan msg) chans |
58 return (ci, serverInfo) |
|
59 |
71 |
60 |
72 |
61 {- |
73 {- |
62 processAction (clID, serverInfo, rnc) SendServerMessage = do |
74 processAction (clID, serverInfo, rnc) SendServerMessage = do |
63 writeChan (sendChan $ clients ! clID) ["SERVER_MESSAGE", message serverInfo] |
75 writeChan (sendChan $ clients ! clID) ["SERVER_MESSAGE", message serverInfo] |
89 processAction (clID, serverInfo, rnc) (Warning msg) = do |
101 processAction (clID, serverInfo, rnc) (Warning msg) = do |
90 writeChan (sendChan $ clients ! clID) ["WARNING", msg] |
102 writeChan (sendChan $ clients ! clID) ["WARNING", msg] |
91 return (clID, serverInfo, rnc) |
103 return (clID, serverInfo, rnc) |
92 -} |
104 -} |
93 |
105 |
94 processAction (ci, serverInfo, rnc) (ByeClient msg) = do |
106 processAction (ByeClient msg) = do |
95 infoM "Clients" (show ci ++ " quits: " ++ msg) |
107 (Just ci) <- gets clientIndex |
96 |
108 rnc <- gets roomsClients |
97 ri <- clientRoomM rnc ci |
109 ri <- clientRoomA |
98 when (ri /= lobbyId) $ do |
110 when (ri /= lobbyId) $ do |
99 processAction (ci, serverInfo, rnc) $ RoomRemoveThisClient ("quit: " ++ msg) |
111 processAction $ RoomRemoveThisClient ("quit: " ++ msg) |
100 return () |
112 return () |
101 |
113 |
102 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom |
114 liftIO $ do |
103 --writeChan (sendChan $ clients ! clID) ["BYE", msg] |
115 infoM "Clients" (show ci ++ " quits: " ++ msg) |
104 modifyRoom rnc (\r -> r{ |
116 |
105 --playersIDs = IntSet.delete ci (playersIDs r) |
117 ri <- clientRoomM rnc ci |
106 playersIn = (playersIn r) - 1 |
118 |
107 --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r |
119 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom |
108 }) ri |
120 --writeChan (sendChan $ clients ! clID) ["BYE", msg] |
109 removeClient rnc ci |
121 modifyRoom rnc (\r -> r{ |
110 |
122 --playersIDs = IntSet.delete ci (playersIDs r) |
111 return (ci, serverInfo) |
123 playersIn = (playersIn r) - 1 |
|
124 --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r |
|
125 }) ri |
|
126 removeClient rnc ci |
|
127 |
112 |
128 |
113 {- |
129 {- |
114 where |
130 where |
115 client = clients ! clID |
131 client = clients ! clID |
116 clientNick = nick client |
132 clientNick = nick client |
358 room = rooms ! (roomID client) |
374 room = rooms ! (roomID client) |
359 teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room |
375 teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room |
360 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
376 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
361 -} |
377 -} |
362 |
378 |
363 processAction (_, serverInfo, rnc) (AddClient client) = do |
379 processAction (AddClient client) = do |
364 ci <- addClient rnc client |
380 rnc <- gets roomsClients |
365 forkIO $ clientRecvLoop (clientHandle client) (coreChan serverInfo) ci |
381 si <- gets serverInfo |
366 forkIO $ clientSendLoop (clientHandle client) (coreChan serverInfo) (sendChan client) ci |
382 liftIO $ do |
367 |
383 ci <- addClient rnc client |
368 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client)) |
384 forkIO $ clientRecvLoop (clientHandle client) (coreChan si) ci |
369 writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
385 forkIO $ clientSendLoop (clientHandle client) (coreChan si) (sendChan client) ci |
370 |
386 |
371 let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo |
387 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client)) |
372 |
388 writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
373 if False && (isJust $ host client `Prelude.lookup` newLogins) then |
389 |
374 processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast" |
390 {- let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo |
375 else |
391 |
376 return (ci, serverInfo) |
392 if False && (isJust $ host client `Prelude.lookup` newLogins) then |
|
393 processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast" |
|
394 else |
|
395 return (ci, serverInfo) |
|
396 -} |
|
397 |
|
398 |
|
399 |
377 |
400 |
378 {- |
401 {- |
379 processAction (clID, serverInfo, rnc) PingAll = do |
402 processAction (clID, serverInfo, rnc) PingAll = do |
380 (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, rnc) $ elems clients |
403 (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, rnc) $ elems clients |
381 processAction (clID, |
404 processAction (clID, |