What is the synchronization defect in this Haskell chat code, and what is the fix?
chat, concurrency, haskell, multithreading
Solution
You want to make sure that every successful `checkAddClient` is paired with a `removeClient`. The `finally` statement at the bottom only guarantees that `removeClient` is run if the `runClient` action begins.
However, there is a brief window in between the end of `checkAddClient` and the beginning of `runClient` where that code could receive an asynchronous exception. If it did, `finally` would not get a chance to register the `removeClient` command. This is the synchronization crack that Simon is referring to.
The solution is to mask asynchronous exceptions by default and only allow them to show up in certain places (i.e. the actions wrapped by `restore`). This seals up the aforementioned crack.
Problem
Simon Marlow gave a High performance concurrency talk at Haskell eXchange 2012. Due to time constraints, he skipped the section on a simple concurrent chat server. Curious about the elided content, a web search found similar slides on server applications and an implementation on GitHub. Slide 33 reads Back to talk… ``` talk :: Server -> Handle -> IO () talk server@Server{..} handle = do hSetNewlineMode handle universalNewlineMode hSetBuffering handle LineBuffering readName where readName = do hPutStrLn handle "What is your name?" name <- hGetLine handle m <- checkAddClient server name handle case m of Nothing -> do hPrintf handle "The name %s is in use" name readName Just client -> do runClient server client `finally` removeClient server name ``` Strictly speaking we should plug the hole between `checkAddClient` and `finally` (see the notes…) Earlier, slide 3 mentions “Chapter 14 in the notes,” which I assume refers to his upcoming book. What is the synchronization crack between `checkAddClient` and `finally`, and how do we plug it? The aforementioned implementation uses `mask` from Control.Exception. If this is the fix, what is a scenario in which an ill-timed exception spoils the party? ``` ... readName = do hPutStrLn handle "What is your name?" name <- hGetLine handle if null name then readName else mask $ \restore -> do ok <- checkAddClient server name handle case ok of Nothing -> restore $ do hPrintf handle "The name %s is in use, please choose another\n" name readName Just client -> restore (runClient server client) `finally` removeClient server name ```