warp: rethrowing asynchronous exceptions if caught.

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

@@ -204,6 +204,7 @@ processRequest settings ii conn app th istatus src req mremainingRef idxhdr next
         Right ResponseReceived -> return ()
         Left (e :: SomeException)
             | Just (ExceptionInsideResponseBody e') <- fromException e -> throwIO e'
+            | isAsyncException e -> throwIO e
             | otherwise -> do
                 keepAlive <- sendErrorResponse settings ii conn th istatus req e
                 settingsOnException settings (Just req) e

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

@@ -152,7 +152,7 @@ wrappedRecvN th slowlorisSize readN bufsize = do
     return bs
   where
     handler :: E.SomeException -> IO ByteString
-    handler _ = return ""
+    handler = throughAsync (return "")
 
 -- connClose must not be called here since Run:fork calls it
 goaway :: Connection -> H2.ErrorCodeId -> ByteString -> IO ()

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

@@ -10,9 +10,12 @@ module Network.Wai.Handler.Warp.Imports (
     module Data.Word,
     module Data.Maybe,
     module Numeric,
+    throughAsync,
+    isAsyncException,
 ) where
 
 import Control.Applicative
+import Control.Exception
 import Control.Monad
 import Data.Bits
 import Data.ByteString.Internal (ByteString (..))
@@ -23,3 +26,14 @@ import Data.Monoid
 import Data.Ord
 import Data.Word
 import Numeric
+
+isAsyncException :: Exception e => e -> Bool
+isAsyncException e =
+    case fromException (toException e) of
+        Just (SomeAsyncException _) -> True
+        Nothing -> False
+
+throughAsync :: IO a -> SomeException -> IO a
+throughAsync action (SomeException e)
+    | isAsyncException e = throwIO e
+    | otherwise = action

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

@@ -81,7 +81,7 @@ socketConnection _ s = do
                             else settingsGracefulCloseTimeout1 set
                 if tm == 0
                     then close s
-                    else gracefulClose s tm `E.catch` \(E.SomeException _) -> return ()
+                    else gracefulClose s tm `E.catch` throughAsync (return ())
 #else
             , connClose = close s
 #endif
@@ -179,7 +179,7 @@ runSettingsSocket set@Settings{settingsAccept = accept'} socket app = do
         (s, sa) <- accept' socket
         setSocketCloseOnExec s
         -- NoDelay causes an error for AF_UNIX.
-        setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return ()
+        setSocketOption s NoDelay 1 `E.catch` throughAsync (return ())
         conn <- socketConnection set s
         return (conn, sa)