using isAsyncException around fromException

warp/Network/Wai/Handler/Warp/HTTP1.hs

@@ -122,6 +122,7 @@ http1server settings ii conn transport app addr th istatus src =
         | Just NoKeepAliveRequest <- fromException e = return ()
         -- No valid request
         | Just (BadFirstLine _) <- fromException e = return ()
+        | isAsyncException e = throwIO e
         | otherwise = do
             _ <-
                 sendErrorResponse

warp/Network/Wai/Handler/Warp/HTTP2.hs

@@ -110,6 +110,7 @@ http2server label settings ii transport addr app h2req0 aux0 response = do
           | Just E.ThreadKilled  <- E.fromException e -> return ()
           -- killed by the local timeout manager
           | Just T.TimeoutThread <- E.fromException e -> return ()
+          | isAsyncException e -> E.throwIO e
           | otherwise -> do
             S.settingsOnException settings (Just req) e
             let ersp = S.settingsOnExceptionResponse settings e

warp/Network/Wai/Handler/Warp/Settings.hs

@@ -9,15 +9,15 @@
 
 module Network.Wai.Handler.Warp.Settings where
 
-import Control.Exception (SomeException, fromException)
+import Control.Exception (SomeException(..), fromException, throw)
 import qualified Data.ByteString.Builder as Builder
 import qualified Data.ByteString.Char8 as C8
 import Data.Streaming.Network (HostPreference)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
 import Data.Version (showVersion)
 import GHC.IO (IO (IO), unsafeUnmask)
-import GHC.IO.Exception (AsyncException (ThreadKilled), IOErrorType (..))
+import GHC.IO.Exception (IOErrorType (..))
 import GHC.Prim (fork#)
 import qualified Network.HTTP.Types as H
 import Network.Socket (SockAddr, Socket, accept)
@@ -228,12 +228,11 @@ defaultSettings =
 -- Since 2.1.3
 defaultShouldDisplayException :: SomeException -> Bool
 defaultShouldDisplayException se
-    | Just ThreadKilled <- fromException se = False
     | Just (_ :: InvalidRequest) <- fromException se = False
     | Just (ioeGetErrorType -> et) <- fromException se
     , et == ResourceVanished || et == InvalidArgument =
         False
-    | Just TimeoutThread <- fromException se = False
+    | isAsyncException se = False
     | otherwise = True
 
 -- | Printing an exception to standard error
@@ -255,6 +254,7 @@ defaultOnException _ e =
 -- Since 3.2.27
 defaultOnExceptionResponse :: SomeException -> Response
 defaultOnExceptionResponse e
+    | isAsyncException e = throw e
     | Just PayloadTooLarge <- fromException e =
         responseLBS
             H.status413