withAsync can leak threads in MaybeT/ExceptT monads

[Shimuuar]

Reproducer:

module Q where

import Control.Concurrent
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Control.Concurrent.Async.Lifted

dumb :: IO ()
dumb = forever $ do threadDelay 100000
                    putStrLn "still alive"
  
go :: MaybeT IO ()
go = withAsync (liftIO dumb) $ \_ ->
  liftIO (threadDelay 10000) >> mzero

instead of killing async after go is finished thread is left running. Reason for that is simple: withAsyncUsing uses monadic bind from m which could abort early without ever reaching stop

[maoe]

Thanks for reporting the issue with the nice repro.

I guess we need to change withAsyncUsing like this:

 withAsyncUsing fork action inner = E.mask $ \restore -> do
   a <- fork $ restore action
-  r <- restore (inner a) `E.catch` \e -> do
-    cancel a
-    E.throwIO (e :: SomeException)
-  cancel a
-  return r
+  restore (inner a)
+    `E.finally` cancel a
+    `E.catch` \e -> do
+      cancel a
+      E.throwIO (e :: SomeException)

I'm going to test this hopefully in the weekend. It seems that this function in the async package has changed quite a bit since last time I checked so I need to check that too.

[maoe]

The catch is no longer needed with the change, I guess. I'll check this too.

[Shimuuar]

Another option would be to drop into IO and use withAsync from async. It's not very simple and I think for good reason

[maoe]

Sorry I was a bit busy these days. I pushed a fix in #35.

Do you have a fix with your suggestion? If so could you make a PR so we can compare it with #35?

[Shimuuar]

No worries I'm not in hurry. Actually I found bug doing code review when considering lifted-async as dependency and in the end decided against it. Async turned out to be wrong abstaction. Then I reported bug anyway

[maoe]

Released as https://hackage.haskell.org/package/lifted-async-0.10.2. Thanks!