handing or not handling async exceptions

tryAE.hs

{-# LANGUAGE NumericUnderscores #-}

import Control.Concurrent
import Control.Concurrent.Async as Async
import Control.Exception

import DNS.Types

fromIOException :: String -> IOError -> DNSError
fromIOException tag ioe = NetworkFailure (SomeException ioe) tag

tryDNS :: String -> IO a -> IO (Either DNSError a)
tryDNS ~tag action =
    try action >>= either left (return . Right)
  where
    left se
        | Just (e :: DNSError) <- fromException se = return $ Left   e
        | Just (e :: IOError)  <- fromException se = return $ Left $ fromIOException tag e
        | otherwise                                = return $ Left $ BadThing (show se)

tryDNS2 :: String -> IO a -> IO (Either DNSError a)
tryDNS2 ~tag action =
    try action >>= either left (return . Right)
  where
    left se
        | Just (e :: DNSError)       <- fromException se = return $ Left   e
        | Just (e :: IOError)        <- fromException se = return $ Left $ fromIOException tag e
        | Just (e :: AsyncException) <- fromException se = throwIO e
        | Just (e :: AsyncCancelled) <- fromException se = throwIO e
        | otherwise                                      = return $ Left $ BadThing (show se)

loop
  :: IO a
  -> (String -> IO a -> IO (Either DNSError a))
  -> Int -> IO (Either DNSError a)
loop step try' = loop'
  where
    step' = try' "test" step
    loop' n
        | n > 1      = step' >> loop' (n - 1)
        | otherwise  = step'

sleeps
  :: (String -> IO () -> IO (Either DNSError ()))
  -> IO (Either DNSError ())
sleeps try' = loop (threadDelay 2_000_000) try' 2

run
  :: String
  -> (IO () -> IO a) -> (a -> IO ()) -> (String -> IO () -> IO (Either DNSError ()))
  -> IO ()
run tag fork kill try' = do
  x <- fork (sleeps try' *> putStrLn (tag ++ ": thread done."))
  threadDelay 1_000_000
  kill x
  threadDelay 4_000_000
  putStrLn (tag ++ ": finished.")

run1K, run1C, run2K, run2C :: IO ()

run1K = run "run1K"  forkIO  killThread    tryDNS
run1C = run "run1C"  async   Async.cancel  tryDNS
run2K = run "run2K"  forkIO  killThread    tryDNS2
run2C = run "run2C"  async   Async.cancel  tryDNS2