We finished up Chapter 12, discussing how to write a chat server. We were able to compile and run the code, opening up a server in one window, and several clients in other windows.
One thing that struck me as not quite satisfying was that clientKicked is a TVar rather than a message. Marlow says “we could send a message to its TChan, but because we are using STM, we might as well just watch the global state for changes as we did for the factor example in the previous section.” Uh, OK. But since we’re already using a TChan, why complicate things by adding another variable?
Another thing I found odd was that Marlow says on page 220 that in this particular situation we can’t use the bracket function, because our resource acquisition with checkAddClient is conditional. He then has to resort to the lower-level mask in order to mask asynchronous exceptions:
else mask $ \restore -> do -- <1>
ok <- checkAddClient server name handle
case ok of
Nothing -> restore $ do -- <2>
hPrintf handle
"The name %s is in use, please choose another\n" name
readName
Just client ->
restore (runClient server client) -- <3>
`finally` removeClient server name
I don’t think that the resource acquisition being conditional is a problem. We can write it using bracket - we just need to pattern match on the result of checkAddClient:
else bracket
(checkAddClient server name handle)
(\ok -> case ok of
Nothing -> return ()
Just _ -> removeClient server name
)
(\ok -> case ok of
Nothing -> do
hPrintf handle
"The name %s is in use, please choose another\n" name
readName
Just client -> runClient server client
)
I believe this will work correctly, and it runs fine at least in the normal use situation.
Another option would be to use
ResourceT, which allows you to allocate multiple resources within the scope of runResourceT, and guarantees that all of them will be freed if there is an exception. This works, but isn’t as much of a win as I had thought:
else runResourceT $ do
(_, ok) <- allocate (checkAddClient server name handle)
(\ok -> case ok of
Nothing -> return ()
Just _ -> liftIO $ removeClient server name
)
liftIO $ case ok of
Nothing -> do
hPrintf handle
"The name %s is in use, please choose another\n" name
readName
Just client -> runClient server client
The upside is that the lower section no longer needs to be parenthesized. The downside is that we have to throw in some liftIOs.
Unfortunately, we can’t push the resource cleanup into checkAddClient, because it runs in STM. We can’t run ResourceT inside STM, only wrap it around the call to atomically.
At the end of the chapter, Marlow suggests that we try to improve the performance of broadcast messages by using a broadcast channel. I tried this, and STM made it quite easy! If we were using MVars, we’d have to have another thread per client to listen to the broadcast channel, to send messages to the client’s own channel. But with STM, we can just use the magical orElse to listen to either!
First we need to extend the server datatype to contain a broadcast channel, to send messages on:
-- <<Server
data Server = Server
{ clients :: TVar (Map ClientName Client)
, broadcastChan :: TChan Message
}
newServer :: IO Server
newServer = do
c <- newTVarIO Map.empty
chan <- newTChanIO
return Server { clients = c, broadcastChan = chan }
-- >>
Then we need to extend the client datatype to contain its own copy of the broadcast channel, made using dupTChan:
data Client = Client
{ clientName :: ClientName
, clientHandle :: Handle
, clientKicked :: TVar (Maybe String)
, clientSendChan :: TChan Message
, clientBroadcastChan :: TChan Message
}
-- >>
-- <<newClient
newClient :: TChan Message -> ClientName -> Handle -> STM Client
newClient serverBroadcastChan name handle = do
c <- newTChan
k <- newTVar Nothing
bc <- dupTChan serverBroadcastChan
return Client { clientName = name
, clientHandle = handle
, clientSendChan = c
, clientKicked = k
, clientBroadcastChan = bc
}
-- >>
We can now simplify broadcast. No more looping over the client list:
broadcast :: Server -> Message -> STM ()
broadcast Server{..} msg = writeTChan broadcastChan msg
In runClient, we just change this one line:
msg <- readTChan clientSendChan `orElse` readTChan clientBroadcastChan
Now, if it finds no messages on its own channel, it will check the broadcast channel. The orElse does the merging for us.
This is one of those code changes that worked correctly as soon as I got it to compile. :)
See you next time!
- Lyle