8 import System.IO |
8 import System.IO |
9 import qualified Data.ByteString.UTF8 as BUTF8 |
9 import qualified Data.ByteString.UTF8 as BUTF8 |
10 import qualified Data.ByteString as B |
10 import qualified Data.ByteString as B |
11 ---------------- |
11 ---------------- |
12 import CoreTypes |
12 import CoreTypes |
|
13 import RoomsAndClients |
13 |
14 |
14 listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO () |
15 listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> ClientIndex -> IO () |
15 listenLoop handle linesNumber buf chan clientID = do |
16 listenLoop handle linesNumber buf chan clientID = do |
16 str <- liftM BUTF8.toString $ B.hGetLine handle |
17 str <- liftM BUTF8.toString $ B.hGetLine handle |
17 if (linesNumber > 50) || (length str > 450) then |
18 if (linesNumber > 50) || (length str > 450) then |
18 writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"]) |
19 writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"]) |
19 else |
20 else |
22 yield |
23 yield |
23 listenLoop handle 0 [] chan clientID |
24 listenLoop handle 0 [] chan clientID |
24 else |
25 else |
25 listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID |
26 listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID |
26 |
27 |
27 clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO () |
28 clientRecvLoop :: Handle -> Chan CoreMessage -> ClientIndex -> IO () |
28 clientRecvLoop handle chan clientID = |
29 clientRecvLoop handle chan clientID = |
29 listenLoop handle 0 [] chan clientID |
30 listenLoop handle 0 [] chan clientID |
30 `catch` (\e -> clientOff (show e) >> return ()) |
31 `catch` (\e -> clientOff (show e) >> return ()) |
31 where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message |
32 where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message |
32 |
33 |
33 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO() |
34 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> ClientIndex -> IO() |
34 clientSendLoop handle coreChan chan clientID = do |
35 clientSendLoop handle coreChan chan clientID = do |
35 answer <- readChan chan |
36 answer <- readChan chan |
36 doClose <- Exception.handle |
37 doClose <- Exception.handle |
37 (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do |
38 (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do |
38 B.hPutStrLn handle $ BUTF8.fromString $ unlines answer |
39 B.hPutStrLn handle $ BUTF8.fromString $ unlines answer |