unexpected program termination

[zoranbosnjak]

I need to restart periodic http polling on every configuration change. In reality, the configuration changes come from GUI actions (via STM). For the purpose of this test, I am simulating the changes.

The following minimal example does not behave as expected. The program is suppose to run forever, but instead it terminates after a few seconds. It looks like the problem is related to canceling runReq.

I am not sure if the problem is with async or req or I am maybe misusing something.

$ runhaskell -Wall test.hs
2020-06-30 08:26:43.969039315 UTC
2020-06-30 08:26:44.973565897 UTC
2020-06-30 08:26:45.971567632 UTC
2020-06-30 08:26:46.972884804 UTC
test.hs: AsyncCancelled

Where test.hs is:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import           Control.Monad
import           Control.Concurrent (threadDelay)
import           Control.Concurrent.STM
import           Control.Concurrent.Async
import           Control.Exception
import           Data.Time
import           Data.Text
import           Data.Bool
import           Network.HTTP.Req

sleep :: IO ()
sleep = threadDelay $ round $ 1000*1000 * seconds where
    seconds = 1.0 :: Double

-- | Restart IO action on STM value change.
-- This function terminates only when the IO action itself terminates.
restartOnChange :: Eq t => STM t -> (t -> IO b) -> IO b
restartOnChange getVar act = atomically getVar >>= go where
    go x = do
        result <- race (act x) $ atomically $ do
            y <- getVar
            bool (return y) retry (y == x)
        case result of
            Left a -> return a
            Right y -> go y

-- | This action is not suppose to terminate on it's own.
runRequest :: Text -> IO ()
runRequest host = forever $ do
    getCurrentTime >>= print
    sleep
    result <- try $ runReq defaultHttpConfig $ do
        void $ req GET (http host) NoReqBody bsResponse mempty
    case result of
        Left (_e :: HttpException) -> return ()
        Right _ -> return ()

main :: IO ()
main = do

    -- configuration variable
    hostVar <- newTVarIO "someHost"

    -- simulate configuration changes
    void $ async $ forever $ do
        sleep
        atomically $ writeTVar hostVar "host1"
        sleep
        atomically $ writeTVar hostVar "host2"

    -- Restart polling on every config change.
    restartOnChange (readTVar hostVar) runRequest

[zoranbosnjak]

A problem is the same on req-3.4.0.

@simonmar
I am not sure where the problem is, but it looks like it's related to async. A function reqBr is doing some magic with AsyncExceptions (which I don't understand):
https://hackage.haskell.org/package/req-3.4.0/docs/src/Network.HTTP.Req.html#reqBr
But nevertheless, how is it possible for AsyncCancelled (which is generated by the race function) to escape to the main function?
Can you please tell what is going on?
Is there a way to workaround the problem within the example program?

[mrkkrp]

As I told you elsewhere, I do not have enough free time these days to debug user's programs. On the surface though, it looks like something async-related.