50 |
50 |
51 clientRecvLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () |
51 clientRecvLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () |
52 clientRecvLoop s chan ci = do |
52 clientRecvLoop s chan ci = do |
53 msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show) |
53 msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show) |
54 clientOff msg |
54 clientOff msg |
55 where |
55 where |
56 clientOff msg = mapM_ (writeChan chan) [ClientMessage (ci, ["QUIT", msg]), Remove ci] |
56 clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg]) |
57 |
57 |
58 |
58 |
59 |
59 |
60 clientSendLoop :: Socket -> ThreadId -> Chan [B.ByteString] -> ClientIndex -> IO () |
60 clientSendLoop :: Socket -> ThreadId -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO () |
61 clientSendLoop s tId chan ci = do |
61 clientSendLoop s tId coreChan chan ci = do |
62 answer <- readChan chan |
62 answer <- readChan chan |
63 Exception.handle |
63 Exception.handle |
64 (\(e :: Exception.IOException) -> when (not $ isQuit answer) $ sendQuit e) $ do |
64 (\(e :: Exception.IOException) -> when (not $ isQuit answer) $ sendQuit e) $ do |
65 sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n') |
65 sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n') |
66 |
66 |
67 if (isQuit answer) then |
67 if (isQuit answer) then |
68 do |
68 do |
|
69 Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s |
69 killThread tId |
70 killThread tId |
70 Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s |
71 writeChan coreChan $ Remove ci |
71 else |
72 else |
72 clientSendLoop s tId chan ci |
73 clientSendLoop s tId coreChan chan ci |
73 |
74 |
74 where |
75 where |
75 --sendQuit e = writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e]) |
76 --sendQuit e = writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e]) |
76 sendQuit e = putStrLn $ show e |
77 sendQuit e = putStrLn $ show e |
77 isQuit ("BYE":xs) = True |
78 isQuit ("BYE":xs) = True |