joinAtomicallyWithMask, and a potential resource leak in http-client

[Leon Smith]

I'm going to propose four new functions to add to the STM library,  and
would be interested in getting some feedback for this idea.  The basic idea
is that we implement these two functions, along with their
WithUninterruptibleMask counterparts:

{-# LANGUAGE RankNTypes, ImpredicativeTypes #-}
import Control.Monad(join)
import Control.Concurrent.STM(STM, atomically)
import Control.Exception(mask, mask_)
joinAtomicallyWithMask :: STM ((forall a. (IO a -> IO a)) -> IO b) -> IO b
joinAtomicallyWithMask transaction =
  mask $ \unmask -> do
    join . atomically $ do
      ioCont <- transaction
      return $ do
        ioCont unmask

joinAtomicallyWithMask_ :: STM (IO b) -> IO b
joinAtomicallyWithMask_ = mask_ . join . atomically


However, the entire point of this endeavor is to implement these functions
better than this.  What we really want to do is to mask asynchronous
exceptions in conjunction with an STM commit:  a conservative
implementation would upgrade the masking state shortly before we know if
the transaction will commit or retry:  if it retries,  we restore the old
masking state;  if we commit, then we leave it alone.   A perhaps more
daring implementation would find a place immediately after commit before
async exceptions could possibly appear,  but this probably isn't necessary
if the approach turns out to be too difficult/problematic.

joinAtomicallyWithUninterruptibleMask actually allows us to express some
programs that we couldn't before: will complete the STM transaction in an
uninterruptible masking state,  but we don't have to worry about blocking
in the transaction because we won't have upgraded the masking state.

I actually noticed this pattern twice recently:  once in some code I was
writing,  and a second time within a week or two later,  I noticed this
would fix a potential resource leak in http-client,  namely:

https://github.com/snoyberg/http-client/blob/master/http-client/Data/KeyedPool.hs#L165

reap destroy var =
    loop
  where
    loop = do
        threadDelay (5 * 1000 * 1000)
        join $ atomically $ do
            m'' <- readTVar var
            case m'' of
                PoolClosed -> return (return ())
                PoolOpen idleCount m
                    | Map.null m -> retry
                    | otherwise -> do
                        (m', toDestroy) <- findStale idleCount m
                        writeTVar var m'
                        return $ do
                            mask_ (mapM_ (ignoreExceptions . destroy)
toDestroy)
                            loop


It looks like to me that we really want to ensure that we call "destroy" on
every resource taken out of the pool,  but it would appear that the mask_
is somewhat misplaced:  while perhaps it removes the most likely places
that an asynchronous exception could break that invariant,  it looks like
there's still a possibility that an asynchronous exception that happens
after the transaction commits but before the call to `mask_`.

And lastly,  I know I independently came up with the join . atomically
idiom,  but I know I'm not the first nor the last to do so.  It's an idiom
that does deserve to be more widely appreciated, and this could be a way to
do it.

Best,
Leon
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20191212/80292dbe/attachment.html>