Simple chat server in Haskell

Question

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.

Using a 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?

Answer 1

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.

Naturally. This is because "send" and "receive" for a chat server behave asynchronously, and block on different events. Haskell's threads are lightweight, so you can write your code using blocking calls and multiple threads, and rest assured that behind the scenes Haskell is using epoll.

You could modify the chat server so that the client is required to give a special command in order to read new messages, in that case only one thread would be needed, since all messages from you to the client would depend directly on that particular client's input. But then it wouldn't feel much like a chat program.

[Haskell] so hard to reason about, especially when exceptions come into the picture.

Exceptions are best avoided in Haskell, but you seem to have been able to reason about them fairly well. Did you have any specific issues reasoning about your code? I think it might be fair to replace [Haskell] with [Concurrent programming]; exceptions and concurrency are inherently at odds, in any language.

Is this a good approach? Is there a better way to organize network code like this?

I think it's pretty good. I don't do much networking code so take my opinion with a grain of salt.

Clearly this is just some simple example code, but you might want to consider allowing the client to send a special message to stop interacting with the server, so that disconnecting is not entirely dependent on exceptions.