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 |
14 import 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] [String] |
22 AnswerClients [ClientChan] [ByteString] |
23 | SendServerMessage |
23 | SendServerMessage |
24 | SendServerVars |
24 | SendServerVars |
25 | RoomAddThisClient RoomIndex -- roomID |
25 | RoomAddThisClient RoomIndex -- roomID |
26 | RoomRemoveThisClient String |
26 | RoomRemoveThisClient ByteString |
27 | RemoveTeam String |
27 | RemoveTeam ByteString |
28 | RemoveRoom |
28 | RemoveRoom |
29 | UnreadyRoomClients |
29 | UnreadyRoomClients |
30 | MoveToLobby |
30 | MoveToLobby |
31 | ProtocolError String |
31 | ProtocolError ByteString |
32 | Warning String |
32 | Warning ByteString |
33 | ByeClient String |
33 | ByeClient ByteString |
34 | KickClient ClientIndex -- clID |
34 | KickClient ClientIndex -- clID |
35 | KickRoomClient ClientIndex -- clID |
35 | KickRoomClient ClientIndex -- clID |
36 | BanClient String -- nick |
36 | BanClient ByteString -- nick |
37 | RemoveClientTeams ClientIndex -- clID |
37 | RemoveClientTeams ClientIndex -- clID |
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 String String |
42 | AddRoom ByteString 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 = [String] -> Reader (ClientIndex, IRnC) [Action] |
51 type CmdHandler = [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 |
94 processAction (ByeClient msg) = do |
94 processAction (ByeClient msg) = do |
95 (Just ci) <- gets clientIndex |
95 (Just ci) <- gets clientIndex |
96 rnc <- gets roomsClients |
96 rnc <- gets roomsClients |
97 ri <- clientRoomA |
97 ri <- clientRoomA |
98 when (ri /= lobbyId) $ do |
98 when (ri /= lobbyId) $ do |
99 processAction $ RoomRemoveThisClient ("quit: " ++ msg) |
99 processAction $ RoomRemoveThisClient ("quit: " `B.append` msg) |
100 return () |
100 return () |
101 |
101 |
102 chan <- clients sendChan |
102 chan <- clients sendChan |
103 |
103 |
104 liftIO $ do |
104 liftIO $ do |
105 infoM "Clients" (show ci ++ " quits: " ++ msg) |
105 infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) |
106 |
106 |
107 |
107 |
108 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom |
108 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom |
109 writeChan chan ["BYE", msg] |
109 writeChan chan ["BYE", msg] |
110 modifyRoom rnc (\r -> r{ |
110 modifyRoom rnc (\r -> r{ |
368 processAction (AddClient client) = do |
368 processAction (AddClient client) = do |
369 rnc <- gets roomsClients |
369 rnc <- gets roomsClients |
370 si <- gets serverInfo |
370 si <- gets serverInfo |
371 liftIO $ do |
371 liftIO $ do |
372 ci <- addClient rnc client |
372 ci <- addClient rnc client |
373 forkIO $ clientRecvLoop (clientHandle client) (coreChan si) ci |
373 forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci |
374 forkIO $ clientSendLoop (clientHandle client) (coreChan si) (sendChan client) ci |
374 forkIO $ clientSendLoop (clientSocket client) (coreChan si) (sendChan client) ci |
375 |
375 |
376 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client)) |
376 infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client)) |
377 writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
377 writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
378 |
378 |
379 {- let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo |
379 {- let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo |