writeChan is not 100% exception-safe

[joeyadams]

Control.Concurrent.Chan.writeChan is currently implemented like this:

writeChan :: Chan a -> a -> IO ()
writeChan (Chan _ writeVar) val = do
  new_hole <- newEmptyMVar
  modifyMVar_ writeVar $ \old_hole -> do
    putMVar old_hole (ChItem val new_hole)
    return new_hole

The problem is that modifyMVar_ restores the exception mask when it calls the callback. If an asynchronous exception is delivered immediately after the putMVar, the Chan's write end will be set to a filled hole, violating a key invariant.

I think it should be implemented like this:

writeChan :: Chan a -> a -> IO ()
writeChan (Chan _ writeVar) val = do
  new_hole <- newEmptyMVar
  mask_ $ do
    old_hole <- takeMVar writeVar           -- (1)
    putMVar old_hole (ChItem val new_hole)  -- (2)
    putMVar writeVar new_hole               -- (3)

This looks a bit naïve, but it should be atomic, at least in theory:

• (1) is interruptible. However, if it is interrupted, the MVar will remain intact.

• (2) is not interruptible, because old_hole is guaranteed to be empty. No other thread can fill it because we have taken exclusive access to writeVar.

• (3) is not interruptible, because we have taken exclusive access to writeVar.

This implementation has the added benefit of removing an exception handler, which should make it slightly faster.

readChan is okay, though:

readChan :: Chan a -> IO a
readChan (Chan readVar _) = do
  modifyMVar readVar $ \read_end -> do
    (ChItem val new_read_end) <- readMVar read_end
    return (new_read_end, val)

If an exception is received immediately after the readMVar, then the read cursor will not be advanced, and the next call to readChan will simply read from that position again. Unfortunately, we can't get rid of the exception handler like we did with writeChan, because readMVar read_end is interruptible.

The attached patch changes the implementation of writeChan to the one shown above, and adds a comment to the definition of Chan about the write end's empty-hole invariant. I believe all of the Chan operations preserve this invariant, even the deprecated unGetChan and isEmptyChan.

I have not been able to create a test case where writeChan is interrupted between filling the hole and updating the write cursor. Perhaps it doesn't actually happen in practice, or perhaps it is extremely rare. But by my understanding of the semantics:

mask $ \restore -> do
    thing1
    restore $ putMVar ...
    thing2

It is possible for an exception to arrive after the putMVar and before thing2.

[simonmar]

Good catch, I think you're right. It's possible the race condition doesn't actually exist in practice, only in theory, but it doesn't hurt to fix it and the fix is a performance improvement.

[simonmar]

pushed as 48df85c45e50d18a1e34f2db82a58e74dea6bbef. Thanks!

[pcapriotti]

Merged as b24a3598764592ae341f3e90d7223ae04bce931b.