Rethrow exceptions from forked threads in bye

See commit `c05ce0eb2c1adb3e29a5a95783f43fa8ed59162e` message. That was
motivated by the forked threads in `bye` printing their exceptions to stdout.
However, those changes may mask exceptions occuring in `bye` that we actually
care about. This commit fixes that by leaving exceptions in `bye` uncaught, and
simply rethrowing exceptions that occur in the forked threads of `bye` back to
the main thread. No messages printed to stdout, but potentially important
exceptions are still propagated.

Author: FinleyMcIlwaine

tls/Network/TLS/Core.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 module Network.TLS.Core (
@@ -98,7 +99,8 @@ getRTT ctx = do
 --
 -- this doesn't actually close the handle
 bye :: MonadIO m => Context -> m ()
-bye ctx = liftIO $ E.handle swallowSync $ do
+bye ctx = liftIO $ do
+    tid <- myThreadId
     eof <- ctxEOF ctx
     tls13 <- tls13orLater ctx
     when (tls13 && not eof) $ do
@@ -112,8 +114,10 @@ bye ctx = liftIO $ E.handle swallowSync $ do
                 unless recvNST $ do
                     rtt <- getRTT ctx
                     var <- newEmptyMVar
-                    _ <- forkIOWithUnmask $ \umask -> E.handle swallowSync $
-                        umask (void $ timeout rtt $ recvHS13 ctx chk) `E.finally` putMVar var ()
+                    _ <- forkIOWithUnmask $ \umask ->
+                        E.handle @E.SomeException (E.throwTo tid) $
+                          umask (void $ timeout rtt $ recvHS13 ctx chk)
+                            `E.finally` putMVar var ()
                     takeMVar var
             else do
                 -- receiving Client Finished
@@ -124,18 +128,12 @@ bye ctx = liftIO $ E.handle swallowSync $ do
                     -- fixme: 1sec is good enough?
                     let rtt = 1000000
                     var <- newEmptyMVar
-                    _ <- forkIOWithUnmask $ \umask -> E.handle swallowSync $
-                        umask (void $ timeout rtt $ recvHS13 ctx chk) `E.finally` putMVar var ()
+                    _ <- forkIOWithUnmask $ \umask ->
+                        E.handle @E.SomeException (E.throwTo tid) $
+                          umask (void $ timeout rtt $ recvHS13 ctx chk)
+                            `E.finally` putMVar var ()
                     takeMVar var
     bye_ ctx
-  where
-    -- Swallow synchronous exceptions, rethrow asynchronous exceptions
-    swallowSync :: E.SomeException -> IO ()
-    swallowSync e
-        | Just (E.SomeAsyncException ae) <- E.fromException e
-        = E.throwIO ae
-        | otherwise
-        = return ()
 
 bye_ :: MonadIO m => Context -> m ()
 bye_ ctx = liftIO $ do