I've been struggling with concurrent programming in Haskell for a while. It's so hard to reason about, especially when exceptions come into the picture.
As a learning exercise, I implemented a simple chat server. Clients connect using telnet on port 1337, and start typing text. Each message is broadcast to all connected clients. Clients are distinguished by an incrementing counter.
Requires the stm-linkedlist package
import Control.Concurrent import Control.Concurrent.STM import Control.Exception as E hiding (handle) import Control.Monad import Network import Data.STM.LinkedList (LinkedList) import System.IO import qualified Data.STM.LinkedList as LL type Client = TChan String main :: IO () main = do clients <- LL.emptyIO sock <- listenOn (PortNumber 1337) let loop n = do (handle, host, port) <- accept sock putStrLn $ "Accepted connection from " ++ host ++ ":" ++ show port _ <- forkIO $ serve clients handle n loop $! n+1 in loop 0 serve :: LinkedList Client -> Handle -> Integer -> IO () serve clients handle n = do hSetBuffering handle LineBuffering send_chan <- newTChanIO receiver <- myThreadId let sendLoop = forever $ atomically (readTChan send_chan) >>= hPutStrLn handle receiveLoop = forever $ do line <- hGetLine handle broadcast $ "<client " ++ show n ++ ">: " ++ line broadcast message = atomically $ LL.toList clients >>= mapM_ (flip writeTChan message) start = do node <- atomically $ LL.append send_chan clients sender <- forkIO $ sendLoop `onException` killThread receiver return $ do atomically $ LL.delete node killThread sender in bracket start (\finish -> finish) (\_ -> receiveLoop)
One hurdle is that I can't send and receive simultaneously in the same thread. Thus, I'm forced to send and receive in separate threads.
In the code below, I spawn two threads per client:
A "receive" thread, which gets lines from the client and broadcasts them.
A "send" thread, which reads this client's TChan (written to by "receive" threads) and sends each message to the client.
TChan, rather than having other threads write directly to this thread's
Handle, has two benefits:
If sending produces an exception, it doesn't kill the innocent sending client's thread. It only kills the "send" thread of the target client.
It keeps message text from getting interleaved.
When the "receive" thread hits an exception, its finalizer removes the client's send channel from the linked list and kills the "send" thread. When the "send" thread hits an exception, it kills the "receive" thread, causing its finalizer to be invoked.
Is this a good approach? Is there a better way to organize network code like this?