<div dir="ltr">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:<br><br><blockquote style="margin:0 0 0 40px;border:none;padding:0px">{-# LANGUAGE RankNTypes, ImpredicativeTypes #-}<br> import Control.Monad(join)<br>import Control.Concurrent.STM(STM, atomically)<br>import Control.Exception(mask, mask_)<br>joinAtomicallyWithMask :: STM ((forall a. (IO a -> IO a)) -> IO b) -> IO b<br>joinAtomicallyWithMask transaction =<br>  mask $ \unmask -> do<br>    join . atomically $ do<br>      ioCont <- transaction<br>      return $ do<br>        ioCont unmask<br>     <br> joinAtomicallyWithMask_ :: STM (IO b) -> IO b<br>joinAtomicallyWithMask_ = mask_ . join . atomically</blockquote><br><div>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.<br><br>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.<br><br>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:<br><br><a href="https://github.com/snoyberg/http-client/blob/master/http-client/Data/KeyedPool.hs#L165">https://github.com/snoyberg/http-client/blob/master/http-client/Data/KeyedPool.hs#L165</a><br><br><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div>reap destroy var =<br>    loop<br>  where<br>    loop = do<br>        threadDelay (5 * 1000 * 1000)<br>        join $ atomically $ do<br>            m'' <- readTVar var<br>            case m'' of<br>                PoolClosed -> return (return ())<br>                PoolOpen idleCount m<br>                    | Map.null m -> retry<br>                    | otherwise -> do<br>                        (m', toDestroy) <- findStale idleCount m<br>                        writeTVar var m'<br>                        return $ do<br>                            mask_ (mapM_ (ignoreExceptions . destroy) toDestroy)<br>                            loop<br></div></blockquote><br></div><div>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_`.<br><br>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.</div><div><br></div><div>Best,</div><div>Leon</div></div>