26 messagesLoop messagesChan = forever $ do |
26 messagesLoop messagesChan = forever $ do |
27 threadDelay (30 * 10^6) -- 30 seconds |
27 threadDelay (30 * 10^6) -- 30 seconds |
28 atomically $ writeTChan messagesChan ["PING"] |
28 atomically $ writeTChan messagesChan ["PING"] |
29 |
29 |
30 acceptLoop :: Socket -> TChan ClientInfo -> IO () |
30 acceptLoop :: Socket -> TChan ClientInfo -> IO () |
31 acceptLoop servSock acceptChan = do |
31 acceptLoop servSock acceptChan = Control.Exception.handle (const $ putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ do |
32 (cHandle, host, port) <- accept servSock |
32 (cHandle, host, port) <- accept servSock |
33 hPutStrLn cHandle "CONNECTED\n" |
|
34 hFlush cHandle |
|
35 cChan <- atomically newTChan |
33 cChan <- atomically newTChan |
36 forkIO $ clientLoop cHandle cChan |
34 forkIO $ clientLoop cHandle cChan |
37 atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False False False) |
35 atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False False False) |
|
36 atomically $ writeTChan cChan ["ASKME"] |
38 acceptLoop servSock acceptChan |
37 acceptLoop servSock acceptChan |
39 |
38 |
40 |
39 |
41 listenLoop :: Handle -> [String] -> TChan [String] -> IO () |
40 listenLoop :: Handle -> [String] -> TChan [String] -> IO () |
42 listenLoop handle buf chan = do |
41 listenLoop handle buf chan = do |