diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,100 @@
 # ChangeLog for warp
 
+## 3.4.14
+
+* Important bugfix to not deadlock on empty file descriptors if the cause of
+  the file descriptor exhaustion is outside of the server's control.
+  (i.e. the server does not have any running connections and can't use a file
+  descriptor to create the next connection)
+  [#1084](https://github.com/yesodweb/wai/pull/1084)
+
+## 3.4.13.1
+
+* Bugfix to fall back to "blocking `recv`" when on Windows systems and when
+  using `network < 3.2.2`.
+  [#1077](https://github.com/yesodweb/wai/pull/1077)
+
+## 3.4.13
+
+* Change graceful shutdown logic to stop accepting data from idle connections,
+  but to wait for busy `Application`s, adding `Connection: close` headers to
+  responses if the server is shutting down.
+  This should make sure the server doesn't wait for idle keep-alive connections.
+* Expose a broader way to access internal state like the open connection `Counter`
+  and whether the server is currently `ShuttingDown` or not.
+  Users can use `makeSettingsAndServerState` to get a `ServerState` while
+  making `defaultSettings`.
+  [#1071](https://github.com/yesodweb/wai/pull/1071)
+
+## 3.4.12
+
+* Respond with `Connection: close` header if connection is to be closed after a request.
+  [#958](https://github.com/yesodweb/wai/pull/958)
+
+## 3.4.11
+
+* Expose a way to access the open connection `Counter` with `makeSettingsAndCounter`,
+  and `getCount` to be able to monitor the current open connections.
+* Added getter function to get the open connection counter from the `Settings` with
+  `getOpenConnectionCounter`.
+  [#1050](https://github.com/yesodweb/wai/pull/1050)
+
+## 3.4.10
+
+* Using newest dependencies
+
+## 3.4.9
+
+* New flag `include-warp-version` can be disabled to remove dependency on `Paths_warp`.
+  [#1044](https://github.com/yesodweb/wai/pull/1044)
+
+## 3.4.8
+
+* Label the internal hack thread on Windows used to make socket
+  listening interruptible.
+
+## 3.4.7
+
+* Using time-manager >= 0.2.
+
+## 3.4.6
+
+* Using `withHandle` of time-manager.
+
+## 3.4.5
+
+* Rethrowing asynchronous exceptions and preventing callsing
+  `connClose` twice.
+  [#1013](https://github.com/yesodweb/wai/pull/1013)
+
+## 3.4.4
+
+* Removing `unliftio`.
+
+## 3.4.3
+
+* Waiting untill the number of FDs desreases on EMFILE.
+  [#1009](https://github.com/yesodweb/wai/pull/1009)
+
+## 3.4.2
+
+* serveConnection is re-exported from the Internal module.
+  [#1007](https://github.com/yesodweb/wai/pull/1007)
+
+## 3.4.1
+
+* Using time-manager v0.1.0, and auto-update v0.2.0.
+  [#986](https://github.com/yesodweb/wai/pull/986)
+
+## 3.4.0
+
+* Reworked request lines (`CRLF`) parsing: [#968](https://github.com/yesodweb/wai/pulls)
+    * We do not accept multiline headers anymore.
+      ([`RFC 7230`](https://www.rfc-editor.org/rfc/rfc7230#section-3.2.4) deprecated it 10 years ago)
+    * Reworked request lines (`CRLF`) parsing to not unnecessarily copy bytestrings.
+* Using http2 v5.1.0.
+* `fourmolu` is used as an official formatter.
+
 ## 3.3.31
 
 * Supporting http2 v5.0.
diff --git a/Network/Wai/Handler/Warp.hs b/Network/Wai/Handler/Warp.hs
--- a/Network/Wai/Handler/Warp.hs
+++ b/Network/Wai/Handler/Warp.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RankNTypes #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
 ---------------------------------------------------------
@@ -34,118 +34,157 @@
 -- * call the 'pauseTimeout' function
 --
 -- For more information, see <https://github.com/yesodweb/wai/issues/351>.
---
---
 module Network.Wai.Handler.Warp (
     -- * Run a Warp server
+
     -- | All of these automatically serve the same 'Application' over HTTP\/1,
     -- HTTP\/1.1, and HTTP\/2.
-    run
-  , runEnv
-  , runSettings
-  , runSettingsSocket
+    run,
+    runEnv,
+    runSettings,
+    runSettingsSocket,
+
     -- * Settings
-  , Settings
-  , defaultSettings
+    Settings,
+    defaultSettings,
+
     -- ** Setters
-  , setPort
-  , setHost
-  , setOnException
-  , setOnExceptionResponse
-  , setOnOpen
-  , setOnClose
-  , setTimeout
-  , setManager
-  , setFdCacheDuration
-  , setFileInfoCacheDuration
-  , setBeforeMainLoop
-  , setNoParsePath
-  , setInstallShutdownHandler
-  , setServerName
-  , setMaximumBodyFlush
-  , setFork
-  , setAccept
-  , setProxyProtocolNone
-  , setProxyProtocolRequired
-  , setProxyProtocolOptional
-  , setSlowlorisSize
-  , setHTTP2Disabled
-  , setLogger
-  , setServerPushLogger
-  , setGracefulShutdownTimeout
-  , setGracefulCloseTimeout1
-  , setGracefulCloseTimeout2
-  , setMaxTotalHeaderLength
-  , setAltSvc
-  , setMaxBuilderResponseBufferSize
+    setPort,
+    setHost,
+    setOnException,
+    setOnExceptionResponse,
+    setOnOpen,
+    setOnClose,
+    setTimeout,
+    setManager,
+    setFdCacheDuration,
+    setFileInfoCacheDuration,
+    setBeforeMainLoop,
+    setNoParsePath,
+    setInstallShutdownHandler,
+    setServerName,
+    setMaximumBodyFlush,
+    setFork,
+    setAccept,
+    setProxyProtocolNone,
+    setProxyProtocolRequired,
+    setProxyProtocolOptional,
+    setSlowlorisSize,
+    setHTTP2Disabled,
+    setLogger,
+    setServerPushLogger,
+    setGracefulShutdownTimeout,
+    setGracefulCloseTimeout1,
+    setGracefulCloseTimeout2,
+    setMaxTotalHeaderLength,
+    setAltSvc,
+    setMaxBuilderResponseBufferSize,
+
     -- ** Getters
-  , getPort
-  , getHost
-  , getOnOpen
-  , getOnClose
-  , getOnException
-  , getGracefulShutdownTimeout
-  , getGracefulCloseTimeout1
-  , getGracefulCloseTimeout2
+    getPort,
+    getHost,
+    getOnOpen,
+    getOnClose,
+    getOnException,
+    getGracefulShutdownTimeout,
+    getGracefulCloseTimeout1,
+    getGracefulCloseTimeout2,
+    getOpenConnectionCounter,
+    getServerState,
+
+    -- ** Internal server state
+    --
+    -- Creating 'Settings' with insight into the internal state of the server.
+    --
+    -- When using 'makeSettingsAndServerState', you will receive the 'ServerState'
+    -- that will be used by @warp@ so that you can query things like the
+    -- 'currentOpenConnections', and 'currentShuttingDownState'.
+    ServerState,
+    makeSettingsAndServerState,
+    currentOpenConnections,
+    currentShuttingDownState,
+
+    -- *** STM versions
+    currentOpenConnectionsSTM,
+    currentShuttingDownStateSTM,
+
+    -- ** Connection counter
+    --
+    -- /Deprecated in favor of 'ServerState'/
+    makeSettingsAndCounter,
+    Counter,
+    getCount,
+
     -- ** Exception handler
-  , defaultOnException
-  , defaultShouldDisplayException
+    defaultOnException,
+    defaultShouldDisplayException,
+
     -- ** Exception response handler
-  , defaultOnExceptionResponse
-  , exceptionResponseForDebug
+    defaultOnExceptionResponse,
+    exceptionResponseForDebug,
+
     -- * Data types
-  , HostPreference
-  , Port
-  , InvalidRequest (..)
+    HostPreference,
+    Port,
+    InvalidRequest (..),
+
     -- * Utilities
-  , pauseTimeout
-  , FileInfo(..)
-  , getFileInfo
+    pauseTimeout,
+    FileInfo (..),
+    getFileInfo,
 #ifdef MIN_VERSION_crypton_x509
-  , clientCertificate
+    clientCertificate,
 #endif
-  , withApplication
-  , withApplicationSettings
-  , testWithApplication
-  , testWithApplicationSettings
-  , openFreePort
+    withApplication,
+    withApplicationSettings,
+    testWithApplication,
+    testWithApplicationSettings,
+    openFreePort,
+
     -- * Version
-  , warpVersion
+    warpVersion,
+
     -- * HTTP/2
+
     -- ** HTTP2 data
-  , HTTP2Data
-  , http2dataPushPromise
-  , http2dataTrailers
-  , defaultHTTP2Data
-  , getHTTP2Data
-  , setHTTP2Data
-  , modifyHTTP2Data
+    HTTP2Data,
+    http2dataPushPromise,
+    http2dataTrailers,
+    defaultHTTP2Data,
+    getHTTP2Data,
+    setHTTP2Data,
+    modifyHTTP2Data,
+
     -- ** Push promise
-  , PushPromise
-  , promisedPath
-  , promisedFile
-  , promisedResponseHeaders
-  , promisedWeight
-  , defaultPushPromise
-  ) where
+    PushPromise,
+    promisedPath,
+    promisedFile,
+    promisedResponseHeaders,
+    promisedWeight,
+    defaultPushPromise,
+) where
 
-import UnliftIO.Exception (SomeException, throwIO)
 import Data.Streaming.Network (HostPreference)
 import qualified Data.Vault.Lazy as Vault
+import Control.Exception (SomeException, throwIO)
 #ifdef MIN_VERSION_crypton_x509
 import Data.X509
 #endif
 import qualified Network.HTTP.Types as H
-import Network.Socket (Socket, SockAddr)
+import Network.Socket (SockAddr, Socket)
 import Network.Wai (Request, Response, vault)
 import System.TimeManager
 
+import Network.Wai.Handler.Warp.Counter (Counter, getCount)
 import Network.Wai.Handler.Warp.FileInfoCache
-import Network.Wai.Handler.Warp.HTTP2.Request (getHTTP2Data, setHTTP2Data, modifyHTTP2Data)
+import Network.Wai.Handler.Warp.HTTP2.Request (
+    getHTTP2Data,
+    modifyHTTP2Data,
+    setHTTP2Data,
+ )
 import Network.Wai.Handler.Warp.HTTP2.Types
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.Request
-import Network.Wai.Handler.Warp.Response (warpVersion)
 import Network.Wai.Handler.Warp.Run
 import Network.Wai.Handler.Warp.Settings
 import Network.Wai.Handler.Warp.Types hiding (getFileInfo)
@@ -155,20 +194,21 @@
 --
 -- Since 2.1.0
 setPort :: Port -> Settings -> Settings
-setPort x y = y { settingsPort = x }
+setPort x y = y{settingsPort = x}
 
 -- | Interface to bind to. Default value: HostIPv4
 --
 -- Since 2.1.0
 setHost :: HostPreference -> Settings -> Settings
-setHost x y = y { settingsHost = x }
+setHost x y = y{settingsHost = x}
 
 -- | What to do with exceptions thrown by either the application or server.
 -- Default: 'defaultOnException'
 --
 -- Since 2.1.0
-setOnException :: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
-setOnException x y = y { settingsOnException = x }
+setOnException
+    :: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
+setOnException x y = y{settingsOnException = x}
 
 -- | A function to create a `Response` when an exception occurs.
 -- Default: 'defaultOnExceptionResponse'
@@ -185,7 +225,7 @@
 --
 -- Since 2.1.0
 setOnExceptionResponse :: (SomeException -> Response) -> Settings -> Settings
-setOnExceptionResponse x y = y { settingsOnExceptionResponse = x }
+setOnExceptionResponse x y = y{settingsOnExceptionResponse = x}
 
 -- | What to do when a connection is opened. When 'False' is returned, the
 -- connection is closed immediately. Otherwise, the connection is going on.
@@ -193,13 +233,13 @@
 --
 -- Since 2.1.0
 setOnOpen :: (SockAddr -> IO Bool) -> Settings -> Settings
-setOnOpen x y = y { settingsOnOpen = x }
+setOnOpen x y = y{settingsOnOpen = x}
 
 -- | What to do when a connection is closed. Default: do nothing.
 --
 -- Since 2.1.0
 setOnClose :: (SockAddr -> IO ()) -> Settings -> Settings
-setOnClose x y = y { settingsOnClose = x }
+setOnClose x y = y{settingsOnClose = x}
 
 -- | "Slow-loris" timeout lower-bound value in seconds.  Connections where
 -- network progress is made less frequently than this may be closed.  In
@@ -211,14 +251,14 @@
 --
 -- Since 2.1.0
 setTimeout :: Int -> Settings -> Settings
-setTimeout x y = y { settingsTimeout = x }
+setTimeout x y = y{settingsTimeout = x}
 
 -- | Use an existing timeout manager instead of spawning a new one. If used,
 -- 'settingsTimeout' is ignored.
 --
 -- Since 2.1.0
 setManager :: Manager -> Settings -> Settings
-setManager x y = y { settingsManager = Just x }
+setManager x y = y{settingsManager = Just x}
 
 -- | Cache duration time of file descriptors in seconds. 0 means that the cache mechanism is not used.
 --
@@ -234,7 +274,7 @@
 --
 -- Since 3.0.13
 setFdCacheDuration :: Int -> Settings -> Settings
-setFdCacheDuration x y = y { settingsFdCacheDuration = x }
+setFdCacheDuration x y = y{settingsFdCacheDuration = x}
 
 -- | Cache duration time of file information in seconds. 0 means that the cache mechanism is not used.
 --
@@ -248,7 +288,7 @@
 --
 -- Default value: 0
 setFileInfoCacheDuration :: Int -> Settings -> Settings
-setFileInfoCacheDuration x y = y { settingsFileInfoCacheDuration = x }
+setFileInfoCacheDuration x y = y{settingsFileInfoCacheDuration = x}
 
 -- | Code to run after the listening socket is ready but before entering
 -- the main event loop. Useful for signaling to tests that they can start
@@ -258,7 +298,7 @@
 --
 -- Since 2.1.0
 setBeforeMainLoop :: IO () -> Settings -> Settings
-setBeforeMainLoop x y = y { settingsBeforeMainLoop = x }
+setBeforeMainLoop x y = y{settingsBeforeMainLoop = x}
 
 -- | Perform no parsing on the rawPathInfo.
 --
@@ -268,7 +308,7 @@
 --
 -- Since 2.1.0
 setNoParsePath :: Bool -> Settings -> Settings
-setNoParsePath x y = y { settingsNoParsePath = x }
+setNoParsePath x y = y{settingsNoParsePath = x}
 
 -- | Get the listening port.
 --
@@ -332,7 +372,7 @@
 --
 -- Since 3.0.1
 setInstallShutdownHandler :: (IO () -> IO ()) -> Settings -> Settings
-setInstallShutdownHandler x y = y { settingsInstallShutdownHandler = x }
+setInstallShutdownHandler x y = y{settingsInstallShutdownHandler = x}
 
 -- | Default server name to be sent as the \"Server:\" header
 --   if an application does not set one.
@@ -341,7 +381,7 @@
 --
 -- Since 3.0.2
 setServerName :: ByteString -> Settings -> Settings
-setServerName x y = y { settingsServerName = x }
+setServerName x y = y{settingsServerName = x}
 
 -- | The maximum number of bytes to flush from an unconsumed request body.
 --
@@ -358,7 +398,7 @@
 setMaximumBodyFlush :: Maybe Int -> Settings -> Settings
 setMaximumBodyFlush x y
     | Just x' <- x, x' < 0 = error "setMaximumBodyFlush: must be positive"
-    | otherwise = y { settingsMaximumBodyFlush = x }
+    | otherwise = y{settingsMaximumBodyFlush = x}
 
 -- | Code to fork a new thread to accept a connection.
 --
@@ -368,8 +408,9 @@
 -- Default: void . forkIOWithUnmask
 --
 -- Since 3.0.4
-setFork :: (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> Settings -> Settings
-setFork fork' s = s { settingsFork = fork' }
+setFork
+    :: (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> Settings -> Settings
+setFork fork' s = s{settingsFork = fork'}
 
 -- | Code to accept a new connection.
 --
@@ -380,13 +421,13 @@
 --
 -- Since 3.3.24
 setAccept :: (Socket -> IO (Socket, SockAddr)) -> Settings -> Settings
-setAccept accept' s = s { settingsAccept = accept' }
+setAccept accept' s = s{settingsAccept = accept'}
 
 -- | Do not use the PROXY protocol.
 --
 -- Since 3.0.5
 setProxyProtocolNone :: Settings -> Settings
-setProxyProtocolNone y = y { settingsProxyProtocol = ProxyProtocolNone }
+setProxyProtocolNone y = y{settingsProxyProtocol = ProxyProtocolNone}
 
 -- | Require PROXY header.
 --
@@ -402,7 +443,7 @@
 --
 -- Since 3.0.5
 setProxyProtocolRequired :: Settings -> Settings
-setProxyProtocolRequired y = y { settingsProxyProtocol = ProxyProtocolRequired }
+setProxyProtocolRequired y = y{settingsProxyProtocol = ProxyProtocolRequired}
 
 -- | Use the PROXY header if it exists, but also accept
 -- connections without the header.  See 'setProxyProtocolRequired'.
@@ -418,35 +459,39 @@
 --
 -- Since 3.0.5
 setProxyProtocolOptional :: Settings -> Settings
-setProxyProtocolOptional y = y { settingsProxyProtocol = ProxyProtocolOptional }
+setProxyProtocolOptional y = y{settingsProxyProtocol = ProxyProtocolOptional}
 
 -- | Size in bytes read to prevent Slowloris attacks. Default value: 2048
 --
 -- Since 3.1.2
 setSlowlorisSize :: Int -> Settings -> Settings
-setSlowlorisSize x y = y { settingsSlowlorisSize = x }
+setSlowlorisSize x y = y{settingsSlowlorisSize = x}
 
 -- | Disable HTTP2.
 --
 -- Since 3.1.7
 setHTTP2Disabled :: Settings -> Settings
-setHTTP2Disabled y = y { settingsHTTP2Enabled = False }
+setHTTP2Disabled y = y{settingsHTTP2Enabled = False}
 
 -- | Setting a log function.
 --
 -- Since 3.X.X
-setLogger :: (Request -> H.Status -> Maybe Integer -> IO ()) -- ^ request, status, maybe file-size
-          -> Settings
-          -> Settings
-setLogger lgr y = y { settingsLogger = lgr }
+setLogger
+    :: (Request -> H.Status -> Maybe Integer -> IO ())
+    -- ^ request, status, maybe file-size
+    -> Settings
+    -> Settings
+setLogger lgr y = y{settingsLogger = lgr}
 
 -- | Setting a log function for HTTP/2 server push.
 --
 --   Since: 3.2.7
-setServerPushLogger :: (Request -> ByteString -> Integer -> IO ()) -- ^ request, path, file-size
-                    -> Settings
-                    -> Settings
-setServerPushLogger lgr y = y { settingsServerPushLogger = lgr }
+setServerPushLogger
+    :: (Request -> ByteString -> Integer -> IO ())
+    -- ^ request, path, file-size
+    -> Settings
+    -> Settings
+setServerPushLogger lgr y = y{settingsServerPushLogger = lgr}
 
 -- | Set the graceful shutdown timeout. A timeout of `Nothing' will
 -- wait indefinitely, and a number, if provided, will be treated as seconds
@@ -457,29 +502,32 @@
 -- response to a UNIX signal.
 --
 -- Since 3.2.8
-setGracefulShutdownTimeout :: Maybe Int
-                           -> Settings -> Settings
-setGracefulShutdownTimeout time y = y { settingsGracefulShutdownTimeout = time }
+setGracefulShutdownTimeout
+    :: Maybe Int
+    -> Settings
+    -> Settings
+setGracefulShutdownTimeout time y = y{settingsGracefulShutdownTimeout = time}
 
 -- | Set the maximum header size that Warp will tolerate when using HTTP/1.x.
 --
 -- Since 3.3.8
 setMaxTotalHeaderLength :: Int -> Settings -> Settings
-setMaxTotalHeaderLength maxTotalHeaderLength settings = settings
-  { settingsMaxTotalHeaderLength = maxTotalHeaderLength }
-
+setMaxTotalHeaderLength maxTotalHeaderLength settings =
+    settings
+        { settingsMaxTotalHeaderLength = maxTotalHeaderLength
+        }
 
 -- | Setting the header value of Alternative Services (AltSvc:).
 --
 -- Since 3.3.11
 setAltSvc :: ByteString -> Settings -> Settings
-setAltSvc altsvc settings = settings { settingsAltSvc = Just altsvc }
+setAltSvc altsvc settings = settings{settingsAltSvc = Just altsvc}
 
 -- | Set the maximum buffer size for sending `Builder` responses.
 --
 -- Since 3.3.22
 setMaxBuilderResponseBufferSize :: Int -> Settings -> Settings
-setMaxBuilderResponseBufferSize maxRspBufSize settings = settings { settingsMaxBuilderResponseBufferSize = maxRspBufSize }
+setMaxBuilderResponseBufferSize maxRspBufSize settings = settings{settingsMaxBuilderResponseBufferSize = maxRspBufSize}
 
 -- | Explicitly pause the slowloris timeout.
 --
@@ -507,7 +555,10 @@
 --
 -- Since 3.1.10
 getFileInfo :: Request -> FilePath -> IO FileInfo
-getFileInfo = fromMaybe (\_ -> throwIO (userError "getFileInfo")) . Vault.lookup getFileInfoKey . vault
+getFileInfo =
+    fromMaybe (\_ -> throwIO (userError "getFileInfo"))
+        . Vault.lookup getFileInfoKey
+        . vault
 
 -- | A timeout to limit the time (in milliseconds) waiting for
 --   FIN for HTTP/1.x. 0 means uses immediate close.
@@ -515,7 +566,7 @@
 --
 -- Since 3.3.5
 setGracefulCloseTimeout1 :: Int -> Settings -> Settings
-setGracefulCloseTimeout1 x y = y { settingsGracefulCloseTimeout1 = x }
+setGracefulCloseTimeout1 x y = y{settingsGracefulCloseTimeout1 = x}
 
 -- | A timeout to limit the time (in milliseconds) waiting for
 --   FIN for HTTP/1.x. 0 means uses immediate close.
@@ -530,7 +581,7 @@
 --
 -- Since 3.3.5
 setGracefulCloseTimeout2 :: Int -> Settings -> Settings
-setGracefulCloseTimeout2 x y = y { settingsGracefulCloseTimeout2 = x }
+setGracefulCloseTimeout2 x y = y{settingsGracefulCloseTimeout2 = x}
 
 -- | A timeout to limit the time (in milliseconds) waiting for
 --   FIN for HTTP/2. 0 means uses immediate close.
@@ -538,6 +589,27 @@
 -- Since 3.3.5
 getGracefulCloseTimeout2 :: Settings -> Int
 getGracefulCloseTimeout2 = settingsGracefulCloseTimeout2
+
+-- | Get the connection counter, if one was configured.
+-- Use 'getCount' on the returned 'Counter' to read the current value.
+--
+-- See 'makeSettingsAndCounter' to create settings with a counter.
+--
+-- /DEPRECATED in favor of 'getServerState'/
+--
+-- Since 3.4.11
+getOpenConnectionCounter :: Settings -> Maybe Counter
+getOpenConnectionCounter = settingsConnectionCounter
+
+-- | Get the 'ServerState', if one was configured.
+-- Use things like 'currentOpenConnections' and 'currentShuttingDownState' to
+-- query information about the current state of the server.
+--
+-- See 'makeSettingsAndServerState' to create 'Settings' with a 'ServerState'.
+--
+-- Since 3.4.12
+getServerState :: Settings -> Maybe ServerState
+getServerState = settingsServerState
 
 #ifdef MIN_VERSION_crypton_x509
 -- | Getting information of client certificate.
diff --git a/Network/Wai/Handler/Warp/Buffer.hs b/Network/Wai/Handler/Warp/Buffer.hs
--- a/Network/Wai/Handler/Warp/Buffer.hs
+++ b/Network/Wai/Handler/Warp/Buffer.hs
@@ -1,15 +1,15 @@
 module Network.Wai.Handler.Warp.Buffer (
-    createWriteBuffer
-  , allocateBuffer
-  , freeBuffer
-  , toBuilderBuffer
-  , bufferIO
-  ) where
+    createWriteBuffer,
+    allocateBuffer,
+    freeBuffer,
+    toBuilderBuffer,
+    bufferIO,
+) where
 
 import Data.IORef (IORef, readIORef)
 import qualified Data.Streaming.ByteString.Builder.Buffer as B (Buffer (..))
 import Foreign.ForeignPtr
-import Foreign.Marshal.Alloc (mallocBytes, free)
+import Foreign.Marshal.Alloc (free, mallocBytes)
 import Foreign.Ptr (plusPtr)
 import Network.Socket.BufferPool
 
@@ -22,13 +22,13 @@
 -- containing that size and a finalizer.
 createWriteBuffer :: BufSize -> IO WriteBuffer
 createWriteBuffer size = do
-  bytes <- allocateBuffer size
-  return
-    WriteBuffer
-      { bufBuffer = bytes,
-        bufSize = size,
-        bufFree = freeBuffer bytes
-      }
+    bytes <- allocateBuffer size
+    return
+        WriteBuffer
+            { bufBuffer = bytes
+            , bufSize = size
+            , bufFree = freeBuffer bytes
+            }
 
 ----------------------------------------------------------------
 
diff --git a/Network/Wai/Handler/Warp/Conduit.hs b/Network/Wai/Handler/Warp/Conduit.hs
--- a/Network/Wai/Handler/Warp/Conduit.hs
+++ b/Network/Wai/Handler/Warp/Conduit.hs
@@ -2,9 +2,10 @@
 
 module Network.Wai.Handler.Warp.Conduit where
 
-import UnliftIO (assert, throwIO)
+import Control.Exception (assert, throwIO)
 import qualified Data.ByteString as S
 import qualified Data.IORef as I
+import Data.Word8 (_0, _9, _A, _F, _a, _cr, _f, _lf)
 
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.Types
@@ -29,46 +30,44 @@
     if count == 0
         then return S.empty
         else do
+            bs <- readSource src
 
-        bs <- readSource src
+            -- If no chunk available, then there aren't enough bytes in the
+            -- stream. Throw a ConnectionClosedByPeer
+            when (S.null bs) $ throwIO ConnectionClosedByPeer
 
-        -- If no chunk available, then there aren't enough bytes in the
-        -- stream. Throw a ConnectionClosedByPeer
-        when (S.null bs) $ throwIO ConnectionClosedByPeer
+            let -- How many of the bytes in this chunk to send downstream
+                toSend = min count (S.length bs)
+                -- How many bytes will still remain to be sent downstream
+                count' = count - toSend
 
-        let -- How many of the bytes in this chunk to send downstream
-            toSend = min count (S.length bs)
-            -- How many bytes will still remain to be sent downstream
-            count' = count - toSend
-        case () of
-            ()
-                -- The expected count is greater than the size of the
+            I.writeIORef ref count'
+
+            if count' > 0
+                then -- The expected count is greater than the size of the
                 -- chunk we just read. Send the entire chunk
                 -- downstream, and then loop on this function for the
                 -- next chunk.
-                | count' > 0 -> do
-                    I.writeIORef ref count'
                     return bs
-
-                -- Some of the bytes in this chunk should not be sent
-                -- downstream. Split up the chunk into the sent and
-                -- not-sent parts, add the not-sent parts onto the new
-                -- source, and send the rest of the chunk downstream.
-                | otherwise -> do
+                else do
+                    -- Some of the bytes in this chunk should not be sent
+                    -- downstream. Split up the chunk into the sent and
+                    -- not-sent parts, add the not-sent parts onto the new
+                    -- source, and send the rest of the chunk downstream.
                     let (x, y) = S.splitAt toSend bs
                     leftoverSource src y
-                    assert (count' == 0) $ I.writeIORef ref count'
-                    return x
+                    assert (count' == 0) $ return x
 
 ----------------------------------------------------------------
 
 data CSource = CSource !Source !(I.IORef ChunkState)
 
-data ChunkState = NeedLen
-                | NeedLenNewline
-                | HaveLen Word
-                | DoneChunking
-    deriving Show
+data ChunkState
+    = NeedLen
+    | NeedLenNewline
+    | HaveLen Word
+    | DoneChunking
+    deriving (Show)
 
 mkCSource :: Source -> IO CSource
 mkCSource src = do
@@ -106,17 +105,19 @@
         bs <- readSource src
         case S.uncons bs of
             Nothing -> return ()
-            Just (13, bs') -> dropLF bs'
-            Just (10, bs') -> leftoverSource src bs'
-            Just _ -> leftoverSource src bs
+            Just (w8, bs')
+                | w8 == _cr -> dropLF bs'
+                | w8 == _lf -> leftoverSource src bs'
+                | otherwise -> leftoverSource src bs
 
     dropLF bs =
         case S.uncons bs of
             Nothing -> do
                 bs2 <- readSource' src
                 unless (S.null bs2) $ dropLF bs2
-            Just (10, bs') -> leftoverSource src bs'
-            Just _ -> leftoverSource src bs
+            Just (w8, bs') ->
+                leftoverSource src $
+                    if w8 == _lf then bs' else bs
 
     go NeedLen = getLen
     go NeedLenNewline = dropCRLF >> getLen
@@ -139,17 +140,18 @@
                 return S.empty
             else do
                 (x, y) <-
-                    case S.break (== 10) bs of
+                    case S.break (== _lf) bs of
                         (x, y)
                             | S.null y -> do
                                 bs2 <- readSource' src
-                                return $ if S.null bs2
-                                    then (x, y)
-                                    else S.break (== 10) $ bs `S.append` bs2
+                                return $
+                                    if S.null bs2
+                                        then (x, y)
+                                        else S.break (== _lf) $ bs `S.append` bs2
                             | otherwise -> return (x, y)
                 let w =
-                        S.foldl' (\i c -> i * 16 + fromIntegral (hexToWord c)) 0
-                        $ S.takeWhile isHexDigit x
+                        S.foldl' (\i c -> i * 16 + fromIntegral (hexToWord c)) 0 $
+                            S.takeWhile isHexDigit x
 
                 let y' = S.drop 1 y
                 y'' <-
@@ -159,11 +161,12 @@
                 withLen w y''
 
     hexToWord w
-        | w < 58 = w - 48
-        | w < 71 = w - 55
+        | w <= _9 = w - _0
+        | w <= _F = w - 55
         | otherwise = w - 87
 
 isHexDigit :: Word8 -> Bool
-isHexDigit w = w >= 48 && w <= 57
-            || w >= 65 && w <= 70
-            || w >= 97 && w <= 102
+isHexDigit w =
+    w >= _0 && w <= _9
+        || w >= _A && w <= _F
+        || w >= _a && w <= _f
diff --git a/Network/Wai/Handler/Warp/Counter.hs b/Network/Wai/Handler/Warp/Counter.hs
--- a/Network/Wai/Handler/Warp/Counter.hs
+++ b/Network/Wai/Handler/Warp/Counter.hs
@@ -1,30 +1,58 @@
 {-# LANGUAGE CPP #-}
 
 module Network.Wai.Handler.Warp.Counter (
-    Counter
-  , newCounter
-  , waitForZero
-  , increase
-  , decrease
-  ) where
+    Counter,
+    newCounter,
+    HasDecreased (..),
+    waitForZero,
+    increase,
+    decrease,
+    waitForDecreased,
+    getCount,
+    getCountSTM,
+) where
 
 import Control.Concurrent.STM
 
 import Network.Wai.Handler.Warp.Imports
 
-
 newtype Counter = Counter (TVar Int)
 
 newCounter :: IO Counter
 newCounter = Counter <$> newTVarIO 0
 
 waitForZero :: Counter -> IO ()
-waitForZero (Counter ref) = atomically $ do
-    x <- readTVar ref
+waitForZero (Counter var) = atomically $ do
+    x <- readTVar var
     when (x > 0) retry
 
+data HasDecreased = HasDecreased | NoConnections
+    deriving (Eq, Show)
+
+waitForDecreased :: Counter -> IO HasDecreased
+waitForDecreased (Counter var) = do
+    n0 <- atomically $ readTVar var
+    if n0 <= 0
+        then pure NoConnections
+        else atomically $ do
+            n <- readTVar var
+            check (n < n0)
+            pure HasDecreased
+
 increase :: Counter -> IO ()
-increase (Counter ref) = atomically $ modifyTVar' ref $ \x -> x + 1
+increase (Counter var) = atomically $ modifyTVar' var $ \x -> x + 1
 
 decrease :: Counter -> IO ()
-decrease (Counter ref) = atomically $ modifyTVar' ref $ \x -> x - 1
+decrease (Counter var) = atomically $ modifyTVar' var $ \x -> x - 1
+
+-- | Get the current count of open connections.
+--
+-- Since 3.4.11
+getCount :: Counter -> IO Int
+getCount (Counter var) = readTVarIO var
+
+-- | Get the current count in an 'STM' transaction.
+--
+-- Since 3.4.13
+getCountSTM :: Counter -> STM Int
+getCountSTM (Counter tvar) = readTVar tvar
diff --git a/Network/Wai/Handler/Warp/Date.hs b/Network/Wai/Handler/Warp/Date.hs
--- a/Network/Wai/Handler/Warp/Date.hs
+++ b/Network/Wai/Handler/Warp/Date.hs
@@ -1,11 +1,16 @@
 {-# LANGUAGE CPP #-}
 
 module Network.Wai.Handler.Warp.Date (
-    withDateCache
-  , GMTDate
-  ) where
+    withDateCache,
+    GMTDate,
+) where
 
-import Control.AutoUpdate (defaultUpdateSettings, updateAction, mkAutoUpdate)
+import Control.AutoUpdate (
+    defaultUpdateSettings,
+    mkAutoUpdate,
+    updateAction,
+    updateThreadName,
+ )
 import Data.ByteString
 import Network.HTTP.Date
 
@@ -25,9 +30,12 @@
 withDateCache action = initialize >>= action
 
 initialize :: IO (IO GMTDate)
-initialize = mkAutoUpdate defaultUpdateSettings {
-                            updateAction = formatHTTPDate <$> getCurrentHTTPDate
-                          }
+initialize =
+    mkAutoUpdate
+        defaultUpdateSettings
+            { updateAction = formatHTTPDate <$> getCurrentHTTPDate
+            , updateThreadName = "Date cacher (AutoUpdate)"
+            }
 
 #ifdef WINDOWS
 uToH :: UTCTime -> HTTPDate
diff --git a/Network/Wai/Handler/Warp/FdCache.hs b/Network/Wai/Handler/Warp/FdCache.hs
--- a/Network/Wai/Handler/Warp/FdCache.hs
+++ b/Network/Wai/Handler/Warp/FdCache.hs
@@ -1,24 +1,32 @@
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 
 -- | File descriptor cache to avoid locks in kernel.
-
 module Network.Wai.Handler.Warp.FdCache (
-    withFdCache
-  , Fd
-  , Refresh
+    withFdCache,
+    Fd,
+    Refresh,
 #ifndef WINDOWS
-  , openFile
-  , closeFile
-  , setFileCloseOnExec
+    closeFile,
+    openFile,
+    setFileCloseOnExec,
 #endif
-  ) where
+) where
 
 #ifndef WINDOWS
-import UnliftIO.Exception (bracket)
 import Control.Reaper
 import Data.IORef
 import Network.Wai.Handler.Warp.MultiMap as MM
-import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd, FdOption(CloseOnExec), setFdOption)
+import System.Posix.IO (
+    FdOption (CloseOnExec),
+    OpenFileFlags (..),
+    OpenMode (ReadOnly),
+    closeFd,
+    defaultFileFlags,
+    openFd,
+    setFdOption,
+ )
+import Control.Exception (bracket)
 #endif
 import System.Posix.Types (Fd)
 
@@ -33,15 +41,17 @@
 ----------------------------------------------------------------
 
 -- | Creating 'MutableFdCache' and executing the action in the second
---   argument. The first argument is a cache duration in second.
+--   argument. The first argument is a cache duration in microseconds.
 withFdCache :: Int -> ((FilePath -> IO (Maybe Fd, Refresh)) -> IO a) -> IO a
 #ifdef WINDOWS
-withFdCache _        action = action getFdNothing
+withFdCache _ action = action getFdNothing
 #else
-withFdCache 0        action = action getFdNothing
-withFdCache duration action = bracket (initialize duration)
-                                      terminate
-                                      (action . getFd)
+withFdCache 0 action = action getFdNothing
+withFdCache duration action =
+    bracket
+        (initialize duration)
+        terminate
+        (action . getFd)
 
 ----------------------------------------------------------------
 
@@ -68,9 +78,9 @@
 openFile :: FilePath -> IO Fd
 openFile path = do
 #if MIN_VERSION_unix(2,8,0)
-    fd <- openFd path ReadOnly defaultFileFlags{nonBlock=False}
+    fd <- openFd path ReadOnly defaultFileFlags{nonBlock = False}
 #else
-    fd <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock=False}
+    fd <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock = False}
 #endif
     setFileCloseOnExec fd
     return fd
@@ -89,7 +99,7 @@
 type FdCache = MultiMap FdEntry
 
 -- | Mutable Fd cacher.
-newtype MutableFdCache = MutableFdCache (Reaper FdCache (FilePath,FdEntry))
+newtype MutableFdCache = MutableFdCache (Reaper FdCache (FilePath, FdEntry))
 
 fdCache :: MutableFdCache -> IO FdCache
 fdCache (MutableFdCache reaper) = reaperRead reaper
@@ -99,27 +109,29 @@
 
 ----------------------------------------------------------------
 
--- The first argument is a cache duration in second.
+-- The first argument is a cache duration in microseconds.
 initialize :: Int -> IO MutableFdCache
 initialize duration = MutableFdCache <$> mkReaper settings
   where
-    settings = defaultReaperSettings {
-        reaperAction = clean
-      , reaperDelay = duration
-      , reaperCons = uncurry insert
-      , reaperNull = isEmpty
-      , reaperEmpty = empty
-      }
+    settings =
+        defaultReaperSettings
+            { reaperAction = clean
+            , reaperDelay = duration
+            , reaperCons = uncurry insert
+            , reaperNull = isEmpty
+            , reaperEmpty = empty
+            , reaperThreadName = "Fd cacher (Reaper) "
+            }
 
 clean :: FdCache -> IO (FdCache -> FdCache)
 clean old = do
     new <- pruneWith old prune
     return $ merge new
   where
-    prune (_,FdEntry fd mst) = status mst >>= act
+    prune (_, FdEntry fd mst) = status mst >>= act
       where
-        act Active   = inactive mst >> return True
-        act Inactive = closeFd fd   >> return False
+        act Active = inactive mst >> return True
+        act Inactive = closeFd fd >> return False
 
 ----------------------------------------------------------------
 
@@ -138,7 +150,7 @@
   where
     get Nothing = do
         ent@(FdEntry fd mst) <- newFdEntry path
-        reaperAdd reaper (path,ent)
+        reaperAdd reaper (path, ent)
         return (Just fd, refresh mst)
     get (Just (FdEntry fd mst)) = do
         refresh mst
diff --git a/Network/Wai/Handler/Warp/File.hs b/Network/Wai/Handler/Warp/File.hs
--- a/Network/Wai/Handler/Warp/File.hs
+++ b/Network/Wai/Handler/Warp/File.hs
@@ -1,13 +1,13 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE BangPatterns #-}
 
 module Network.Wai.Handler.Warp.File (
-    RspFileInfo(..)
-  , conditionalRequest
-  , addContentHeadersForFilePart
-  , H.parseByteRanges
-  ) where
+    RspFileInfo (..),
+    conditionalRequest,
+    addContentHeadersForFilePart,
+    H.parseByteRanges,
+) where
 
 import Data.Array ((!))
 import qualified Data.ByteString.Char8 as C8 (pack)
@@ -21,36 +21,36 @@
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.PackInt
 
-
--- $setup
--- >>> import Test.QuickCheck
-
 ----------------------------------------------------------------
 
-data RspFileInfo = WithoutBody H.Status
-                 | WithBody H.Status H.ResponseHeaders Integer Integer
-                 deriving (Eq,Show)
+data RspFileInfo
+    = WithoutBody H.Status
+    | WithBody H.Status H.ResponseHeaders Integer Integer
+    deriving (Eq, Show)
 
 ----------------------------------------------------------------
 
-conditionalRequest :: I.FileInfo
-                   -> H.ResponseHeaders
-                   -> H.Method
-                   -> IndexedHeader -- ^ Response
-                   -> IndexedHeader -- ^ Request
-                   -> RspFileInfo
+conditionalRequest
+    :: I.FileInfo
+    -> H.ResponseHeaders
+    -> H.Method
+    -> IndexedHeader
+    -- ^ Response
+    -> IndexedHeader
+    -- ^ Request
+    -> RspFileInfo
 conditionalRequest finfo hs0 method rspidx reqidx = case condition of
     nobody@(WithoutBody _) -> nobody
-    WithBody s _ off len   ->
+    WithBody s _ off len ->
         let !hs1 = addContentHeaders hs0 off len size
             !hs = case rspidx ! fromEnum ResLastModified of
                 Just _ -> hs1
-                Nothing -> (H.hLastModified,date) : hs1
-        in WithBody s hs off len
+                Nothing -> (H.hLastModified, date) : hs1
+         in WithBody s hs off len
   where
     !mtime = I.fileInfoTime finfo
-    !size  = I.fileInfoSize finfo
-    !date  = I.fileInfoDate finfo
+    !size = I.fileInfoSize finfo
+    !date = I.fileInfoDate finfo
     -- According to RFC 9110:
     -- "A recipient cache or origin server MUST evaluate the request
     -- preconditions defined by this specification in the following order:
@@ -64,9 +64,10 @@
     -- we also don't want to block middleware or applications from
     -- using ETags. And sending If-(None-)Match headers in a request
     -- to a server that doesn't use them is requester's problem.
-    !mcondition = ifunmodified  reqidx mtime
-              <|> ifmodified    reqidx mtime method
-              <|> ifrange       reqidx mtime method size
+    !mcondition =
+        ifunmodified reqidx mtime
+            <|> ifmodified reqidx mtime method
+            <|> ifrange reqidx mtime method size
     !condition = fromMaybe (unconditional reqidx size) mcondition
 
 ----------------------------------------------------------------
@@ -112,7 +113,7 @@
     -- "When the method is GET and both Range and If-Range are
     -- present, evaluate the If-Range precondition:"
     date <- ifRange reqidx
-    rng  <- reqidx ! fromEnum ReqRange
+    rng <- reqidx ! fromEnum ReqRange
     guard $ method == H.methodGet
     return $
         if date == mtime
@@ -122,27 +123,28 @@
 unconditional :: IndexedHeader -> Integer -> RspFileInfo
 unconditional reqidx =
     case reqidx ! fromEnum ReqRange of
-        Nothing  -> WithBody H.ok200 [] 0
+        Nothing -> WithBody H.ok200 [] 0
         Just rng -> parseRange rng
 
 ----------------------------------------------------------------
 
 parseRange :: ByteString -> Integer -> RspFileInfo
 parseRange rng size = case H.parseByteRanges rng of
-    Nothing    -> WithoutBody H.requestedRangeNotSatisfiable416
-    Just []    -> WithoutBody H.requestedRangeNotSatisfiable416
-    Just (r:_) -> let (!beg, !end) = checkRange r size
-                      !len = end - beg + 1
-                      s = if beg == 0 && end == size - 1 then
-                              H.ok200
-                            else
-                              H.partialContent206
-                  in WithBody s [] beg len
+    Nothing -> WithoutBody H.requestedRangeNotSatisfiable416
+    Just [] -> WithoutBody H.requestedRangeNotSatisfiable416
+    Just (r : _) ->
+        let (!beg, !end) = checkRange r size
+            !len = end - beg + 1
+            s =
+                if beg == 0 && end == size - 1
+                    then H.ok200
+                    else H.partialContent206
+         in WithBody s [] beg len
 
 checkRange :: H.ByteRange -> Integer -> (Integer, Integer)
-checkRange (H.ByteRangeFrom   beg)     size = (beg, size - 1)
-checkRange (H.ByteRangeFromTo beg end) size = (beg,  min (size - 1) end)
-checkRange (H.ByteRangeSuffix count)   size = (max 0 (size - count), size - 1)
+checkRange (H.ByteRangeFrom beg) size = (beg, size - 1)
+checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size - 1) end)
+checkRange (H.ByteRangeSuffix count) size = (max 0 (size - count), size - 1)
 
 ----------------------------------------------------------------
 
@@ -151,24 +153,37 @@
 contentRangeHeader :: Integer -> Integer -> Integer -> H.Header
 contentRangeHeader beg end total = (H.hContentRange, range)
   where
-    range = C8.pack
-      -- building with ShowS
-      $ 'b' : 'y': 't' : 'e' : 's' : ' '
-      : (if beg > end then ('*':) else
-          showInt beg
-          . ('-' :)
-          . showInt end)
-      ( '/'
-      : showInt total "")
+    range =
+        C8.pack
+        -- building with ShowS
+        $
+            'b'
+                : 'y'
+                : 't'
+                : 'e'
+                : 's'
+                : ' '
+                : ( if beg > end
+                        then ('*' :)
+                        else
+                            showInt beg
+                                . ('-' :)
+                                . showInt end
+                  )
+                    ( '/'
+                        : showInt total ""
+                    )
 
-addContentHeaders :: H.ResponseHeaders -> Integer -> Integer -> Integer -> H.ResponseHeaders
+addContentHeaders
+    :: H.ResponseHeaders -> Integer -> Integer -> Integer -> H.ResponseHeaders
 addContentHeaders hs off len size
-  | len == size = hs'
-  | otherwise   = let !ctrng = contentRangeHeader off (off + len - 1) size
-                  in ctrng:hs'
+    | len == size = hs'
+    | otherwise =
+        let !ctrng = contentRangeHeader off (off + len - 1) size
+         in ctrng : hs'
   where
     !lengthBS = packIntegral len
-    !hs' = (H.hContentLength, lengthBS) : (H.hAcceptRanges,"bytes") : hs
+    !hs' = (H.hContentLength, lengthBS) : (H.hAcceptRanges, "bytes") : hs
 
 -- |
 --
@@ -176,7 +191,8 @@
 -- [("Content-Range","bytes 2-11/16"),("Content-Length","10"),("Accept-Ranges","bytes")]
 -- >>> addContentHeadersForFilePart [] (FilePart 0 16 16)
 -- [("Content-Length","16"),("Accept-Ranges","bytes")]
-addContentHeadersForFilePart :: H.ResponseHeaders -> FilePart -> H.ResponseHeaders
+addContentHeadersForFilePart
+    :: H.ResponseHeaders -> FilePart -> H.ResponseHeaders
 addContentHeadersForFilePart hs part = addContentHeaders hs off len size
   where
     off = filePartOffset part
diff --git a/Network/Wai/Handler/Warp/FileInfoCache.hs b/Network/Wai/Handler/Warp/FileInfoCache.hs
--- a/Network/Wai/Handler/Warp/FileInfoCache.hs
+++ b/Network/Wai/Handler/Warp/FileInfoCache.hs
@@ -1,11 +1,13 @@
-{-# LANGUAGE RecordWildCards, CPP #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Network.Wai.Handler.Warp.FileInfoCache (
-    FileInfo(..)
-  , withFileInfoCache
-  , getInfo -- test purpose only
-  ) where
+    FileInfo (..),
+    withFileInfoCache,
+    getInfo, -- test purpose only
+) where
 
+import Control.Exception (bracket, onException, throwIO)
 import Control.Reaper
 import Network.HTTP.Date
 #if WINDOWS
@@ -13,7 +15,6 @@
 #else
 import System.Posix.Files
 #endif
-import qualified UnliftIO (onException, bracket, throwIO)
 
 import Network.Wai.Handler.Warp.HashMap (HashMap)
 import qualified Network.Wai.Handler.Warp.HashMap as M
@@ -22,16 +23,19 @@
 ----------------------------------------------------------------
 
 -- | File information.
-data FileInfo = FileInfo {
-    fileInfoName :: !FilePath
-  , fileInfoSize :: !Integer
-  , fileInfoTime :: HTTPDate   -- ^ Modification time
-  , fileInfoDate :: ByteString -- ^ Modification time in the GMT format
-  } deriving (Eq, Show)
+data FileInfo = FileInfo
+    { fileInfoName :: !FilePath
+    , fileInfoSize :: !Integer
+    , fileInfoTime :: HTTPDate
+    -- ^ Modification time
+    , fileInfoDate :: ByteString
+    -- ^ Modification time in the GMT format
+    }
+    deriving (Eq, Show)
 
 data Entry = Negative | Positive FileInfo
 type Cache = HashMap Entry
-type FileInfoCache = Reaper Cache (FilePath,Entry)
+type FileInfoCache = Reaper Cache (FilePath, Entry)
 
 ----------------------------------------------------------------
 
@@ -41,19 +45,20 @@
     fs <- getFileStatus path -- file access
     let regular = not (isDirectory fs)
         readable = fileMode fs `intersectFileModes` ownerReadMode /= 0
-    if regular && readable then do
-        let time = epochTimeToHTTPDate $ modificationTime fs
-            date = formatHTTPDate time
-            size = fromIntegral $ fileSize fs
-            info = FileInfo {
-                fileInfoName = path
-              , fileInfoSize = size
-              , fileInfoTime = time
-              , fileInfoDate = date
-              }
-        return info
-      else
-        UnliftIO.throwIO (userError "FileInfoCache:getInfo")
+    if regular && readable
+        then do
+            let time = epochTimeToHTTPDate $ modificationTime fs
+                date = formatHTTPDate time
+                size = fromIntegral $ fileSize fs
+                info =
+                    FileInfo
+                        { fileInfoName = path
+                        , fileInfoSize = size
+                        , fileInfoTime = time
+                        , fileInfoDate = date
+                        }
+            return info
+        else throwIO (userError "FileInfoCache:getInfo")
 
 getInfoNaive :: FilePath -> IO FileInfo
 getInfoNaive = getInfo
@@ -61,50 +66,54 @@
 ----------------------------------------------------------------
 
 getAndRegisterInfo :: FileInfoCache -> FilePath -> IO FileInfo
-getAndRegisterInfo reaper@Reaper{..} path = do
-    cache <- reaperRead
+getAndRegisterInfo reaper path = do
+    cache <- reaperRead reaper
     case M.lookup path cache of
-        Just Negative     -> UnliftIO.throwIO (userError "FileInfoCache:getAndRegisterInfo")
+        Just Negative -> throwIO (userError "FileInfoCache:getAndRegisterInfo")
         Just (Positive x) -> return x
-        Nothing           -> positive reaper path
-                               `UnliftIO.onException` negative reaper path
+        Nothing ->
+            positive reaper path
+                `onException` negative reaper path
 
 positive :: FileInfoCache -> FilePath -> IO FileInfo
-positive Reaper{..} path = do
+positive reaper path = do
     info <- getInfo path
-    reaperAdd (path, Positive info)
+    reaperAdd reaper (path, Positive info)
     return info
 
 negative :: FileInfoCache -> FilePath -> IO FileInfo
-negative Reaper{..} path = do
-    reaperAdd (path, Negative)
-    UnliftIO.throwIO (userError "FileInfoCache:negative")
+negative reaper path = do
+    reaperAdd reaper (path, Negative)
+    throwIO (userError "FileInfoCache:negative")
 
 ----------------------------------------------------------------
 
 -- | Creating a file information cache
 --   and executing the action in the second argument.
---   The first argument is a cache duration in second.
-withFileInfoCache :: Int
-                  -> ((FilePath -> IO FileInfo) -> IO a)
-                  -> IO a
-withFileInfoCache 0        action = action getInfoNaive
+--   The first argument is a cache duration in microseconds.
+withFileInfoCache
+    :: Int
+    -> ((FilePath -> IO FileInfo) -> IO a)
+    -> IO a
+withFileInfoCache 0 action = action getInfoNaive
 withFileInfoCache duration action =
-    UnliftIO.bracket
-      (initialize duration)
-      terminate
-      (action . getAndRegisterInfo)
+    bracket
+        (initialize duration)
+        terminate
+        (action . getAndRegisterInfo)
 
 initialize :: Int -> IO FileInfoCache
 initialize duration = mkReaper settings
   where
-    settings = defaultReaperSettings {
-        reaperAction = override
-      , reaperDelay  = duration
-      , reaperCons   = \(path,v) -> M.insert path v
-      , reaperNull   = M.isEmpty
-      , reaperEmpty  = M.empty
-      }
+    settings =
+        defaultReaperSettings
+            { reaperAction = override
+            , reaperDelay = duration
+            , reaperCons = \(path, v) -> M.insert path v
+            , reaperNull = M.isEmpty
+            , reaperEmpty = M.empty
+            , reaperThreadName = "File info cacher (Reaper)"
+            }
 
 override :: Cache -> IO (Cache -> Cache)
 override _ = return $ const M.empty
diff --git a/Network/Wai/Handler/Warp/HTTP1.hs b/Network/Wai/Handler/Warp/HTTP1.hs
--- a/Network/Wai/Handler/Warp/HTTP1.hs
+++ b/Network/Wai/Handler/Warp/HTTP1.hs
@@ -5,20 +5,20 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Network.Wai.Handler.Warp.HTTP1 (
-    http1
-  ) where
+    http1,
+) where
 
-import "iproute" Data.IP (toHostAddress, toHostAddress6)
 import qualified Control.Concurrent as Conc (yield)
-import qualified UnliftIO
-import UnliftIO (SomeException, fromException, throwIO)
+import Control.Exception (SomeException, catch, fromException, throwIO, try)
 import qualified Data.ByteString as BS
 import Data.Char (chr)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Network.Socket (SockAddr(SockAddrInet, SockAddrInet6))
+import Data.Word8 (_cr, _space)
+import Network.Socket (SockAddr (SockAddrInet, SockAddrInet6))
 import Network.Wai
 import Network.Wai.Internal (ResponseReceived (ResponseReceived))
 import qualified System.TimeManager as T
+import "iproute" Data.IP (toHostAddress, toHostAddress6)
 
 import Network.Wai.Handler.Warp.Header
 import Network.Wai.Handler.Warp.Imports hiding (readInt)
@@ -28,7 +28,16 @@
 import Network.Wai.Handler.Warp.Settings
 import Network.Wai.Handler.Warp.Types
 
-http1 :: Settings -> InternalInfo -> Connection -> Transport -> Application -> SockAddr -> T.Handle -> ByteString -> IO ()
+http1
+    :: Settings
+    -> InternalInfo
+    -> Connection
+    -> Transport
+    -> Application
+    -> SockAddr
+    -> T.Handle
+    -> ByteString
+    -> IO ()
 http1 settings ii conn transport app origAddr th bs0 = do
     istatus <- newIORef True
     src <- mkSource (wrappedRecv conn istatus (settingsSlowlorisSize settings))
@@ -36,7 +45,7 @@
     addr <- getProxyProtocolAddr src
     http1server settings ii conn transport app addr th istatus src
   where
-    wrappedRecv Connection { connRecv = recv } istatus slowlorisSize = do
+    wrappedRecv Connection{connRecv = recv} istatus slowlorisSize = do
         bs <- recv
         unless (BS.null bs) $ do
             writeIORef istatus True
@@ -54,69 +63,127 @@
                 seg <- readSource src
                 if BS.isPrefixOf "PROXY " seg
                     then parseProxyProtocolHeader src seg
-                    else do leftoverSource src seg
-                            return origAddr
+                    else do
+                        leftoverSource src seg
+                        return origAddr
 
     parseProxyProtocolHeader src seg = do
-        let (header,seg') = BS.break (== 0x0d) seg -- 0x0d == CR
-            maybeAddr = case BS.split 0x20 header of -- 0x20 == space
-                ["PROXY","TCP4",clientAddr,_,clientPort,_] ->
+        let (header, seg') = BS.break (== _cr) seg
+            maybeAddr = case BS.split _space header of
+                ["PROXY", "TCP4", clientAddr, _, clientPort, _] ->
                     case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of
-                        [a] -> Just (SockAddrInet (readInt clientPort)
-                                                       (toHostAddress a))
+                        [a] ->
+                            Just
+                                ( SockAddrInet
+                                    (readInt clientPort)
+                                    (toHostAddress a)
+                                )
                         _ -> Nothing
-                ["PROXY","TCP6",clientAddr,_,clientPort,_] ->
+                ["PROXY", "TCP6", clientAddr, _, clientPort, _] ->
                     case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of
-                        [a] -> Just (SockAddrInet6 (readInt clientPort)
-                                                        0
-                                                        (toHostAddress6 a)
-                                                        0)
+                        [a] ->
+                            Just
+                                ( SockAddrInet6
+                                    (readInt clientPort)
+                                    0
+                                    (toHostAddress6 a)
+                                    0
+                                )
                         _ -> Nothing
-                ("PROXY":"UNKNOWN":_) ->
+                ("PROXY" : "UNKNOWN" : _) ->
                     Just origAddr
                 _ ->
                     Nothing
         case maybeAddr of
             Nothing -> throwIO (BadProxyHeader (decodeAscii header))
-            Just a -> do leftoverSource src (BS.drop 2 seg') -- drop CRLF
-                         return a
+            Just a -> do
+                leftoverSource src (BS.drop 2 seg') -- drop CRLF
+                return a
 
     decodeAscii = map (chr . fromEnum) . BS.unpack
 
-http1server :: Settings -> InternalInfo -> Connection -> Transport -> Application  -> SockAddr -> T.Handle -> IORef Bool -> Source -> IO ()
+http1server
+    :: Settings
+    -> InternalInfo
+    -> Connection
+    -> Transport
+    -> Application
+    -> SockAddr
+    -> T.Handle
+    -> IORef Bool
+    -> Source
+    -> IO ()
 http1server settings ii conn transport app addr th istatus src =
-    loop True `UnliftIO.catchAny` handler
+    loop FirstRequest `catch` handler
   where
     handler e
-      -- See comment below referencing
-      -- https://github.com/yesodweb/wai/issues/618
-      | Just NoKeepAliveRequest <- fromException e = return ()
-      -- No valid request
-      | Just (BadFirstLine _)   <- fromException e = return ()
-      | otherwise = do
-          _ <- sendErrorResponse settings ii conn th istatus defaultRequest { remoteHost = addr } e
-          throwIO e
+        -- See comment below referencing
+        -- https://github.com/yesodweb/wai/issues/618
+        | Just NoKeepAliveRequest <- fromException e = return ()
+        -- No valid request
+        | Just (BadFirstLine _) <- fromException e = return ()
+        | isAsyncException e = throwIO e
+        | otherwise = do
+            _ <-
+                sendErrorResponse
+                    settings
+                    ii
+                    conn
+                    th
+                    istatus
+                    defaultRequest{remoteHost = addr}
+                    e
+            throwIO e
 
     loop firstRequest = do
-        (req, mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src transport
-        keepAlive <- processRequest settings ii conn app th istatus src req mremainingRef idxhdr nextBodyFlush
-            `UnliftIO.catchAny` \e -> do
-                settingsOnException settings (Just req) e
-                -- Don't throw the error again to prevent calling settingsOnException twice.
-                return False
+        (req, mremainingRef, idxhdr, nextBodyFlush) <-
+            recvRequest firstRequest settings conn ii th addr src transport
+        keepAlive <-
+            processRequest
+                settings
+                ii
+                conn
+                app
+                th
+                istatus
+                src
+                req
+                mremainingRef
+                idxhdr
+                nextBodyFlush
+                `catch` \e -> do
+                    settingsOnException settings (Just req) e
+                    -- Don't throw the error again to prevent calling settingsOnException twice.
+                    return CloseConnection
 
         -- When doing a keep-alive connection, the other side may just
         -- close the connection. We don't want to treat that as an
-        -- exceptional situation, so we pass in False to http1 (which
-        -- in turn passes in False to recvRequest), indicating that
+        -- exceptional situation, so we pass in SubsequentRequest to http1 (which
+        -- in turn passes in SubsequentRequest to recvRequest), indicating that
         -- this is not the first request. If, when trying to read the
         -- request headers, no data is available, recvRequest will
         -- throw a NoKeepAliveRequest exception, which we catch here
         -- and ignore. See: https://github.com/yesodweb/wai/issues/618
 
-        when keepAlive $ loop False
+        case keepAlive of
+            ReuseConnection -> loop SubsequentRequest
+            CloseConnection -> return ()
 
-processRequest :: Settings -> InternalInfo -> Connection -> Application -> T.Handle -> IORef Bool -> Source -> Request -> Maybe (IORef Int) -> IndexedHeader -> IO ByteString -> IO Bool
+data ReuseConnection = ReuseConnection | CloseConnection
+
+processRequest
+    :: Settings
+    -> InternalInfo
+    -> Connection
+    -> Application
+    -> T.Handle
+    -> IORef Bool
+    -> Source
+    -> Request
+    -> Maybe (IORef Int)
+    -> IndexedHeader
+    -> IO ByteString
+    -> IO ReuseConnection
 processRequest settings ii conn app th istatus src req mremainingRef idxhdr nextBodyFlush = do
     -- Let the application run for as long as it wants
     T.pause th
@@ -125,7 +192,7 @@
     -- creating the request, we need to make sure that we don't get
     -- an async exception before calling the ResponseSource.
     keepAliveRef <- newIORef $ error "keepAliveRef not filled"
-    r <- UnliftIO.tryAny $ app req $ \res -> do
+    r <- try $ app req $ \res -> do
         T.resume th
         -- FIXME consider forcing evaluation of the res here to
         -- send more meaningful error messages to the user.
@@ -137,8 +204,9 @@
     case r of
         Right ResponseReceived -> return ()
         Left (e :: SomeException)
-          | Just (ExceptionInsideResponseBody e') <- fromException e -> throwIO e'
-          | otherwise -> do
+            | 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
                 writeIORef keepAliveRef keepAlive
@@ -156,46 +224,59 @@
     Conc.yield
 
     if keepAlive
-      then
-        -- If there is an unknown or large amount of data to still be read
+        then -- If there is an unknown or large amount of data to still be read
         -- from the request body, simple drop this connection instead of
         -- reading it all in to satisfy a keep-alive request.
-        case settingsMaximumBodyFlush settings of
-            Nothing -> do
-                flushEntireBody nextBodyFlush
-                T.resume th
-                return True
-            Just maxToRead -> do
-                let tryKeepAlive = do
-                        -- flush the rest of the request body
-                        isComplete <- flushBody nextBodyFlush maxToRead
-                        if isComplete then do
-                            T.resume th
-                            return True
-                          else
-                            return False
-                case mremainingRef of
-                    Just ref -> do
-                        remaining <- readIORef ref
-                        if remaining <= maxToRead then
-                            tryKeepAlive
-                          else
-                            return False
-                    Nothing -> tryKeepAlive
-      else
-        return False
+            case settingsMaximumBodyFlush settings of
+                Nothing -> do
+                    flushEntireBody nextBodyFlush
+                    T.resume th
+                    return ReuseConnection
+                Just maxToRead -> do
+                    let tryKeepAlive = do
+                            -- flush the rest of the request body
+                            isComplete <- flushBody nextBodyFlush maxToRead
+                            if isComplete
+                                then do
+                                    T.resume th
+                                    return ReuseConnection
+                                else return CloseConnection
+                    case mremainingRef of
+                        Just ref -> do
+                            remaining <- readIORef ref
+                            if remaining <= maxToRead
+                                then tryKeepAlive
+                                else return CloseConnection
+                        Nothing -> tryKeepAlive
+        else return CloseConnection
 
-sendErrorResponse :: Settings -> InternalInfo -> Connection -> T.Handle -> IORef Bool -> Request -> SomeException -> IO Bool
+sendErrorResponse
+    :: Settings
+    -> InternalInfo
+    -> Connection
+    -> T.Handle
+    -> IORef Bool
+    -> Request
+    -> SomeException
+    -> IO Bool
 sendErrorResponse settings ii conn th istatus req e = do
     status <- readIORef istatus
-    if shouldSendErrorResponse e && status then
-        sendResponse settings conn ii th req defaultIndexRequestHeader (return BS.empty) errorResponse
-      else
-        return False
+    if shouldSendErrorResponse e && status
+        then
+            sendResponse
+                settings
+                conn
+                ii
+                th
+                req
+                defaultIndexRequestHeader
+                (return BS.empty)
+                errorResponse
+        else return False
   where
     shouldSendErrorResponse se
-      | Just ConnectionClosedByPeer <- fromException se = False
-      | otherwise                                       = True
+        | Just ConnectionClosedByPeer <- fromException se = False
+        | otherwise = True
     errorResponse = settingsOnExceptionResponse settings e
 
 flushEntireBody :: IO ByteString -> IO ()
@@ -206,9 +287,13 @@
         bs <- src
         unless (BS.null bs) loop
 
-flushBody :: IO ByteString -- ^ get next chunk
-          -> Int -- ^ maximum to flush
-          -> IO Bool -- ^ True == flushed the entire body, False == we didn't
+flushBody
+    :: IO ByteString
+    -- ^ get next chunk
+    -> Int
+    -- ^ maximum to flush
+    -> IO Bool
+    -- ^ True == flushed the entire body, False == we didn't
 flushBody src = loop
   where
     loop toRead = do
diff --git a/Network/Wai/Handler/Warp/HTTP2.hs b/Network/Wai/Handler/Warp/HTTP2.hs
--- a/Network/Wai/Handler/Warp/HTTP2.hs
+++ b/Network/Wai/Handler/Warp/HTTP2.hs
@@ -1,25 +1,25 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Network.Wai.Handler.Warp.HTTP2 (
-    http2
-  , http2server
-  ) where
+    http2,
+    http2server,
+) where
 
+import qualified Control.Exception as E
 import qualified Data.ByteString as BS
-import Data.IORef (IORef, newIORef, writeIORef, readIORef)
+import Data.IORef (readIORef)
 import qualified Data.IORef as I
+import GHC.Conc.Sync (labelThread, myThreadId)
 import qualified Network.HTTP2.Frame as H2
 import qualified Network.HTTP2.Server as H2
 import Network.Socket (SockAddr)
 import Network.Socket.BufferPool
 import Network.Wai
-import Network.Wai.Internal (ResponseReceived(..))
+import Network.Wai.Internal (ResponseReceived (..))
 import qualified System.TimeManager as T
-import qualified UnliftIO
 
 import Network.Wai.Handler.Warp.HTTP2.File
 import Network.Wai.Handler.Warp.HTTP2.PushPromise
@@ -31,9 +31,17 @@
 
 ----------------------------------------------------------------
 
-http2 :: S.Settings -> InternalInfo -> Connection -> Transport -> Application -> SockAddr -> T.Handle -> ByteString -> IO ()
+http2
+    :: S.Settings
+    -> InternalInfo
+    -> Connection
+    -> Transport
+    -> Application
+    -> SockAddr
+    -> T.Handle
+    -> ByteString
+    -> IO ()
 http2 settings ii conn transport app peersa th bs = do
-    istatus <- newIORef False
     rawRecvN <- makeRecvN bs $ connRecv conn
     writeBuffer <- readIORef $ connWriteBuffer conn
     -- This thread becomes the sender in http2 library.
@@ -43,23 +51,24 @@
     -- output data from the worker. It's not good enough to tickle
     -- the time handler in the receiver only. So, we should tickle
     -- the time handler in both the receiver and the sender.
-    let recvN = wrappedRecvN th istatus (S.settingsSlowlorisSize settings) rawRecvN
+    let recvN = wrappedRecvN th (S.settingsSlowlorisSize settings) rawRecvN
         sendBS x = connSendAll conn x >> T.tickle th
-        conf = H2.Config {
-            confWriteBuffer       = bufBuffer writeBuffer
-          , confBufferSize        = bufSize writeBuffer
-          , confSendAll           = sendBS
-          , confReadN             = recvN
-          , confPositionReadMaker = pReadMaker ii
-          , confTimeoutManager    = timeoutManager ii
-#if MIN_VERSION_http2(4,2,0)
-          , confMySockAddr        = connMySockAddr conn
-          , confPeerSockAddr      = peersa
-#endif
-          }
+        conf =
+            H2.defaultConfig
+                { H2.confWriteBuffer = bufBuffer writeBuffer
+                , H2.confBufferSize = bufSize writeBuffer
+                , H2.confSendAll = sendBS
+                , H2.confReadN = recvN
+                , H2.confPositionReadMaker = pReadMaker ii
+                , H2.confTimeoutManager = timeoutManager ii
+                , H2.confMySockAddr = connMySockAddr conn
+                , H2.confPeerSockAddr = peersa
+                , H2.confReadNTimeout = True
+                }
     checkTLS
     setConnHTTP2 conn True
-    H2.run H2.defaultServerConfig conf $ http2server settings ii transport peersa app
+    H2.run H2.defaultServerConfig conf $
+        http2server "Warp HTTP/2" settings ii transport peersa app
   where
     checkTLS = case transport of
         TCP -> return () -- direct
@@ -69,35 +78,41 @@
 -- | Converting WAI application to the server type of http2 library.
 --
 -- Since 3.3.11
-http2server :: S.Settings
-            -> InternalInfo
-            -> Transport
-            -> SockAddr
-            -> Application
-            -> H2.Server
-http2server settings ii transport addr app h2req0 aux0 response = do
+http2server
+    :: String
+    -> S.Settings
+    -> InternalInfo
+    -> Transport
+    -> SockAddr
+    -> Application
+    -> H2.Server
+http2server label settings ii transport addr app h2req0 aux0 response = do
+    tid <- myThreadId
+    labelThread tid (label ++ " http2server " ++ show addr)
     req <- toWAIRequest h2req0 aux0
     ref <- I.newIORef Nothing
-    eResponseReceived <- UnliftIO.tryAny $ app req $ \rsp -> do
-        (h2rsp,st,hasBody) <- fromResponse settings ii req rsp
+    eResponseReceived <- E.try $ app req $ \rsp -> do
+        (h2rsp, st, hasBody) <- fromResponse settings ii req rsp
         pps <- if hasBody then fromPushPromises ii req else return []
         I.writeIORef ref $ Just (h2rsp, pps, st)
         _ <- response h2rsp pps
         return ResponseReceived
     case eResponseReceived of
-      Right ResponseReceived -> do
-          Just (h2rsp, pps, st) <- I.readIORef ref
-          let msiz = fromIntegral <$> H2.responseBodySize h2rsp
-          logResponse req st msiz
-          mapM_ (logPushPromise req) pps
-      Left e -> do
-            S.settingsOnException settings (Just req) e
-            let ersp = S.settingsOnExceptionResponse settings e
-                st = responseStatus ersp
-            (h2rsp',_,_) <- fromResponse settings ii req ersp
-            let msiz = fromIntegral <$> H2.responseBodySize h2rsp'
-            _ <- response h2rsp' []
+        Right ResponseReceived -> do
+            Just (h2rsp, pps, st) <- I.readIORef ref
+            let msiz = fromIntegral <$> H2.responseBodySize h2rsp
             logResponse req st msiz
+            mapM_ (logPushPromise req) pps
+        Left e
+            | isAsyncException e -> E.throwIO e
+            | otherwise -> do
+                S.settingsOnException settings (Just req) e
+                let ersp = S.settingsOnExceptionResponse settings e
+                    st = responseStatus ersp
+                (h2rsp', _, _) <- fromResponse settings ii req ersp
+                let msiz = fromIntegral <$> H2.responseBodySize h2rsp'
+                _ <- response h2rsp' []
+                logResponse req st msiz
     return ()
   where
     toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th transport
@@ -115,23 +130,24 @@
         !path = H2.promiseRequestPath pp
         !siz = case H2.responseBodySize $ H2.promiseResponse pp of
             Nothing -> 0
-            Just s  -> fromIntegral s
+            Just s -> fromIntegral s
 
-wrappedRecvN :: T.Handle -> IORef Bool -> Int -> (BufSize -> IO ByteString) -> (BufSize -> IO ByteString)
-wrappedRecvN th istatus slowlorisSize readN bufsize = do
-    bs <-  UnliftIO.handleAny handler $ readN bufsize
-    unless (BS.null bs) $ do
-        writeIORef istatus True
+wrappedRecvN
+    :: T.Handle -> Int -> (BufSize -> IO ByteString) -> (BufSize -> IO ByteString)
+wrappedRecvN th slowlorisSize readN bufsize = do
+    bs <- E.handle handler $ readN bufsize
     -- TODO: think about the slowloris protection in HTTP2: current code
     -- might open a slow-loris attack vector. Rather than timing we should
     -- consider limiting the per-client connections assuming that in HTTP2
     -- we should allow only few connections per host (real-world
     -- deployments with large NATs may be trickier).
-        when (BS.length bs >= slowlorisSize || bufsize <= slowlorisSize) $ T.tickle th
+    when
+        (BS.length bs > 0 && BS.length bs >= slowlorisSize || bufsize <= slowlorisSize)
+        $ T.tickle th
     return bs
- where
-   handler :: UnliftIO.SomeException -> IO ByteString
-   handler _ = return ""
+  where
+    handler :: E.SomeException -> IO ByteString
+    handler = throughAsync (return "")
 
 -- connClose must not be called here since Run:fork calls it
 goaway :: Connection -> H2.ErrorCodeId -> ByteString -> IO ()
diff --git a/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs b/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs
--- a/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs
@@ -3,7 +3,7 @@
 
 module Network.Wai.Handler.Warp.HTTP2.PushPromise where
 
-import qualified UnliftIO
+import qualified Control.Exception as E
 import qualified Network.HTTP.Types as H
 import qualified Network.HTTP2.Server as H2
 
@@ -17,19 +17,17 @@
 fromPushPromises :: InternalInfo -> Request -> IO [H2.PushPromise]
 fromPushPromises ii req = do
     mh2data <- getHTTP2Data req
-    let pp = case mh2data of
-          Nothing     -> []
-          Just h2data -> http2dataPushPromise h2data
+    let pp = maybe [] http2dataPushPromise mh2data
     catMaybes <$> mapM (fromPushPromise ii) pp
 
 fromPushPromise :: InternalInfo -> PushPromise -> IO (Maybe H2.PushPromise)
 fromPushPromise ii (PushPromise path file rsphdr w) = do
-    efinfo <- UnliftIO.tryIO $ getFileInfo ii file
+    efinfo <- E.try $ getFileInfo ii file
     case efinfo of
-      Left (_ex :: UnliftIO.IOException) -> return Nothing
-      Right finfo -> do
-          let !siz = fromIntegral $ fileInfoSize finfo
-              !fileSpec = H2.FileSpec file 0 siz
-              !rsp = H2.responseFile H.ok200 rsphdr fileSpec
-              !pp = H2.pushPromise path rsp w
-          return $ Just pp
+        Left (_ex :: E.IOException) -> return Nothing
+        Right finfo -> do
+            let !siz = fromIntegral $ fileInfoSize finfo
+                !fileSpec = H2.FileSpec file 0 siz
+                !rsp = H2.responseFile H.ok200 rsphdr fileSpec
+                !pp = H2.pushPromise path rsp w
+            return $ Just pp
diff --git a/Network/Wai/Handler/Warp/HTTP2/Request.hs b/Network/Wai/Handler/Warp/HTTP2/Request.hs
--- a/Network/Wai/Handler/Warp/HTTP2/Request.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/Request.hs
@@ -2,11 +2,11 @@
 {-# LANGUAGE CPP #-}
 
 module Network.Wai.Handler.Warp.HTTP2.Request (
-    toRequest
-  , getHTTP2Data
-  , setHTTP2Data
-  , modifyHTTP2Data
-  ) where
+    toRequest,
+    getHTTP2Data,
+    setHTTP2Data,
+    modifyHTTP2Data,
+) where
 
 import Control.Arrow (first)
 import qualified Data.ByteString.Char8 as C8
@@ -17,7 +17,6 @@
 import qualified Network.HTTP.Types as H
 import Network.Socket (SockAddr)
 import Network.Wai
-import Network.Wai.Internal (Request(..))
 import System.IO.Unsafe (unsafePerformIO)
 import qualified System.TimeManager as T
 
@@ -27,10 +26,19 @@
 #ifdef MIN_VERSION_crypton_x509
 import Network.Wai.Handler.Warp.Request (getClientCertificateKey)
 #endif
-import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath)
+import qualified Network.Wai.Handler.Warp.Settings as S (
+    Settings,
+    settingsNoParsePath,
+ )
 import Network.Wai.Handler.Warp.Types
 
-type ToReq = (TokenHeaderList,ValueTable) -> Maybe Int -> IO ByteString -> T.Handle -> Transport -> IO Request
+type ToReq =
+    (TokenHeaderList, ValueTable)
+    -> Maybe Int
+    -> IO ByteString
+    -> T.Handle
+    -> Transport
+    -> IO Request
 
 ----------------------------------------------------------------
 
@@ -42,36 +50,41 @@
     ref <- newIORef Nothing
     toRequest' ii settings addr ref ht bodylen body th transport
 
-toRequest' :: InternalInfo -> S.Settings -> SockAddr
-           -> IORef (Maybe HTTP2Data)
-           -> ToReq
-toRequest' ii settings addr ref (reqths,reqvt) bodylen body th transport = return req
+toRequest'
+    :: InternalInfo
+    -> S.Settings
+    -> SockAddr
+    -> IORef (Maybe HTTP2Data)
+    -> ToReq
+toRequest' ii settings addr ref (reqths, reqvt) bodylen body th transport =
+    -- setting 'requestBody' with 'setRequestBodyChunks' to  avoid warnings
+    return $! setRequestBodyChunks body req
   where
-    !req = Request {
-        requestMethod = colonMethod
-      , httpVersion = if isTransportQUIC transport then http30 else H.http20
-      , rawPathInfo = rawPath
-      , pathInfo = H.decodePathSegments path
-      , rawQueryString = query
-      , queryString = H.parseQuery query
-      , requestHeaders = headers
-      , isSecure = isTransportSecure transport
-      , remoteHost = addr
-      , requestBody = body
-      , vault = vaultValue
-      , requestBodyLength = maybe ChunkedBody (KnownLength . fromIntegral) bodylen
-      , requestHeaderHost      = mHost <|> mAuth
-      , requestHeaderRange     = mRange
-      , requestHeaderReferer   = mReferer
-      , requestHeaderUserAgent = mUserAgent
-      }
+    !req =
+        defaultRequest
+            { requestMethod = colonMethod
+            , httpVersion = if isTransportQUIC transport then http30 else H.http20
+            , rawPathInfo = rawPath
+            , pathInfo = H.decodePathSegments path
+            , rawQueryString = query
+            , queryString = H.parseQuery query
+            , requestHeaders = headers
+            , isSecure = isTransportSecure transport
+            , remoteHost = addr
+            , vault = vaultValue
+            , requestBodyLength = maybe ChunkedBody (KnownLength . fromIntegral) bodylen
+            , requestHeaderHost = mHost <|> mAuth
+            , requestHeaderRange = mRange
+            , requestHeaderReferer = mReferer
+            , requestHeaderUserAgent = mUserAgent
+            }
     headers = map (first tokenKey) ths
       where
         ths = case mHost of
-            Just _  -> reqths
+            Just _ -> reqths
             Nothing -> case mAuth of
-              Just auth -> (tokenHost, auth) : reqths
-              _         -> reqths
+                Just auth -> (tokenHost, auth) : reqths
+                _ -> reqths
     !mPath = getHeaderValue tokenPath reqvt -- SHOULD
     !colonMethod = fromJust $ getHeaderValue tokenMethod reqvt -- MUST
     !mAuth = getHeaderValue tokenAuthority reqvt -- SHOULD
@@ -81,19 +94,20 @@
     !mUserAgent = getHeaderValue tokenUserAgent reqvt
     -- CONNECT request will have ":path" omitted, use ":authority" as unparsed
     -- path instead so that it will have consistent behavior compare to HTTP 1.0
-    (unparsedPath,query) = C8.break (=='?') $ fromJust (mPath <|> mAuth)
+    (unparsedPath, query) = C8.break (== '?') $ fromJust (mPath <|> mAuth)
     !path = H.extractPath unparsedPath
     !rawPath = if S.settingsNoParsePath settings then unparsedPath else path
     -- fixme: pauseTimeout. th is not available here.
-    !vaultValue = Vault.insert getFileInfoKey (getFileInfo ii)
-                $ Vault.insert getHTTP2DataKey (readIORef ref)
-                $ Vault.insert setHTTP2DataKey (writeIORef ref)
-                $ Vault.insert modifyHTTP2DataKey (modifyIORef' ref)
-                $ Vault.insert pauseTimeoutKey (T.pause th)
+    !vaultValue =
+        Vault.insert getFileInfoKey (getFileInfo ii)
+            . Vault.insert getHTTP2DataKey (readIORef ref)
+            . Vault.insert setHTTP2DataKey (writeIORef ref)
+            . Vault.insert modifyHTTP2DataKey (modifyIORef' ref)
+            . Vault.insert pauseTimeoutKey (T.pause th)
 #ifdef MIN_VERSION_crypton_x509
-                $ Vault.insert getClientCertificateKey (getTransportClientCertificate transport)
+            . Vault.insert getClientCertificateKey (getTransportClientCertificate transport)
 #endif
-                  Vault.empty
+            $ Vault.empty
 
 getHTTP2DataKey :: Vault.Key (IO (Maybe HTTP2Data))
 getHTTP2DataKey = unsafePerformIO Vault.newKey
@@ -105,8 +119,8 @@
 --   Since: 3.2.7
 getHTTP2Data :: Request -> IO (Maybe HTTP2Data)
 getHTTP2Data req = case Vault.lookup getHTTP2DataKey (vault req) of
-  Nothing     -> return Nothing
-  Just getter -> getter
+    Nothing -> return Nothing
+    Just getter -> getter
 
 setHTTP2DataKey :: Vault.Key (Maybe HTTP2Data -> IO ())
 setHTTP2DataKey = unsafePerformIO Vault.newKey
@@ -118,8 +132,8 @@
 --   Since: 3.2.7
 setHTTP2Data :: Request -> Maybe HTTP2Data -> IO ()
 setHTTP2Data req mh2d = case Vault.lookup setHTTP2DataKey (vault req) of
-  Nothing     -> return ()
-  Just setter -> setter mh2d
+    Nothing -> return ()
+    Just setter -> setter mh2d
 
 modifyHTTP2DataKey :: Vault.Key ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ())
 modifyHTTP2DataKey = unsafePerformIO Vault.newKey
@@ -131,5 +145,5 @@
 --   Since: 3.2.8
 modifyHTTP2Data :: Request -> (Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ()
 modifyHTTP2Data req func = case Vault.lookup modifyHTTP2DataKey (vault req) of
-  Nothing     -> return ()
-  Just modify -> modify func
+    Nothing -> return ()
+    Just modify -> modify func
diff --git a/Network/Wai/Handler/Warp/HTTP2/Response.hs b/Network/Wai/Handler/Warp/HTTP2/Response.hs
--- a/Network/Wai/Handler/Warp/HTTP2/Response.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/Response.hs
@@ -1,50 +1,55 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Network.Wai.Handler.Warp.HTTP2.Response (
-    fromResponse
-  ) where
+    fromResponse,
+) where
 
+import qualified Control.Exception as E
 import qualified Data.ByteString.Builder as BB
 import qualified Data.List as L (find)
 import qualified Network.HTTP.Types as H
 import qualified Network.HTTP2.Server as H2
-import Network.Wai hiding (responseFile, responseBuilder, responseStream)
-import Network.Wai.Internal (Response(..))
-import qualified UnliftIO
+import Network.Wai hiding (responseBuilder, responseFile, responseStream)
+import Network.Wai.Internal (Response (..))
 
 import Network.Wai.Handler.Warp.File
-import Network.Wai.Handler.Warp.Header
 import Network.Wai.Handler.Warp.HTTP2.Request (getHTTP2Data)
 import Network.Wai.Handler.Warp.HTTP2.Types
+import Network.Wai.Handler.Warp.Header
 import qualified Network.Wai.Handler.Warp.Response as R
 import qualified Network.Wai.Handler.Warp.Settings as S
 import Network.Wai.Handler.Warp.Types
 
 ----------------------------------------------------------------
 
-fromResponse :: S.Settings -> InternalInfo -> Request -> Response -> IO (H2.Response, H.Status, Bool)
+fromResponse
+    :: S.Settings
+    -> InternalInfo
+    -> Request
+    -> Response
+    -> IO (H2.Response, H.Status, Bool)
 fromResponse settings ii req rsp = do
     date <- getDate ii
     rspst@(h2rsp, st, hasBody) <- case rsp of
-      ResponseFile    st rsphdr path mpart -> do
-          let rsphdr' = add date rsphdr
-          responseFile    st rsphdr' method path mpart ii reqhdr
-      ResponseBuilder st rsphdr builder -> do
-          let rsphdr' = add date rsphdr
-          return $ responseBuilder st rsphdr' method builder
-      ResponseStream  st rsphdr strmbdy -> do
-          let rsphdr' = add date rsphdr
-          return $ responseStream  st rsphdr' method strmbdy
-      _ -> error "ResponseRaw is not supported in HTTP/2"
+        ResponseFile st rsphdr path mpart -> do
+            let rsphdr' = add date rsphdr
+            responseFile st rsphdr' method path mpart ii reqhdr
+        ResponseBuilder st rsphdr builder -> do
+            let rsphdr' = add date rsphdr
+            return $ responseBuilder st rsphdr' method builder
+        ResponseStream st rsphdr strmbdy -> do
+            let rsphdr' = add date rsphdr
+            return $ responseStream st rsphdr' method strmbdy
+        _ -> error "ResponseRaw is not supported in HTTP/2"
     mh2data <- getHTTP2Data req
     case mh2data of
-      Nothing     -> return rspst
-      Just h2data -> do
-          let !trailers = http2dataTrailers h2data
-              !h2rsp' = H2.setResponseTrailersMaker h2rsp trailers
-          return (h2rsp', st, hasBody)
+        Nothing -> return rspst
+        Just h2data -> do
+            let !trailers = http2dataTrailers h2data
+                !h2rsp' = H2.setResponseTrailersMaker h2rsp trailers
+            return (h2rsp', st, hasBody)
   where
     !method = requestMethod req
     !reqhdr = requestHeaders req
@@ -53,63 +58,78 @@
         let hasServerHdr = L.find ((== H.hServer) . fst) rsphdr
             addSVR =
                 maybe ((H.hServer, server) :) (const id) hasServerHdr
-        in R.addAltSvc settings $
-            (H.hDate, date) : addSVR rsphdr
+         in R.addAltSvc settings $
+                (H.hDate, date) : addSVR rsphdr
 
 ----------------------------------------------------------------
 
-responseFile :: H.Status -> H.ResponseHeaders -> H.Method
-             -> FilePath -> Maybe FilePart -> InternalInfo -> H.RequestHeaders
-             -> IO (H2.Response, H.Status, Bool)
+responseFile
+    :: H.Status
+    -> H.ResponseHeaders
+    -> H.Method
+    -> FilePath
+    -> Maybe FilePart
+    -> InternalInfo
+    -> H.RequestHeaders
+    -> IO (H2.Response, H.Status, Bool)
 responseFile st rsphdr _ _ _ _ _
-  | noBody st = return $ responseNoBody st rsphdr
-
+    | noBody st = return $ responseNoBody st rsphdr
 responseFile st rsphdr method path (Just fp) _ _ =
     return $ responseFile2XX st rsphdr method fileSpec
   where
-    !off'   = fromIntegral $ filePartOffset fp
+    !off' = fromIntegral $ filePartOffset fp
     !bytes' = fromIntegral $ filePartByteCount fp
     !fileSpec = H2.FileSpec path off' bytes'
-
 responseFile _ rsphdr method path Nothing ii reqhdr = do
-    efinfo <- UnliftIO.tryIO $ getFileInfo ii path
+    efinfo <- E.try $ getFileInfo ii path
     case efinfo of
-        Left (_ex :: UnliftIO.IOException) -> return $ response404 rsphdr
+        Left (_ex :: E.IOException) -> return $ response404 rsphdr
         Right finfo -> do
             let reqidx = indexRequestHeader reqhdr
                 rspidx = indexResponseHeader rsphdr
             case conditionalRequest finfo rsphdr method rspidx reqidx of
-                WithoutBody s                -> return $ responseNoBody s rsphdr
+                WithoutBody s -> return $ responseNoBody s rsphdr
                 WithBody s rsphdr' off bytes -> do
-                    let !off'   = fromIntegral off
+                    let !off' = fromIntegral off
                         !bytes' = fromIntegral bytes
                         !fileSpec = H2.FileSpec path off' bytes'
                     return $ responseFile2XX s rsphdr' method fileSpec
 
 ----------------------------------------------------------------
 
-responseFile2XX :: H.Status -> H.ResponseHeaders -> H.Method -> H2.FileSpec -> (H2.Response, H.Status, Bool)
+responseFile2XX
+    :: H.Status
+    -> H.ResponseHeaders
+    -> H.Method
+    -> H2.FileSpec
+    -> (H2.Response, H.Status, Bool)
 responseFile2XX st rsphdr method fileSpec
-  | method == H.methodHead = responseNoBody st rsphdr
-  | otherwise = (H2.responseFile st rsphdr fileSpec, st, True)
+    | method == H.methodHead = responseNoBody st rsphdr
+    | otherwise = (H2.responseFile st rsphdr fileSpec, st, True)
 
 ----------------------------------------------------------------
 
-responseBuilder :: H.Status -> H.ResponseHeaders -> H.Method
-                -> BB.Builder
-                -> (H2.Response, H.Status, Bool)
+responseBuilder
+    :: H.Status
+    -> H.ResponseHeaders
+    -> H.Method
+    -> BB.Builder
+    -> (H2.Response, H.Status, Bool)
 responseBuilder st rsphdr method builder
-  | method == H.methodHead || noBody st = responseNoBody st rsphdr
-  | otherwise = (H2.responseBuilder st rsphdr builder, st, True)
+    | method == H.methodHead || noBody st = responseNoBody st rsphdr
+    | otherwise = (H2.responseBuilder st rsphdr builder, st, True)
 
 ----------------------------------------------------------------
 
-responseStream :: H.Status -> H.ResponseHeaders -> H.Method
-               -> StreamingBody
-               -> (H2.Response, H.Status, Bool)
+responseStream
+    :: H.Status
+    -> H.ResponseHeaders
+    -> H.Method
+    -> StreamingBody
+    -> (H2.Response, H.Status, Bool)
 responseStream st rsphdr method strmbdy
-  | method == H.methodHead || noBody st = responseNoBody st rsphdr
-  | otherwise = (H2.responseStreaming st rsphdr strmbdy, st, True)
+    | method == H.methodHead || noBody st = responseNoBody st rsphdr
+    | otherwise = (H2.responseStreaming st rsphdr strmbdy, st, True)
 
 ----------------------------------------------------------------
 
diff --git a/Network/Wai/Handler/Warp/HTTP2/Types.hs b/Network/Wai/Handler/Warp/HTTP2/Types.hs
--- a/Network/Wai/Handler/Warp/HTTP2/Types.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/Types.hs
@@ -18,7 +18,7 @@
 isHTTP2 tls = useHTTP2
   where
     useHTTP2 = case tlsNegotiatedProtocol tls of
-        Nothing    -> False
+        Nothing -> False
         Just proto -> "h2" `BS.isPrefixOf` proto
 
 ----------------------------------------------------------------
@@ -26,15 +26,15 @@
 -- | HTTP/2 specific data.
 --
 --   Since: 3.2.7
-data HTTP2Data = HTTP2Data {
-    -- | Accessor for 'PushPromise' in 'HTTP2Data'.
+data HTTP2Data = HTTP2Data
+    { http2dataPushPromise :: [PushPromise]
+    -- ^ Accessor for 'PushPromise' in 'HTTP2Data'.
     --
     --   Since: 3.2.7
-      http2dataPushPromise :: [PushPromise]
-    -- | Accessor for 'H2.TrailersMaker' in 'HTTP2Data'.
+    , http2dataTrailers :: H2.TrailersMaker
+    -- ^ Accessor for 'H2.TrailersMaker' in 'HTTP2Data'.
     --
     --   Since: 3.2.8 but the type changed in 3.3.0
-    , http2dataTrailers :: H2.TrailersMaker
     }
 
 -- | Default HTTP/2 specific data.
@@ -48,30 +48,31 @@
 --   while the HTTP/2 library supports other types.
 --
 --   Since: 3.2.7
-data PushPromise = PushPromise {
-    -- | Accessor for a URL path in 'PushPromise'.
+data PushPromise = PushPromise
+    { promisedPath :: ByteString
+    -- ^ Accessor for a URL path in 'PushPromise'.
     --   E.g. \"\/style\/default.css\".
     --
     --   Since: 3.2.7
-      promisedPath            :: ByteString
-    -- | Accessor for 'FilePath' in 'PushPromise'.
+    , promisedFile :: FilePath
+    -- ^ Accessor for 'FilePath' in 'PushPromise'.
     --   E.g. \"FILE_PATH/default.css\".
     --
     --   Since: 3.2.7
-    , promisedFile            :: FilePath
-    -- | Accessor for 'H.ResponseHeaders' in 'PushPromise'
+    , promisedResponseHeaders :: H.ResponseHeaders
+    -- ^ Accessor for 'H.ResponseHeaders' in 'PushPromise'
     --   \"content-type\" must be specified.
     --   Default value: [].
     --
     --
     --   Since: 3.2.7
-    , promisedResponseHeaders :: H.ResponseHeaders
-    -- | Accessor for 'Weight' in 'PushPromise'.
+    , promisedWeight :: Weight
+    -- ^ Accessor for 'Weight' in 'PushPromise'.
     --    Default value: 16.
     --
     --   Since: 3.2.7
-    , promisedWeight          :: Weight
-    } deriving (Eq,Ord,Show)
+    }
+    deriving (Eq, Ord, Show)
 
 -- | Default push promise.
 --
diff --git a/Network/Wai/Handler/Warp/HashMap.hs b/Network/Wai/Handler/Warp/HashMap.hs
--- a/Network/Wai/Handler/Warp/HashMap.hs
+++ b/Network/Wai/Handler/Warp/HashMap.hs
@@ -28,8 +28,9 @@
 ----------------------------------------------------------------
 
 insert :: FilePath -> v -> HashMap v -> HashMap v
-insert path v (HashMap hm) = HashMap
-  $ I.insertWith M.union (hash path) (M.singleton path v) hm
+insert path v (HashMap hm) =
+    HashMap $
+        I.insertWith M.union (hash path) (M.singleton path v) hm
 
 lookup :: FilePath -> HashMap v -> Maybe v
 lookup path (HashMap hm) = I.lookup (hash path) hm >>= M.lookup path
diff --git a/Network/Wai/Handler/Warp/Header.hs b/Network/Wai/Handler/Warp/Header.hs
--- a/Network/Wai/Handler/Warp/Header.hs
+++ b/Network/Wai/Handler/Warp/Header.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.Header where
 
@@ -20,20 +21,21 @@
 indexRequestHeader :: RequestHeaders -> IndexedHeader
 indexRequestHeader hdr = traverseHeader hdr requestMaxIndex requestKeyIndex
 
-data RequestHeaderIndex = ReqContentLength
-                        | ReqTransferEncoding
-                        | ReqExpect
-                        | ReqConnection
-                        | ReqRange
-                        | ReqHost
-                        | ReqIfModifiedSince
-                        | ReqIfUnmodifiedSince
-                        | ReqIfRange
-                        | ReqReferer
-                        | ReqUserAgent
-                        | ReqIfMatch
-                        | ReqIfNoneMatch
-                        deriving (Enum,Bounded)
+data RequestHeaderIndex
+    = ReqContentLength
+    | ReqTransferEncoding
+    | ReqExpect
+    | ReqConnection
+    | ReqRange
+    | ReqHost
+    | ReqIfModifiedSince
+    | ReqIfUnmodifiedSince
+    | ReqIfRange
+    | ReqReferer
+    | ReqUserAgent
+    | ReqIfMatch
+    | ReqIfNoneMatch
+    deriving (Enum, Bounded)
 
 -- | The size for 'IndexedHeader' for HTTP Request.
 --   From 0 to this corresponds to:
@@ -56,36 +58,40 @@
 
 requestKeyIndex :: HeaderName -> Int
 requestKeyIndex hn = case BS.length bs of
-   4  | bs == "host" -> fromEnum ReqHost
-   5  | bs == "range" -> fromEnum ReqRange
-   6  | bs == "expect" -> fromEnum ReqExpect
-   7  | bs == "referer" -> fromEnum ReqReferer
-   8  | bs == "if-range" -> fromEnum ReqIfRange
-      | bs == "if-match" -> fromEnum ReqIfMatch
-   10 | bs == "user-agent" -> fromEnum ReqUserAgent
-      | bs == "connection" -> fromEnum ReqConnection
-   13 | bs == "if-none-match" -> fromEnum ReqIfNoneMatch
-   14 | bs == "content-length" -> fromEnum ReqContentLength
-   17 | bs == "transfer-encoding" -> fromEnum ReqTransferEncoding
-      | bs == "if-modified-since" -> fromEnum ReqIfModifiedSince
-   19 | bs == "if-unmodified-since" -> fromEnum ReqIfUnmodifiedSince
-   _  -> -1
+    4 | bs == "host" -> fromEnum ReqHost
+    5 | bs == "range" -> fromEnum ReqRange
+    6 | bs == "expect" -> fromEnum ReqExpect
+    7 | bs == "referer" -> fromEnum ReqReferer
+    8
+        | bs == "if-range" -> fromEnum ReqIfRange
+        | bs == "if-match" -> fromEnum ReqIfMatch
+    10
+        | bs == "user-agent" -> fromEnum ReqUserAgent
+        | bs == "connection" -> fromEnum ReqConnection
+    13 | bs == "if-none-match" -> fromEnum ReqIfNoneMatch
+    14 | bs == "content-length" -> fromEnum ReqContentLength
+    17
+        | bs == "transfer-encoding" -> fromEnum ReqTransferEncoding
+        | bs == "if-modified-since" -> fromEnum ReqIfModifiedSince
+    19 | bs == "if-unmodified-since" -> fromEnum ReqIfUnmodifiedSince
+    _ -> -1
   where
     bs = foldedCase hn
 
 defaultIndexRequestHeader :: IndexedHeader
-defaultIndexRequestHeader = array (0, requestMaxIndex) [(i, Nothing) | i <- [0..requestMaxIndex]]
+defaultIndexRequestHeader = array (0, requestMaxIndex) [(i, Nothing) | i <- [0 .. requestMaxIndex]]
 
 ----------------------------------------------------------------
 
 indexResponseHeader :: ResponseHeaders -> IndexedHeader
 indexResponseHeader hdr = traverseHeader hdr responseMaxIndex responseKeyIndex
 
-data ResponseHeaderIndex = ResContentLength
-                         | ResServer
-                         | ResDate
-                         | ResLastModified
-                         deriving (Enum,Bounded)
+data ResponseHeaderIndex
+    = ResContentLength
+    | ResServer
+    | ResDate
+    | ResLastModified
+    deriving (Enum, Bounded)
 
 -- | The size for 'IndexedHeader' for HTTP Response.
 responseMaxIndex :: Int
@@ -93,11 +99,11 @@
 
 responseKeyIndex :: HeaderName -> Int
 responseKeyIndex hn = case BS.length bs of
-    4  | bs == "date" -> fromEnum ResDate
-    6  | bs == "server" -> fromEnum ResServer
+    4 | bs == "date" -> fromEnum ResDate
+    6 | bs == "server" -> fromEnum ResServer
     13 | bs == "last-modified" -> fromEnum ResLastModified
     14 | bs == "content-length" -> fromEnum ResContentLength
-    _  -> -1
+    _ -> -1
   where
     bs = foldedCase hn
 
@@ -105,12 +111,12 @@
 
 traverseHeader :: [Header] -> Int -> (HeaderName -> Int) -> IndexedHeader
 traverseHeader hdr maxidx getIndex = runSTArray $ do
-    arr <- newArray (0,maxidx) Nothing
+    arr <- newArray (0, maxidx) Nothing
     mapM_ (insert arr) hdr
     return arr
   where
-    insert arr (key,val)
-      | idx == -1 = return ()
-      | otherwise = writeArray arr idx (Just val)
+    insert arr (key, val)
+        | idx == -1 = return ()
+        | otherwise = writeArray arr idx (Just val)
       where
         idx = getIndex key
diff --git a/Network/Wai/Handler/Warp/IO.hs b/Network/Wai/Handler/Warp/IO.hs
--- a/Network/Wai/Handler/Warp/IO.hs
+++ b/Network/Wai/Handler/Warp/IO.hs
@@ -8,39 +8,43 @@
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.Types
 
-toBufIOWith :: Int -> IORef WriteBuffer -> (ByteString -> IO ()) -> Builder -> IO Integer
+toBufIOWith
+    :: Int -> IORef WriteBuffer -> (ByteString -> IO ()) -> Builder -> IO Integer
 toBufIOWith maxRspBufSize writeBufferRef io builder = do
-  writeBuffer <- readIORef writeBufferRef
-  loop writeBuffer firstWriter 0
+    writeBuffer <- readIORef writeBufferRef
+    loop writeBuffer firstWriter 0
   where
     firstWriter = runBuilder builder
     loop writeBuffer writer bytesSent = do
-      let buf = bufBuffer writeBuffer
-          size = bufSize writeBuffer
-      (len, signal) <- writer buf size
-      bufferIO buf len io
-      let totalBytesSent = toInteger len + bytesSent
-      case signal of
-        Done -> return totalBytesSent
-        More minSize next
-          | size < minSize -> do
-              when (minSize > maxRspBufSize) $
-                error $ "Sending a Builder response required a buffer of size "
-                          ++ show minSize ++ " which is bigger than the specified maximum of "
-                          ++ show maxRspBufSize ++ "!"
-              -- The current WriteBuffer is too small to fit the next
-              -- batch of bytes from the Builder so we free it and
-              -- create a new bigger one. Freeing the current buffer,
-              -- creating a new one and writing it to the IORef need
-              -- to be performed atomically to prevent both double
-              -- frees and missed frees. So we mask async exceptions:
-              biggerWriteBuffer <- mask_ $ do
-                bufFree writeBuffer
-                biggerWriteBuffer <- createWriteBuffer minSize
-                writeIORef writeBufferRef biggerWriteBuffer
-                return biggerWriteBuffer
-              loop biggerWriteBuffer next totalBytesSent
-          | otherwise -> loop writeBuffer next totalBytesSent
-        Chunk bs next -> do
-          io bs
-          loop writeBuffer next totalBytesSent
+        let buf = bufBuffer writeBuffer
+            size = bufSize writeBuffer
+        (len, signal) <- writer buf size
+        bufferIO buf len io
+        let totalBytesSent = toInteger len + bytesSent
+        case signal of
+            Done -> return totalBytesSent
+            More minSize next
+                | size < minSize -> do
+                    when (minSize > maxRspBufSize) $
+                        error $
+                            "Sending a Builder response required a buffer of size "
+                                ++ show minSize
+                                ++ " which is bigger than the specified maximum of "
+                                ++ show maxRspBufSize
+                                ++ "!"
+                    -- The current WriteBuffer is too small to fit the next
+                    -- batch of bytes from the Builder so we free it and
+                    -- create a new bigger one. Freeing the current buffer,
+                    -- creating a new one and writing it to the IORef need
+                    -- to be performed atomically to prevent both double
+                    -- frees and missed frees. So we mask async exceptions:
+                    biggerWriteBuffer <- mask_ $ do
+                        bufFree writeBuffer
+                        biggerWriteBuffer <- createWriteBuffer minSize
+                        writeIORef writeBufferRef biggerWriteBuffer
+                        return biggerWriteBuffer
+                    loop biggerWriteBuffer next totalBytesSent
+                | otherwise -> loop writeBuffer next totalBytesSent
+            Chunk bs next -> do
+                io bs
+                loop writeBuffer next totalBytesSent
diff --git a/Network/Wai/Handler/Warp/Imports.hs b/Network/Wai/Handler/Warp/Imports.hs
--- a/Network/Wai/Handler/Warp/Imports.hs
+++ b/Network/Wai/Handler/Warp/Imports.hs
@@ -1,25 +1,39 @@
 module Network.Wai.Handler.Warp.Imports (
-    ByteString(..)
-  , NonEmpty(..)
-  , module Control.Applicative
-  , module Control.Monad
-  , module Data.Bits
-  , module Data.Int
-  , module Data.Monoid
-  , module Data.Ord
-  , module Data.Word
-  , module Data.Maybe
-  , module Numeric
-  ) where
+    ByteString (..),
+    NonEmpty (..),
+    module Control.Applicative,
+    module Control.Monad,
+    module Data.Bits,
+    module Data.Int,
+    module Data.Monoid,
+    module Data.Ord,
+    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(..))
+import Data.ByteString.Internal (ByteString (..))
 import Data.Int
-import Data.List.NonEmpty (NonEmpty(..))
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe
 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
diff --git a/Network/Wai/Handler/Warp/Internal.hs b/Network/Wai/Handler/Warp/Internal.hs
--- a/Network/Wai/Handler/Warp/Internal.hs
+++ b/Network/Wai/Handler/Warp/Internal.hs
@@ -1,41 +1,71 @@
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
+-- |
+-- __IMPORTANT NOTICE__
+--
+-- This module exports internals mainly to provide the @warp-tls@ package
+-- with tools to implement what it needs to. This module\/API should /NOT/ be
+-- expected to remain stable at all, even between minor releases.
+--
+-- If you see a use case for these functions or types for other purposes,
+-- please create an issue in the repository so that we might add it to the
+-- main 'Network.Wai.Handler.Warp' API.
 module Network.Wai.Handler.Warp.Internal (
     -- * Settings
-    Settings (..)
-  , ProxyProtocol(..)
+    Settings (..),
+    ProxyProtocol (..),
+    makeSettingsAndCounter,
+    makeSettingsAndServerState,
+
+    -- ** Connection counter
+    Counter,
+    getCount,
+
+    -- ** Server state
+    ServerState,
+    makeServerState,
+
     -- * Low level run functions
-  , runSettingsConnection
-  , runSettingsConnectionMaker
-  , runSettingsConnectionMakerSecure
-  , Transport (..)
+    runSettingsConnection,
+    runSettingsConnectionMaker,
+    runSettingsConnectionMakerSecure,
+    Transport (..),
+
     -- * Connection
-  , Connection (..)
-  , socketConnection
+    Connection (..),
+    socketConnection,
+
     -- ** Receive
-  , Recv
-  , RecvBuf
+    Recv,
+    makeGracefulRecv,
+    RecvBuf,
+
     -- ** Buffer
-  , Buffer
-  , BufSize
-  , WriteBuffer(..)
-  , createWriteBuffer
-  , allocateBuffer
-  , freeBuffer
-  , copy
+    Buffer,
+    BufSize,
+    WriteBuffer (..),
+    createWriteBuffer,
+    allocateBuffer,
+    freeBuffer,
+    copy,
+
     -- ** Sendfile
-  , FileId (..)
-  , SendFile
-  , sendFile
-  , readSendFile
+    FileId (..),
+    SendFile,
+    sendFile,
+    readSendFile,
+
     -- * Version
-  , warpVersion
+    warpVersion,
+
     -- * Data types
-  , InternalInfo (..)
-  , HeaderValue
-  , IndexedHeader
-  , requestMaxIndex
+    InternalInfo (..),
+    HeaderValue,
+    IndexedHeader,
+    requestMaxIndex,
+
     -- * Time out manager
+
     -- |
     --
     -- In order to provide slowloris protection, Warp provides timeout handlers. We
@@ -53,30 +83,39 @@
     --   resumed as soon as we return from user code.
     --
     -- * Every time data is successfully sent to the client, the timeout is tickled.
-  , module System.TimeManager
+    module System.TimeManager,
+
     -- * File descriptor cache
-  , module Network.Wai.Handler.Warp.FdCache
+    module Network.Wai.Handler.Warp.FdCache,
+
     -- * File information cache
-  , module Network.Wai.Handler.Warp.FileInfoCache
+    module Network.Wai.Handler.Warp.FileInfoCache,
+
     -- * Date
-  , module Network.Wai.Handler.Warp.Date
+    module Network.Wai.Handler.Warp.Date,
+
     -- * Request and response
-  , Source
-  , recvRequest
-  , sendResponse
+    Source,
+    FirstRequest (..),
+    recvRequest,
+    sendResponse,
+
     -- * Platform dependent helper functions
-  , setSocketCloseOnExec
-  , windowsThreadBlockHack
+    setSocketCloseOnExec,
+    windowsThreadBlockHack,
+
     -- * Misc
-  , http2server
-  , withII
-  , pReadMaker
-  ) where
+    http2server,
+    withII,
+    serveConnection,
+    pReadMaker,
+) where
 
 import Network.Socket.BufferPool
 import System.TimeManager
 
 import Network.Wai.Handler.Warp.Buffer
+import Network.Wai.Handler.Warp.Counter (Counter, getCount)
 import Network.Wai.Handler.Warp.Date
 import Network.Wai.Handler.Warp.FdCache
 import Network.Wai.Handler.Warp.FileInfoCache
diff --git a/Network/Wai/Handler/Warp/MultiMap.hs b/Network/Wai/Handler/Warp/MultiMap.hs
--- a/Network/Wai/Handler/Warp/MultiMap.hs
+++ b/Network/Wai/Handler/Warp/MultiMap.hs
@@ -1,14 +1,14 @@
 module Network.Wai.Handler.Warp.MultiMap (
-    MultiMap
-  , isEmpty
-  , empty
-  , singleton
-  , insert
-  , Network.Wai.Handler.Warp.MultiMap.lookup
-  , pruneWith
-  , toList
-  , merge
-  ) where
+    MultiMap,
+    isEmpty,
+    empty,
+    singleton,
+    insert,
+    Network.Wai.Handler.Warp.MultiMap.lookup,
+    pruneWith,
+    toList,
+    merge,
+) where
 
 import Control.Monad (filterM)
 import Data.Hashable (hash)
@@ -28,7 +28,7 @@
 --   Because only positive entries are stored,
 --   Malicious attack cannot cause the inner list to blow up.
 --   So, lists are good enough.
-newtype MultiMap v = MultiMap (IntMap [(FilePath,v)])
+newtype MultiMap v = MultiMap (IntMap [(FilePath, v)])
 
 ----------------------------------------------------------------
 
@@ -44,7 +44,7 @@
 
 -- | O(1)
 singleton :: FilePath -> v -> MultiMap v
-singleton path v = MultiMap $ I.singleton (hash path) [(path,v)]
+singleton path v = MultiMap $ I.singleton (hash path) [(path, v)]
 
 ----------------------------------------------------------------
 
@@ -52,35 +52,37 @@
 lookup :: FilePath -> MultiMap v -> Maybe v
 lookup path (MultiMap mm) = case I.lookup (hash path) mm of
     Nothing -> Nothing
-    Just s  -> Prelude.lookup path s
+    Just s -> Prelude.lookup path s
 
 ----------------------------------------------------------------
 
 -- | O(log n)
 insert :: FilePath -> v -> MultiMap v -> MultiMap v
-insert path v (MultiMap mm) = MultiMap
-  $ I.insertWith (<>) (hash path) [(path,v)] mm
+insert path v (MultiMap mm) =
+    MultiMap $
+        I.insertWith (<>) (hash path) [(path, v)] mm
 
 ----------------------------------------------------------------
 
 -- | O(n)
-toList :: MultiMap v -> [(FilePath,v)]
+toList :: MultiMap v -> [(FilePath, v)]
 toList (MultiMap mm) = concatMap snd $ I.toAscList mm
 
 ----------------------------------------------------------------
 
 -- | O(n)
-pruneWith :: MultiMap v
-          -> ((FilePath,v) -> IO Bool)
-          -> IO (MultiMap v)
-pruneWith (MultiMap mm) action
-  = I.foldrWithKey go (pure . MultiMap) mm I.empty
+pruneWith
+    :: MultiMap v
+    -> ((FilePath, v) -> IO Bool)
+    -> IO (MultiMap v)
+pruneWith (MultiMap mm) action =
+    I.foldrWithKey go (pure . MultiMap) mm I.empty
   where
     go h s cont acc = do
-      rs <- filterM action s
-      case rs of
-        [] -> cont acc
-        _  -> cont $! I.insert h rs acc
+        rs <- filterM action s
+        case rs of
+            [] -> cont acc
+            _ -> cont $! I.insert h rs acc
 
 ----------------------------------------------------------------
 
diff --git a/Network/Wai/Handler/Warp/PackInt.hs b/Network/Wai/Handler/Warp/PackInt.hs
--- a/Network/Wai/Handler/Warp/PackInt.hs
+++ b/Network/Wai/Handler/Warp/PackInt.hs
@@ -1,23 +1,16 @@
-{-# LANGUAGE OverloadedStrings, BangPatterns #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.PackInt where
 
 import Data.ByteString.Internal (unsafeCreate)
+import Data.Word8 (_0)
 import Foreign.Ptr (Ptr, plusPtr)
 import Foreign.Storable (poke)
 import qualified Network.HTTP.Types as H
 
 import Network.Wai.Handler.Warp.Imports
 
--- $setup
--- >>> import Data.ByteString.Char8 as C8
--- >>> import Test.QuickCheck (Large(..))
-
--- |
---
--- prop> packIntegral (abs n) == C8.pack (show (abs n))
--- prop> \(Large n) -> let n' = fromIntegral (abs n :: Int) in packIntegral n' == C8.pack (show n')
-
 packIntegral :: Integral a => a -> ByteString
 packIntegral 0 = "0"
 packIntegral n | n < 0 = error "packIntegral"
@@ -28,10 +21,9 @@
     go0 p = go n $ p `plusPtr` (len - 1)
     go :: Integral a => a -> Ptr Word8 -> IO ()
     go i p = do
-        let (d,r) = i `divMod` 10
-        poke p (48 + fromIntegral r)
+        let (d, r) = i `divMod` 10
+        poke p (_0 + fromIntegral r)
         when (d /= 0) $ go d (p `plusPtr` (-1))
-
 {-# SPECIALIZE packIntegral :: Int -> ByteString #-}
 {-# SPECIALIZE packIntegral :: Integer -> ByteString #-}
 
@@ -41,16 +33,15 @@
 -- "200"
 -- >>> packStatus H.preconditionFailed412
 -- "412"
-
 packStatus :: H.Status -> ByteString
 packStatus status = unsafeCreate 3 $ \p -> do
-    poke p               (toW8 r2)
+    poke p (toW8 r2)
     poke (p `plusPtr` 1) (toW8 r1)
     poke (p `plusPtr` 2) (toW8 r0)
   where
     toW8 :: Int -> Word8
-    toW8 n = 48 + fromIntegral n
+    toW8 n = _0 + fromIntegral n
     !s = fromIntegral $ H.statusCode status
-    (!q0,!r0) = s `divMod` 10
-    (!q1,!r1) = q0 `divMod` 10
+    (!q0, !r0) = s `divMod` 10
+    (!q1, !r1) = q0 `divMod` 10
     !r2 = q1 `mod` 10
diff --git a/Network/Wai/Handler/Warp/ReadInt.hs b/Network/Wai/Handler/Warp/ReadInt.hs
--- a/Network/Wai/Handler/Warp/ReadInt.hs
+++ b/Network/Wai/Handler/Warp/ReadInt.hs
@@ -1,19 +1,22 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- Copyright     : Erik de Castro Lopo <erikd@mega-nerd.com>
 -- License       : BSD3
 
 module Network.Wai.Handler.Warp.ReadInt (
-    readInt
-  , readInt64
-  ) where
+    readInt,
+    readInt64,
+) where
 
 import qualified Data.ByteString as S
+import Data.Word8 (isDigit, _0)
 
 import Network.Wai.Handler.Warp.Imports hiding (readInt)
 
 {-# INLINE readInt #-}
+
+-- | Will 'takeWhile isDigit' and return the parsed 'Integral'.
 readInt :: Integral a => ByteString -> a
 readInt bs = fromIntegral $ readInt64 bs
 
@@ -27,8 +30,6 @@
 
 {-# NOINLINE readInt64 #-}
 readInt64 :: ByteString -> Int64
-readInt64 bs = S.foldl' (\ !i !c -> i * 10 + fromIntegral (c - 48)) 0
-             $ S.takeWhile isDigit bs
-
-isDigit :: Word8 -> Bool
-isDigit w = w >= 48 && w <= 57
+readInt64 bs =
+    S.foldl' (\ !i !c -> i * 10 + fromIntegral (c - _0)) 0 $
+        S.takeWhile isDigit bs
diff --git a/Network/Wai/Handler/Warp/Request.hs b/Network/Wai/Handler/Warp/Request.hs
--- a/Network/Wai/Handler/Warp/Request.hs
+++ b/Network/Wai/Handler/Warp/Request.hs
@@ -1,40 +1,39 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
 module Network.Wai.Handler.Warp.Request (
-    recvRequest
-  , headerLines
-  , pauseTimeoutKey
-  , getFileInfoKey
+    FirstRequest(..),
+    recvRequest,
+    headerLines,
+    pauseTimeoutKey,
+    getFileInfoKey,
 #ifdef MIN_VERSION_crypton_x509
-  , getClientCertificateKey
+    getClientCertificateKey,
 #endif
-  , NoKeepAliveRequest (..)
-  ) where
+    NoKeepAliveRequest (..),
+) where
 
 import qualified Control.Concurrent as Conc (yield)
-import UnliftIO (throwIO, Exception)
 import Data.Array ((!))
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Unsafe as SU
 import qualified Data.CaseInsensitive as CI
 import qualified Data.IORef as I
-import Data.Typeable (Typeable)
 import qualified Data.Vault.Lazy as Vault
+import Data.Word8 (_cr, _lf)
 #ifdef MIN_VERSION_crypton_x509
 import Data.X509
 #endif
+import Control.Exception (Exception, throwIO)
 import qualified Network.HTTP.Types as H
 import Network.Socket (SockAddr)
 import Network.Wai
 import Network.Wai.Handler.Warp.Types
 import Network.Wai.Internal
-import Prelude hiding (lines)
 import System.IO.Unsafe (unsafePerformIO)
 import qualified System.TimeManager as Timeout
+import Prelude hiding (lines)
 
 import Network.Wai.Handler.Warp.Conduit
 import Network.Wai.Handler.Warp.FileInfoCache
@@ -42,148 +41,169 @@
 import Network.Wai.Handler.Warp.Imports hiding (readInt)
 import Network.Wai.Handler.Warp.ReadInt
 import Network.Wai.Handler.Warp.RequestHeader
-import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath, settingsMaxTotalHeaderLength)
+import Network.Wai.Handler.Warp.Settings (
+    Settings,
+    settingsMaxTotalHeaderLength,
+    settingsNoParsePath,
+ )
 
 ----------------------------------------------------------------
 
+-- | first request on this connection?
+data FirstRequest = FirstRequest | SubsequentRequest
+
 -- | Receiving a HTTP request from 'Connection' and parsing its header
 --   to create 'Request'.
-recvRequest :: Bool -- ^ first request on this connection?
-            -> Settings
-            -> Connection
-            -> InternalInfo
-            -> Timeout.Handle
-            -> SockAddr -- ^ Peer's address.
-            -> Source -- ^ Where HTTP request comes from.
-            -> Transport
-            -> IO (Request
-                  ,Maybe (I.IORef Int)
-                  ,IndexedHeader
-                  ,IO ByteString) -- ^
-            -- 'Request' passed to 'Application',
-            -- how many bytes remain to be consumed, if known
-            -- 'IndexedHeader' of HTTP request for internal use,
-            -- Body producing action used for flushing the request body
-
+recvRequest
+    :: FirstRequest
+    -> Settings
+    -> Connection
+    -> InternalInfo
+    -> Timeout.Handle
+    -> SockAddr
+    -- ^ Peer's address.
+    -> Source
+    -- ^ Where HTTP request comes from.
+    -> Transport
+    -> IO
+        ( Request
+        , Maybe (I.IORef Int)
+        , IndexedHeader
+        , IO ByteString
+        )
+    -- ^
+    -- 'Request' passed to 'Application',
+    -- how many bytes remain to be consumed, if known
+    -- 'IndexedHeader' of HTTP request for internal use,
+    -- Body producing action used for flushing the request body
 recvRequest firstRequest settings conn ii th addr src transport = do
     hdrlines <- headerLines (settingsMaxTotalHeaderLength settings) firstRequest src
-    (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
+    (method, unparsedPath, path, query, httpversion, hdr) <-
+        parseHeaderLines hdrlines
     let idxhdr = indexRequestHeader hdr
         expect = idxhdr ! fromEnum ReqExpect
-        cl = idxhdr ! fromEnum ReqContentLength
-        te = idxhdr ! fromEnum ReqTransferEncoding
         handle100Continue = handleExpect conn httpversion expect
-        rawPath = if settingsNoParsePath settings then unparsedPath else path
-        vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)
-                   $ Vault.insert getFileInfoKey (getFileInfo ii)
-#ifdef MIN_VERSION_crypton_x509
-                   $ Vault.insert getClientCertificateKey (getTransportClientCertificate transport)
-#endif
-                     Vault.empty
-    (rbody, remainingRef, bodyLength) <- bodyAndSource src cl te
+    (rbody, remainingRef, bodyLength) <- bodyAndSource src idxhdr
     -- body producing function which will produce '100-continue', if needed
     rbody' <- timeoutBody remainingRef th rbody handle100Continue
     -- body producing function which will never produce 100-continue
     rbodyFlush <- timeoutBody remainingRef th rbody (return ())
-    let req = Request {
-            requestMethod     = method
-          , httpVersion       = httpversion
-          , pathInfo          = H.decodePathSegments path
-          , rawPathInfo       = rawPath
-          , rawQueryString    = query
-          , queryString       = H.parseQuery query
-          , requestHeaders    = hdr
-          , isSecure          = isTransportSecure transport
-          , remoteHost        = addr
-          , requestBody       = rbody'
-          , vault             = vaultValue
-          , requestBodyLength = bodyLength
-          , requestHeaderHost      = idxhdr ! fromEnum ReqHost
-          , requestHeaderRange     = idxhdr ! fromEnum ReqRange
-          , requestHeaderReferer   = idxhdr ! fromEnum ReqReferer
-          , requestHeaderUserAgent = idxhdr ! fromEnum ReqUserAgent
-          }
+    let rawPath = if settingsNoParsePath settings then unparsedPath else path
+        vaultValue =
+            Vault.insert pauseTimeoutKey (Timeout.pause th)
+                . Vault.insert getFileInfoKey (getFileInfo ii)
+#ifdef MIN_VERSION_crypton_x509
+                . Vault.insert getClientCertificateKey (getTransportClientCertificate transport)
+#endif
+                $ Vault.empty
+        req =
+            Request
+                { requestMethod = method
+                , httpVersion = httpversion
+                , pathInfo = H.decodePathSegments path
+                , rawPathInfo = rawPath
+                , rawQueryString = query
+                , queryString = H.parseQuery query
+                , requestHeaders = hdr
+                , isSecure = isTransportSecure transport
+                , remoteHost = addr
+                , requestBody = rbody'
+                , vault = vaultValue
+                , requestBodyLength = bodyLength
+                , requestHeaderHost = idxhdr ! fromEnum ReqHost
+                , requestHeaderRange = idxhdr ! fromEnum ReqRange
+                , requestHeaderReferer = idxhdr ! fromEnum ReqReferer
+                , requestHeaderUserAgent = idxhdr ! fromEnum ReqUserAgent
+                }
     return (req, remainingRef, idxhdr, rbodyFlush)
 
 ----------------------------------------------------------------
 
-headerLines :: Int -> Bool -> Source -> IO [ByteString]
+headerLines :: Int -> FirstRequest -> Source -> IO [ByteString]
 headerLines maxTotalHeaderLength firstRequest src = do
     bs <- readSource src
     if S.null bs
-        -- When we're working on a keep-alive connection and trying to
+        then -- When we're working on a keep-alive connection and trying to
         -- get the second or later request, we don't want to treat the
         -- lack of data as a real exception. See the http1 function in
         -- the Run module for more details.
-        then if firstRequest then throwIO ConnectionClosedByPeer else throwIO NoKeepAliveRequest
+
+            case firstRequest of
+              FirstRequest -> throwIO ConnectionClosedByPeer
+              SubsequentRequest -> throwIO NoKeepAliveRequest
         else push maxTotalHeaderLength src (THStatus 0 0 id id) bs
 
 data NoKeepAliveRequest = NoKeepAliveRequest
-    deriving (Show, Typeable)
+    deriving (Show)
 instance Exception NoKeepAliveRequest
 
 ----------------------------------------------------------------
 
-handleExpect :: Connection
-             -> H.HttpVersion
-             -> Maybe HeaderValue
-             -> IO ()
+handleExpect
+    :: Connection
+    -> H.HttpVersion
+    -> Maybe HeaderValue
+    -> IO ()
 handleExpect conn ver (Just "100-continue") = do
     connSendAll conn continue
     Conc.yield
   where
     continue
-      | ver == H.http11 = "HTTP/1.1 100 Continue\r\n\r\n"
-      | otherwise       = "HTTP/1.0 100 Continue\r\n\r\n"
-handleExpect _    _   _                     = return ()
+        | ver == H.http11 = "HTTP/1.1 100 Continue\r\n\r\n"
+        | otherwise = "HTTP/1.0 100 Continue\r\n\r\n"
+handleExpect _ _ _ = return ()
 
 ----------------------------------------------------------------
 
-bodyAndSource :: Source
-              -> Maybe HeaderValue -- ^ content length
-              -> Maybe HeaderValue -- ^ transfer-encoding
-              -> IO (IO ByteString
-                    ,Maybe (I.IORef Int)
-                    ,RequestBodyLength
-                    )
-bodyAndSource src cl te
-  | chunked = do
-      csrc <- mkCSource src
-      return (readCSource csrc, Nothing, ChunkedBody)
-  | otherwise = do
-      isrc@(ISource _ remaining) <- mkISource src len
-      return (readISource isrc, Just remaining, bodyLen)
+bodyAndSource
+    :: Source
+    -> IndexedHeader
+    -> IO
+        ( IO ByteString
+        , Maybe (I.IORef Int)
+        , RequestBodyLength
+        )
+bodyAndSource src idxhdr
+    | chunked = do
+        csrc <- mkCSource src
+        return (readCSource csrc, Nothing, ChunkedBody)
+    | otherwise = do
+        let len = toLength $ idxhdr ! fromEnum ReqContentLength
+            bodyLen = KnownLength $ fromIntegral len
+        isrc@(ISource _ remaining) <- mkISource src len
+        return (readISource isrc, Just remaining, bodyLen)
   where
-    len = toLength cl
-    bodyLen = KnownLength $ fromIntegral len
-    chunked = isChunked te
+    chunked = isChunked $ idxhdr ! fromEnum ReqTransferEncoding
 
 toLength :: Maybe HeaderValue -> Int
-toLength Nothing   = 0
+toLength Nothing = 0
 toLength (Just bs) = readInt bs
 
 isChunked :: Maybe HeaderValue -> Bool
 isChunked (Just bs) = CI.foldCase bs == "chunked"
-isChunked _         = False
+isChunked _ = False
 
 ----------------------------------------------------------------
 
-timeoutBody :: Maybe (I.IORef Int) -- ^ remaining
-            -> Timeout.Handle
-            -> IO ByteString
-            -> IO ()
-            -> IO (IO ByteString)
+timeoutBody
+    :: Maybe (I.IORef Int)
+    -- ^ remaining
+    -> Timeout.Handle
+    -> IO ByteString
+    -> IO ()
+    -> IO (IO ByteString)
 timeoutBody remainingRef timeoutHandle rbody handle100Continue = do
     isFirstRef <- I.newIORef True
 
     let checkEmpty =
             case remainingRef of
                 Nothing -> return . S.null
-                Just ref -> \bs -> if S.null bs
-                    then return True
-                    else do
-                        x <- I.readIORef ref
-                        return $! x <= 0
+                Just ref -> \bs ->
+                    if S.null bs
+                        then return True
+                        else do
+                            x <- I.readIORef ref
+                            return $! x <= 0
 
     return $ do
         isFirst <- I.readIORef isFirstRef
@@ -211,14 +231,15 @@
 
 ----------------------------------------------------------------
 
-type BSEndo = ByteString -> ByteString
+type BSEndo = S.ByteString -> S.ByteString
 type BSEndoList = [ByteString] -> [ByteString]
 
-data THStatus = THStatus
-    !Int -- running total byte count (excluding current header chunk)
-    !Int -- current header chunk byte count
-    BSEndoList -- previously parsed lines
-    BSEndo -- bytestrings to be prepended
+data THStatus
+    = THStatus
+        Int -- running total byte count (excluding current header chunk)
+        Int -- current header chunk byte count
+        BSEndoList -- previously parsed lines
+        BSEndo -- bytestrings to be prepended
 
 ----------------------------------------------------------------
 
@@ -227,93 +248,85 @@
 close = throwIO IncompleteHeaders
 -}
 
+-- | Assumes the 'ByteString' is never 'S.null'
 push :: Int -> Source -> THStatus -> ByteString -> IO [ByteString]
-push maxTotalHeaderLength src (THStatus totalLen chunkLen lines prepend) bs'
+push maxTotalHeaderLength src (THStatus totalLen chunkLen reqLines prepend) bs
+    -- Newline found at index 'ix'
+    | Just ix <- S.elemIndex _lf bs = do
         -- Too many bytes
-        | currentTotal > maxTotalHeaderLength = throwIO OverLargeHeader
-        | otherwise = push' mNL
+        when (currentTotal > maxTotalHeaderLength) $ throwIO OverLargeHeader
+        newlineFound ix
+    -- No newline found
+    | otherwise = do
+        -- Early easy abort
+        when (currentTotal + bsLen > maxTotalHeaderLength) $ throwIO OverLargeHeader
+        withNewChunk noNewlineFound
   where
-    currentTotal = totalLen + chunkLen
-    -- bs: current header chunk, plus maybe (parts of) next header
-    bs = prepend bs'
     bsLen = S.length bs
-    -- Maybe newline
-    -- Returns: Maybe
-    --    ( length of this chunk up to newline
-    --    , position of newline in relation to entire current header
-    --    , is this part of a multiline header
-    --    )
-    mNL = do
-        -- 10 is the code point for newline (\n)
-        chunkNL <- S.elemIndex 10 bs'
-        let headerNL = chunkNL + S.length (prepend "")
-            chunkNLlen = chunkNL + 1
-        -- check if there are two more bytes in the bs
-        -- if so, see if the second of those is a horizontal space
-        if bsLen > headerNL + 1 then
-            let c = S.index bs (headerNL + 1)
-                b = case headerNL of
-                      0 -> True
-                      1 -> S.index bs 0 == 13
-                      _ -> False
-                isMultiline = not b && (c == 32 || c == 9)
-            in Just (chunkNLlen, headerNL, isMultiline)
-            else
-            Just (chunkNLlen, headerNL, False)
-
-    {-# INLINE push' #-}
-    push' :: Maybe (Int, Int, Bool) -> IO [ByteString]
-    -- No newline find in this chunk.  Add it to the prepend,
-    -- update the length, and continue processing.
-    push' Nothing = do
-        bst <- readSource' src
-        when (S.null bst) $ throwIO IncompleteHeaders
-        push maxTotalHeaderLength src status bst
-      where
-        prepend' = S.append bs
-        thisChunkLen = S.length bs'
-        newChunkLen = chunkLen + thisChunkLen
-        status = THStatus totalLen newChunkLen lines prepend'
-    -- Found a newline, but next line continues as a multiline header
-    push' (Just (chunkNLlen, end, True)) =
-        push maxTotalHeaderLength src status rest
-      where
-        rest = S.drop (end + 1) bs
-        prepend' = S.append (SU.unsafeTake (checkCR bs end) bs)
-        -- If we'd just update the entire current chunk up to newline
-        -- we wouldn't count all the dropped newlines in between.
-        -- So update 'chunkLen' with current chunk up to newline
-        -- and use 'chunkLen' later on to add to 'totalLen'.
-        newChunkLen = chunkLen + chunkNLlen
-        status = THStatus totalLen newChunkLen lines prepend'
-    -- Found a newline at position end.
-    push' (Just (chunkNLlen, end, False))
-      -- leftover
-      | S.null line = do
-            when (start < bsLen) $ leftoverSource src (SU.unsafeDrop start bs)
-            return (lines [])
-      -- more headers
-      | otherwise   = let lines' = lines . (line:)
-                          newTotalLength = totalLen + chunkLen + chunkNLlen
-                          status = THStatus newTotalLength 0 lines' id
-                      in if start < bsLen then
-                             -- more bytes in this chunk, push again
-                             let bs'' = SU.unsafeDrop start bs
-                              in push maxTotalHeaderLength src status bs''
-                           else do
-                             -- no more bytes in this chunk, ask for more
-                             bst <- readSource' src
-                             when (S.null bs) $ throwIO IncompleteHeaders
-                             push maxTotalHeaderLength src status bst
+    currentTotal = totalLen + chunkLen
+    {-# INLINE withNewChunk #-}
+    withNewChunk :: (S.ByteString -> IO a) -> IO a
+    withNewChunk f = do
+        newChunk <- readSource' src
+        when (S.null newChunk) $ throwIO IncompleteHeaders
+        f newChunk
+    {-# INLINE noNewlineFound #-}
+    noNewlineFound newChunk
+        -- The chunk split the CRLF in half
+        | SU.unsafeLast bs == _cr && S.head newChunk == _lf =
+            let bs' = SU.unsafeDrop 1 newChunk
+             in if bsLen == 1 && chunkLen == 0
+                -- first part is only CRLF, we're done
+                then do
+                    when (not $ S.null bs') $ leftoverSource src bs'
+                    pure $ reqLines []
+                else do
+                    rest <- if S.null bs'
+                        -- new chunk is only LF, we need more to check for multiline
+                        then withNewChunk pure
+                        else pure bs'
+                    let status = addLine (bsLen + 1) (SU.unsafeTake (bsLen - 1) bs)
+                    push maxTotalHeaderLength src status rest
+        -- chunk and keep going
+        | otherwise = do
+            let newChunkTotal = chunkLen + bsLen
+                newPrepend = prepend . (bs <>)
+                status = THStatus totalLen newChunkTotal reqLines newPrepend
+            push maxTotalHeaderLength src status newChunk
+    {-# INLINE newlineFound #-}
+    newlineFound ix
+        -- Is end of headers
+        | chunkLen == 0 && startsWithLF =  do
+            let rest = SU.unsafeDrop end bs
+            when (not $ S.null rest) $ leftoverSource src rest
+            pure $ reqLines []
+        | otherwise = do
+            -- LF is on last byte
+            let p = ix - 1
+                chunk =
+                    if ix > 0 && SU.unsafeIndex bs p == _cr then p else ix
+                status = addLine end (SU.unsafeTake chunk bs)
+                continue = push maxTotalHeaderLength src status
+            if end == bsLen
+                then withNewChunk continue
+                else continue $ SU.unsafeDrop end bs
       where
-        start = end + 1 -- start of next chunk
-        line = SU.unsafeTake (checkCR bs end) bs
+        end = ix + 1
+        startsWithLF =
+            case ix of
+                0 -> True
+                1 -> SU.unsafeHead bs == _cr
+                _ -> False
+    -- addLine: take the current chunk and, if there's nothing to prepend,
+    -- add straight to 'reqLines', otherwise first prepend then add.
+    {-# INLINE addLine #-}
+    addLine len chunk =
+        let newTotal = currentTotal + len
+            newLine =
+                if chunkLen == 0 then chunk else prepend chunk
+        in THStatus newTotal 0 (reqLines . (newLine:)) id
+{- HLint ignore push "Use unless" -}
 
-{-# INLINE checkCR #-}
-checkCR :: ByteString -> Int -> Int
-checkCR bs pos = if pos > 0 && 13 == S.index bs p then p else pos -- 13 is CR (\r)
-  where
-    !p = pos - 1
 
 pauseTimeoutKey :: Vault.Key (IO ())
 pauseTimeoutKey = unsafePerformIO Vault.newKey
diff --git a/Network/Wai/Handler/Warp/RequestHeader.hs b/Network/Wai/Handler/Warp/RequestHeader.hs
--- a/Network/Wai/Handler/Warp/RequestHeader.hs
+++ b/Network/Wai/Handler/Warp/RequestHeader.hs
@@ -1,16 +1,17 @@
 {-# LANGUAGE BangPatterns #-}
 
 module Network.Wai.Handler.Warp.RequestHeader (
-      parseHeaderLines
-    ) where
+    parseHeaderLines,
+) where
 
-import UnliftIO (throwIO)
+import Control.Exception (throwIO)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as C8 (unpack)
 import Data.ByteString.Internal (memchr)
 import qualified Data.CaseInsensitive as CI
+import Data.Word8
 import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Ptr (Ptr, plusPtr, minusPtr, nullPtr)
+import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
 import Foreign.Storable (peek)
 import qualified Network.HTTP.Types as H
 
@@ -22,16 +23,18 @@
 
 ----------------------------------------------------------------
 
-parseHeaderLines :: [ByteString]
-                 -> IO (H.Method
-                       ,ByteString  --  Path
-                       ,ByteString  --  Path, parsed
-                       ,ByteString  --  Query
-                       ,H.HttpVersion
-                       ,H.RequestHeaders
-                       )
+parseHeaderLines
+    :: [ByteString]
+    -> IO
+        ( H.Method
+        , ByteString --  Path
+        , ByteString --  Path, parsed
+        , ByteString --  Query
+        , H.HttpVersion
+        , H.RequestHeaders
+        )
 parseHeaderLines [] = throwIO $ NotEnoughLines []
-parseHeaderLines (firstLine:otherLines) = do
+parseHeaderLines (firstLine : otherLines) = do
     (method, path', query, httpversion) <- parseRequestLine firstLine
     let path = H.extractPath path'
         hdr = map parseHeader otherLines
@@ -51,24 +54,27 @@
 -- *** Exception: Warp: Request line specified a non-HTTP request
 -- >>> parseRequestLine "PRI * HTTP/2.0"
 -- ("PRI","*","",HTTP/2.0)
-parseRequestLine :: ByteString
-                 -> IO (H.Method
-                       ,ByteString -- Path
-                       ,ByteString -- Query
-                       ,H.HttpVersion)
+parseRequestLine
+    :: ByteString
+    -> IO
+        ( H.Method
+        , ByteString -- Path
+        , ByteString -- Query
+        , H.HttpVersion
+        )
 parseRequestLine requestLine@(PS fptr off len) = withForeignPtr fptr $ \ptr -> do
     when (len < 14) $ throwIO baderr
     let methodptr = ptr `plusPtr` off
         limptr = methodptr `plusPtr` len
         lim0 = fromIntegral len
 
-    pathptr0 <- memchr methodptr 32 lim0 -- ' '
+    pathptr0 <- memchr methodptr _space lim0
     when (pathptr0 == nullPtr || (limptr `minusPtr` pathptr0) < 11) $
         throwIO baderr
     let pathptr = pathptr0 `plusPtr` 1
         lim1 = fromIntegral (limptr `minusPtr` pathptr0)
 
-    httpptr0 <- memchr pathptr 32 lim1 -- ' '
+    httpptr0 <- memchr pathptr _space lim1
     when (httpptr0 == nullPtr || (limptr `minusPtr` httpptr0) < 9) $
         throwIO baderr
     let httpptr = httpptr0 `plusPtr` 1
@@ -76,17 +82,17 @@
 
     checkHTTP httpptr
     !hv <- httpVersion httpptr
-    queryptr <- memchr pathptr 63 lim2 -- '?'
+    queryptr <- memchr pathptr _question lim2
 
     let !method = bs ptr methodptr pathptr0
         !path
-          | queryptr == nullPtr = bs ptr pathptr httpptr0
-          | otherwise           = bs ptr pathptr queryptr
+            | queryptr == nullPtr = bs ptr pathptr httpptr0
+            | otherwise = bs ptr pathptr queryptr
         !query
-          | queryptr == nullPtr = S.empty
-          | otherwise           = bs ptr queryptr httpptr0
+            | queryptr == nullPtr = S.empty
+            | otherwise = bs ptr queryptr httpptr0
 
-    return (method,path,query,hv)
+    return (method, path, query, hv)
   where
     baderr = BadFirstLine $ C8.unpack requestLine
     check :: Ptr Word8 -> Int -> Word8 -> IO ()
@@ -94,19 +100,19 @@
         w0 <- peek $ p `plusPtr` n
         when (w0 /= w) $ throwIO NonHttp
     checkHTTP httpptr = do
-        check httpptr 0 72 -- 'H'
-        check httpptr 1 84 -- 'T'
-        check httpptr 2 84 -- 'T'
-        check httpptr 3 80 -- 'P'
-        check httpptr 4 47 -- '/'
-        check httpptr 6 46 -- '.'
+        check httpptr 0 _H
+        check httpptr 1 _T
+        check httpptr 2 _T
+        check httpptr 3 _P
+        check httpptr 4 _slash
+        check httpptr 6 _period
     httpVersion httpptr = do
         major <- peek (httpptr `plusPtr` 5) :: IO Word8
         minor <- peek (httpptr `plusPtr` 7) :: IO Word8
         let version
-              | major == 49 = if minor == 49 then H.http11 else H.http10
-              | major == 50 && minor == 48 = H.HttpVersion 2 0
-              | otherwise   = H.http10
+                | major == _1 = if minor == _1 then H.http11 else H.http10
+                | major == _2 && minor == _0 = H.http20
+                | otherwise = H.http10
         return version
     bs ptr p0 p1 = PS fptr o l
       where
@@ -125,9 +131,8 @@
 -- ("Host","example.com:8080")
 -- >>> parseHeader "NoSemiColon"
 -- ("NoSemiColon","")
-
 parseHeader :: ByteString -> H.Header
 parseHeader s =
-    let (k, rest) = S.break (== 58) s -- ':'
-        rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
+    let (k, rest) = S.break (== _colon) s
+        rest' = S.dropWhile (\c -> c == _space || c == _tab) $ S.drop 1 rest
      in (CI.mk k, rest')
diff --git a/Network/Wai/Handler/Warp/Response.hs b/Network/Wai/Handler/Warp/Response.hs
--- a/Network/Wai/Handler/Warp/Response.hs
+++ b/Network/Wai/Handler/Warp/Response.hs
@@ -1,37 +1,42 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Network.Wai.Handler.Warp.Response (
-    sendResponse
-  , sanitizeHeaderValue -- for testing
-  , warpVersion
-  , hasBody
-  , replaceHeader
-  , addServer -- testing
-  , addAltSvc
-  ) where
+    sendResponse,
+    sanitizeHeaderValue, -- for testing
+    --  Provided here for backwards compatibility.
+    warpVersion,
+    hasBody,
+    replaceHeader,
+    addServer, -- testing
+    addAltSvc,
+) where
 
-import Data.ByteString.Builder.HTTP.Chunked (chunkedTransferEncoding, chunkedTransferTerminator)
-import qualified UnliftIO
+import qualified Control.Exception as E
 import Data.Array ((!))
 import qualified Data.ByteString as S
-import Data.ByteString.Builder (byteString, Builder)
+import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Builder.Extra (flush)
+import Data.ByteString.Builder.HTTP.Chunked (
+    chunkedTransferEncoding,
+    chunkedTransferTerminator,
+ )
 import qualified Data.ByteString.Char8 as C8
 import qualified Data.CaseInsensitive as CI
 import Data.Function (on)
 import Data.List (deleteBy)
-import Data.Streaming.ByteString.Builder (newByteStringBuilderRecv, reuseBufferStrategy)
-import Data.Version (showVersion)
-import Data.Word8 (_cr, _lf)
+import Data.Streaming.ByteString.Builder (
+    newByteStringBuilderRecv,
+    reuseBufferStrategy,
+ )
+import Data.Word8 (_cr, _lf, _space, _tab)
 import qualified Network.HTTP.Types as H
 import qualified Network.HTTP.Types.Header as H
 import Network.Wai
 import Network.Wai.Internal
-import qualified Paths_warp
 import qualified System.TimeManager as T
 
 import Network.Wai.Handler.Warp.Buffer (toBuilderBuffer)
@@ -99,36 +104,50 @@
 --     If-Modified-Since, If-Unmodified-Since, If-Range and Range
 --     are processed. Since a proper status is chosen, 'Status' is
 --     ignored. Last-Modified is inserted.
-
-sendResponse :: Settings
-             -> Connection
-             -> InternalInfo
-             -> T.Handle
-             -> Request -- ^ HTTP request.
-             -> IndexedHeader -- ^ Indexed header of HTTP request.
-             -> IO ByteString -- ^ source from client, for raw response
-             -> Response -- ^ HTTP response including status code and response header.
-             -> IO Bool -- ^ Returing True if the connection is persistent.
+sendResponse
+    :: Settings
+    -> Connection
+    -> InternalInfo
+    -> T.Handle
+    -> Request
+    -- ^ HTTP request.
+    -> IndexedHeader
+    -- ^ Indexed header of HTTP request.
+    -> IO ByteString
+    -- ^ source from client, for raw response
+    -> Response
+    -- ^ HTTP response including status code and response header.
+    -> IO Bool
+    -- ^ Returing True if the connection is persistent.
 sendResponse settings conn ii th req reqidxhdr src response = do
-    hs <- addAltSvc settings <$> addServerAndDate hs0
-    if hasBody s then do
-        -- The response to HEAD does not have body.
-        -- But to handle the conditional requests defined RFC 7232 and
-        -- to generate appropriate content-length, content-range,
-        -- and status, the response to HEAD is processed here.
-        --
-        -- See definition of rsp below for proper body stripping.
-        (ms, mlen) <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method rsp
-        case ms of
-            Nothing         -> return ()
-            Just realStatus -> logger req realStatus mlen
-        T.tickle th
-        return ret
-      else do
-        _ <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody
-        logger req s Nothing
-        T.tickle th
-        return isPersist
+    isShuttingDown <-
+        case settingsServerState settings of
+            Just serverState -> currentShuttingDownState serverState
+            -- Should never be reached!
+            -- (cf. 'makeServerState' in 'runSettingsConnectionMakerSecure')
+            Nothing -> pure False
+    let shouldPersist =
+            not isShuttingDown && if hasBody s then ret else isPersist
+        addConnection hs =
+            if shouldPersist then hs else (H.hConnection, "close") : hs
+    hs <- addConnection . addAltSvc settings <$> addServerAndDate hs0
+    if hasBody s
+        then do
+            -- The response to HEAD does not have body.
+            -- But to handle the conditional requests defined RFC 7232 and
+            -- to generate appropriate content-length, content-range,
+            -- and status, the response to HEAD is processed here.
+            --
+            -- See definition of rsp below for proper body stripping.
+            (ms, mlen) <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method rsp
+            case ms of
+                Nothing -> return ()
+                Just realStatus -> logger req realStatus mlen
+        else do
+            _ <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody
+            logger req s Nothing
+    T.tickle th
+    return shouldPersist
   where
     defServer = settingsServerName settings
     logger = settingsLogger settings
@@ -139,26 +158,26 @@
     rspidxhdr = indexResponseHeader hs0
     getdate = getDate ii
     addServerAndDate = addDate getdate rspidxhdr . addServer defServer rspidxhdr
-    (isPersist,isChunked0) = infoFromRequest req reqidxhdr
+    (isPersist, isChunked0) = infoFromRequest req reqidxhdr
     isChunked = not isHead && isChunked0
-    (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr (isPersist,isChunked)
+    (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr (isPersist, isChunked)
     method = requestMethod req
     isHead = method == H.methodHead
     rsp = case response of
-        ResponseFile _ _ path mPart -> RspFile path mPart reqidxhdr isHead (T.tickle th)
+        ResponseFile _ _ path mPart -> RspFile path mPart reqidxhdr (T.tickle th)
         ResponseBuilder _ _ b
-          | isHead                  -> RspNoBody
-          | otherwise               -> RspBuilder b needsChunked
+            | isHead -> RspNoBody
+            | otherwise -> RspBuilder b needsChunked
         ResponseStream _ _ fb
-          | isHead                  -> RspNoBody
-          | otherwise               -> RspStream fb needsChunked
-        ResponseRaw raw _           -> RspRaw raw src
+            | isHead -> RspNoBody
+            | otherwise -> RspStream fb needsChunked
+        ResponseRaw raw _ -> RspRaw raw src
     -- Make sure we don't hang on to 'response' (avoid space leak)
     !ret = case response of
-        ResponseFile    {} -> isPersist
-        ResponseBuilder {} -> isKeepAlive
-        ResponseStream  {} -> isKeepAlive
-        ResponseRaw     {} -> False
+        ResponseFile{} -> isPersist
+        ResponseBuilder{} -> isKeepAlive
+        ResponseStream{} -> isKeepAlive
+        ResponseRaw{} -> False
 
 ----------------------------------------------------------------
 
@@ -166,8 +185,8 @@
 sanitizeHeaders = map (sanitize <$>)
   where
     sanitize v
-      | containsNewlines v = sanitizeHeaderValue v -- slow path
-      | otherwise          = v                     -- fast path
+        | containsNewlines v = sanitizeHeaderValue v -- slow path
+        | otherwise = v -- fast path
 
 {-# INLINE containsNewlines #-}
 containsNewlines :: ByteString -> Bool
@@ -176,37 +195,38 @@
 {-# INLINE sanitizeHeaderValue #-}
 sanitizeHeaderValue :: ByteString -> ByteString
 sanitizeHeaderValue v = case C8.lines $ S.filter (/= _cr) v of
-    []     -> ""
+    [] -> ""
     x : xs -> C8.intercalate "\r\n" (x : mapMaybe addSpaceIfMissing xs)
   where
-    addSpaceIfMissing line = case C8.uncons line of
-        Nothing                           -> Nothing
+    addSpaceIfMissing line = case S.uncons line of
+        Nothing -> Nothing
         Just (first, _)
-          | first == ' ' || first == '\t' -> Just line
-          | otherwise                     -> Just $ " " <> line
+            | first == _space || first == _tab -> Just line
+            | otherwise -> Just $ _space `S.cons` line
 
 ----------------------------------------------------------------
 
-data Rsp = RspNoBody
-         | RspFile FilePath (Maybe FilePart) IndexedHeader Bool (IO ())
-         | RspBuilder Builder Bool
-         | RspStream StreamingBody Bool
-         | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString)
+data Rsp
+    = RspNoBody
+    | RspFile FilePath (Maybe FilePart) IndexedHeader (IO ())
+    | RspBuilder Builder Bool
+    | RspStream StreamingBody Bool
+    | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString)
 
 ----------------------------------------------------------------
 
-sendRsp :: Connection
-        -> InternalInfo
-        -> T.Handle
-        -> H.HttpVersion
-        -> H.Status
-        -> H.ResponseHeaders
-        -> IndexedHeader -- Response
-        -> Int -- maxBuilderResponseBufferSize
-        -> H.Method
-        -> Rsp
-        -> IO (Maybe H.Status, Maybe Integer)
-
+sendRsp
+    :: Connection
+    -> InternalInfo
+    -> T.Handle
+    -> H.HttpVersion
+    -> H.Status
+    -> H.ResponseHeaders
+    -> IndexedHeader -- Response
+    -> Int -- maxBuilderResponseBufferSize
+    -> H.Method
+    -> Rsp
+    -> IO (Maybe H.Status, Maybe Integer)
 ----------------------------------------------------------------
 
 sendRsp conn _ _ ver s hs _ _ _ RspNoBody = do
@@ -220,19 +240,29 @@
 sendRsp conn _ th ver s hs _ maxRspBufSize _ (RspBuilder body needsChunked) = do
     header <- composeHeaderBuilder ver s hs needsChunked
     let hdrBdy
-         | needsChunked = header <> chunkedTransferEncoding body
-                                 <> chunkedTransferTerminator
-         | otherwise    = header <> body
+            | needsChunked =
+                header
+                    <> chunkedTransferEncoding body
+                    <> chunkedTransferTerminator
+            | otherwise = header <> body
         writeBufferRef = connWriteBuffer conn
-    len <- toBufIOWith maxRspBufSize writeBufferRef (\bs -> connSendAll conn bs >> T.tickle th) hdrBdy
+    len <-
+        toBufIOWith
+            maxRspBufSize
+            writeBufferRef
+            (\bs -> connSendAll conn bs >> T.tickle th)
+            hdrBdy
     return (Just s, Just len)
 
 ----------------------------------------------------------------
 
 sendRsp conn _ th ver s hs _ _ _ (RspStream streamingBody needsChunked) = do
     header <- composeHeaderBuilder ver s hs needsChunked
-    (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy
-                    $ toBuilderBuffer $ connWriteBuffer conn
+    (recv, finish) <-
+        newByteStringBuilderRecv $
+            reuseBufferStrategy $
+                toBuilderBuffer $
+                    connWriteBuffer conn
     let send builder = do
             popper <- recv builder
             let loop = do
@@ -267,8 +297,21 @@
 
 -- Sophisticated WAI applications.
 -- We respect s0. s0 MUST be a proper value.
-sendRsp conn ii th ver s0 hs0 rspidxhdr maxRspBufSize method (RspFile path (Just part) _ isHead hook) =
-    sendRspFile2XX conn ii th ver s0 hs rspidxhdr maxRspBufSize method path beg len isHead hook
+sendRsp conn ii th ver s0 hs0 rspidxhdr maxRspBufSize method (RspFile path (Just part) _ hook) =
+    sendRspFile2XX
+        conn
+        ii
+        th
+        ver
+        s0
+        hs
+        rspidxhdr
+        maxRspBufSize
+        method
+        path
+        beg
+        len
+        hook
   where
     beg = filePartOffset part
     len = filePartByteCount part
@@ -278,59 +321,86 @@
 
 -- Simple WAI applications.
 -- Status is ignored
-sendRsp conn ii th ver _ hs0 rspidxhdr maxRspBufSize method (RspFile path Nothing reqidxhdr isHead hook) = do
-    efinfo <- UnliftIO.tryIO $ getFileInfo ii path
+sendRsp conn ii th ver _ hs0 rspidxhdr maxRspBufSize method (RspFile path Nothing reqidxhdr hook) = do
+    efinfo <- E.try $ getFileInfo ii path
     case efinfo of
-        Left (_ex :: UnliftIO.IOException) ->
+        Left (_ex :: E.IOException) ->
 #ifdef WARP_DEBUG
-          print _ex >>
+            print _ex >>
 #endif
-          sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize method
+            sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize method
         Right finfo -> case conditionalRequest finfo hs0 method rspidxhdr reqidxhdr of
-          WithoutBody s         -> sendRsp conn ii th ver s hs0 rspidxhdr maxRspBufSize method RspNoBody
-          WithBody s hs beg len -> sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize method path beg len isHead hook
+            WithoutBody s ->
+                sendRsp conn ii th ver s hs0 rspidxhdr maxRspBufSize method RspNoBody
+            WithBody s hs beg len ->
+                sendRspFile2XX
+                    conn
+                    ii
+                    th
+                    ver
+                    s
+                    hs
+                    rspidxhdr
+                    maxRspBufSize
+                    method
+                    path
+                    beg
+                    len
+                    hook
 
 ----------------------------------------------------------------
 
-sendRspFile2XX :: Connection
-               -> InternalInfo
-               -> T.Handle
-               -> H.HttpVersion
-               -> H.Status
-               -> H.ResponseHeaders
-               -> IndexedHeader
-               -> Int
-               -> H.Method
-               -> FilePath
-               -> Integer
-               -> Integer
-               -> Bool
-               -> IO ()
-               -> IO (Maybe H.Status, Maybe Integer)
-sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize method path beg len isHead hook
-  | isHead = sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody
-  | otherwise = do
-      lheader <- composeHeader ver s hs
-      (mfd, fresher) <- getFd ii path
-      let fid = FileId path mfd
-          hook' = hook >> fresher
-      connSendFile conn fid beg len hook' [lheader]
-      return (Just s, Just len)
+sendRspFile2XX
+    :: Connection
+    -> InternalInfo
+    -> T.Handle
+    -> H.HttpVersion
+    -> H.Status
+    -> H.ResponseHeaders
+    -> IndexedHeader
+    -> Int
+    -> H.Method
+    -> FilePath
+    -> Integer
+    -> Integer
+    -> IO ()
+    -> IO (Maybe H.Status, Maybe Integer)
+sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize method path beg len hook
+    | method == H.methodHead =
+        sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody
+    | otherwise = do
+        lheader <- composeHeader ver s hs
+        (mfd, fresher) <- getFd ii path
+        let fid = FileId path mfd
+            hook' = hook >> fresher
+        connSendFile conn fid beg len hook' [lheader]
+        return (Just s, Just len)
 
-sendRspFile404 :: Connection
-               -> InternalInfo
-               -> T.Handle
-               -> H.HttpVersion
-               -> H.ResponseHeaders
-               -> IndexedHeader
-               -> Int
-               -> H.Method
-               -> IO (Maybe H.Status, Maybe Integer)
+sendRspFile404
+    :: Connection
+    -> InternalInfo
+    -> T.Handle
+    -> H.HttpVersion
+    -> H.ResponseHeaders
+    -> IndexedHeader
+    -> Int
+    -> H.Method
+    -> IO (Maybe H.Status, Maybe Integer)
 sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize method =
-    sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method (RspBuilder body True)
+    sendRsp
+        conn
+        ii
+        th
+        ver
+        s
+        hs
+        rspidxhdr
+        maxRspBufSize
+        method
+        (RspBuilder body True)
   where
     s = H.notFound404
-    hs =  replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
+    hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
     body = byteString "File not found"
 
 ----------------------------------------------------------------
@@ -338,34 +408,39 @@
 
 -- | Use 'connSendAll' to send this data while respecting timeout rules.
 sendFragment :: Connection -> T.Handle -> ByteString -> IO ()
-sendFragment Connection { connSendAll = send } th bs = do
+sendFragment Connection{connSendAll = send} th bs = do
     T.resume th
     send bs
     T.pause th
-    -- We pause timeouts before passing control back to user code. This ensures
-    -- that a timeout will only ever be executed when Warp is in control. We
-    -- also make sure to resume the timeout after the completion of user code
-    -- so that we can kill idle connections.
 
+-- We pause timeouts before passing control back to user code. This ensures
+-- that a timeout will only ever be executed when Warp is in control. We
+-- also make sure to resume the timeout after the completion of user code
+-- so that we can kill idle connections.
+
 ----------------------------------------------------------------
 
-infoFromRequest :: Request -> IndexedHeader -> (Bool  -- isPersist
-                                               ,Bool) -- isChunked
+infoFromRequest
+    :: Request
+    -> IndexedHeader
+    -> ( Bool -- isPersist
+       , Bool -- isChunked
+       )
 infoFromRequest req reqidxhdr = (checkPersist req reqidxhdr, checkChunk req)
 
 checkPersist :: Request -> IndexedHeader -> Bool
 checkPersist req reqidxhdr
     | ver == H.http11 = checkPersist11 conn
-    | otherwise       = checkPersist10 conn
+    | otherwise = checkPersist10 conn
   where
     ver = httpVersion req
     conn = reqidxhdr ! fromEnum ReqConnection
     checkPersist11 (Just x)
-        | CI.foldCase x == "close"      = False
-    checkPersist11 _                    = True
+        | CI.foldCase x == "close" = False
+    checkPersist11 _ = True
     checkPersist10 (Just x)
         | CI.foldCase x == "keep-alive" = True
-    checkPersist10 _                    = False
+    checkPersist10 _ = False
 
 checkChunk :: Request -> Bool
 checkChunk req = httpVersion req == H.http11
@@ -379,8 +454,8 @@
 --
 -- Content-Length is specified by a reverse proxy.
 -- Note that CGI does not specify Content-Length.
-infoFromResponse :: IndexedHeader -> (Bool,Bool) -> (Bool,Bool)
-infoFromResponse rspidxhdr (isPersist,isChunked) = (isKeepAlive, needsChunked)
+infoFromResponse :: IndexedHeader -> (Bool, Bool) -> (Bool, Bool)
+infoFromResponse rspidxhdr (isPersist, isChunked) = (isKeepAlive, needsChunked)
   where
     needsChunked = isChunked && not hasLength
     isKeepAlive = isPersist && (isChunked || hasLength)
@@ -389,9 +464,10 @@
 ----------------------------------------------------------------
 
 hasBody :: H.Status -> Bool
-hasBody s = sc /= 204
-         && sc /= 304
-         && sc >= 200
+hasBody s =
+    sc /= 204
+        && sc /= 304
+        && sc >= 200
   where
     sc = H.statusCode s
 
@@ -400,7 +476,8 @@
 addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders
 addTransferEncoding hdrs = (H.hTransferEncoding, "chunked") : hdrs
 
-addDate :: IO D.GMTDate -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders
+addDate
+    :: IO D.GMTDate -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders
 addDate getdate rspidxhdr hdrs = case rspidxhdr ! fromEnum ResDate of
     Nothing -> do
         gmtdate <- getdate
@@ -409,23 +486,20 @@
 
 ----------------------------------------------------------------
 
--- | The version of Warp.
-warpVersion :: String
-warpVersion = showVersion Paths_warp.version
-
 {-# INLINE addServer #-}
-addServer :: HeaderValue -> IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
+addServer
+    :: HeaderValue -> IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
 addServer "" rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of
     Nothing -> hdrs
-    _       -> filter ((/= H.hServer) . fst) hdrs
+    _ -> filter ((/= H.hServer) . fst) hdrs
 addServer serverName rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of
     Nothing -> (H.hServer, serverName) : hdrs
-    _       -> hdrs
+    _ -> hdrs
 
 addAltSvc :: Settings -> H.ResponseHeaders -> H.ResponseHeaders
 addAltSvc settings hs = case settingsAltSvc settings of
-                Nothing -> hs
-                Just  v -> ("Alt-Svc", v) : hs
+    Nothing -> hs
+    Just v -> ("Alt-Svc", v) : hs
 
 ----------------------------------------------------------------
 
@@ -433,12 +507,14 @@
 --
 -- >>> replaceHeader "Content-Type" "new" [("content-type","old")]
 -- [("Content-Type","new")]
-replaceHeader :: H.HeaderName -> HeaderValue -> H.ResponseHeaders -> H.ResponseHeaders
-replaceHeader k v hdrs = (k,v) : deleteBy ((==) `on` fst) (k,v) hdrs
+replaceHeader
+    :: H.HeaderName -> HeaderValue -> H.ResponseHeaders -> H.ResponseHeaders
+replaceHeader k v hdrs = (k, v) : deleteBy ((==) `on` fst) (k, v) hdrs
 
 ----------------------------------------------------------------
 
-composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
+composeHeaderBuilder
+    :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
 composeHeaderBuilder ver s hs True =
     byteString <$> composeHeader ver s (addTransferEncoding hs)
 composeHeaderBuilder ver s hs False =
diff --git a/Network/Wai/Handler/Warp/ResponseHeader.hs b/Network/Wai/Handler/Warp/ResponseHeader.hs
--- a/Network/Wai/Handler/Warp/ResponseHeader.hs
+++ b/Network/Wai/Handler/Warp/ResponseHeader.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.ResponseHeader (composeHeader) where
 
@@ -7,6 +7,7 @@
 import Data.ByteString.Internal (create)
 import qualified Data.CaseInsensitive as CI
 import Data.List (foldl')
+import Data.Word8
 import Foreign.Ptr
 import GHC.Storable
 import qualified Network.HTTP.Types as H
@@ -23,7 +24,7 @@
     void $ copyCRLF ptr2
   where
     !len = 17 + slen + foldl' fieldLength 0 responseHeaders
-    fieldLength !l (!k,!v) = l + S.length (CI.original k) + S.length v + 4
+    fieldLength !l (!k, !v) = l + S.length (CI.original k) + S.length v + 4
     !slen = S.length $ H.statusMessage status
 
 httpVer11 :: ByteString
@@ -36,50 +37,39 @@
 copyStatus :: Ptr Word8 -> H.HttpVersion -> H.Status -> IO (Ptr Word8)
 copyStatus !ptr !httpversion !status = do
     ptr1 <- copy ptr httpVer
-    writeWord8OffPtr ptr1 0 (zero + fromIntegral r2)
-    writeWord8OffPtr ptr1 1 (zero + fromIntegral r1)
-    writeWord8OffPtr ptr1 2 (zero + fromIntegral r0)
-    writeWord8OffPtr ptr1 3 spc
+    writeWord8OffPtr ptr1 0 (_0 + fromIntegral r2)
+    writeWord8OffPtr ptr1 1 (_0 + fromIntegral r1)
+    writeWord8OffPtr ptr1 2 (_0 + fromIntegral r0)
+    writeWord8OffPtr ptr1 3 _space
     ptr2 <- copy (ptr1 `plusPtr` 4) (H.statusMessage status)
     copyCRLF ptr2
   where
     httpVer
-      | httpversion == H.HttpVersion 1 1 = httpVer11
-      | otherwise = httpVer10
-    (q0,r0) = H.statusCode status `divMod` 10
-    (q1,r1) = q0 `divMod` 10
+        | httpversion == H.HttpVersion 1 1 = httpVer11
+        | otherwise = httpVer10
+    (q0, r0) = H.statusCode status `divMod` 10
+    (q1, r1) = q0 `divMod` 10
     r2 = q1 `mod` 10
 
 {-# INLINE copyHeaders #-}
 copyHeaders :: Ptr Word8 -> [H.Header] -> IO (Ptr Word8)
 copyHeaders !ptr [] = return ptr
-copyHeaders !ptr (h:hs) = do
+copyHeaders !ptr (h : hs) = do
     ptr1 <- copyHeader ptr h
     copyHeaders ptr1 hs
 
 {-# INLINE copyHeader #-}
 copyHeader :: Ptr Word8 -> H.Header -> IO (Ptr Word8)
-copyHeader !ptr (k,v) = do
+copyHeader !ptr (k, v) = do
     ptr1 <- copy ptr (CI.original k)
-    writeWord8OffPtr ptr1 0 colon
-    writeWord8OffPtr ptr1 1 spc
+    writeWord8OffPtr ptr1 0 _colon
+    writeWord8OffPtr ptr1 1 _space
     ptr2 <- copy (ptr1 `plusPtr` 2) v
     copyCRLF ptr2
 
 {-# INLINE copyCRLF #-}
 copyCRLF :: Ptr Word8 -> IO (Ptr Word8)
 copyCRLF !ptr = do
-    writeWord8OffPtr ptr 0 cr
-    writeWord8OffPtr ptr 1 lf
+    writeWord8OffPtr ptr 0 _cr
+    writeWord8OffPtr ptr 1 _lf
     return $! ptr `plusPtr` 2
-
-zero :: Word8
-zero = 48
-spc :: Word8
-spc = 32
-colon :: Word8
-colon = 58
-cr :: Word8
-cr = 13
-lf :: Word8
-lf = 10
diff --git a/Network/Wai/Handler/Warp/Run.hs b/Network/Wai/Handler/Warp/Run.hs
--- a/Network/Wai/Handler/Warp/Run.hs
+++ b/Network/Wai/Handler/Warp/Run.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
@@ -8,14 +10,37 @@
 module Network.Wai.Handler.Warp.Run where
 
 import Control.Arrow (first)
-import qualified Control.Exception
-import Control.Exception (allowInterrupt)
+import Control.Concurrent.STM (
+    TVar,
+    atomically,
+    check,
+    modifyTVar',
+    newTVarIO,
+    readTVar,
+ )
+import qualified Control.Exception as E
 import qualified Data.ByteString as S
-import Data.IORef (newIORef, readIORef)
+import Data.Functor (($>))
+import Data.IORef (newIORef, readIORef, IORef, writeIORef)
 import Data.Streaming.Network (bindPortTCP)
-import Foreign.C.Error (Errno(..), eCONNABORTED)
-import GHC.IO.Exception (IOException(..), IOErrorType(..))
-import Network.Socket (Socket, close, withSocketsDo, SockAddr, setSocketOption, SocketOption(..), getSocketName)
+import Foreign.C.Error (Errno (..), eCONNABORTED, eMFILE)
+import GHC.Conc.Sync (labelThread, myThreadId)
+import GHC.IO.Exception (IOErrorType (..), IOException (..))
+import Network.Socket (
+    SockAddr,
+    Socket,
+    SocketOption (..),
+    close,
+#if !WINDOWS
+    fdSocket,
+#if MIN_VERSION_network(3,2,2)
+    waitReadSocketSTM,
+#endif
+#endif
+    getSocketName,
+    setSocketOption,
+    withSocketsDo,
+ )
 #if MIN_VERSION_network(3,1,1)
 import Network.Socket (gracefulClose)
 #endif
@@ -26,10 +51,8 @@
 import System.IO.Error (ioeGetErrorType)
 import qualified System.TimeManager as T
 import System.Timeout (timeout)
-import qualified UnliftIO
-import UnliftIO (toException)
 
-import Network.Wai.Handler.Warp.Buffer
+import Network.Wai.Handler.Warp.Buffer (createWriteBuffer)
 import Network.Wai.Handler.Warp.Counter
 import qualified Network.Wai.Handler.Warp.Date as D
 import qualified Network.Wai.Handler.Warp.FdCache as F
@@ -38,77 +61,114 @@
 import Network.Wai.Handler.Warp.HTTP2 (http2)
 import Network.Wai.Handler.Warp.HTTP2.Types (isHTTP2)
 import Network.Wai.Handler.Warp.Imports hiding (readInt)
-import Network.Wai.Handler.Warp.SendFile
+import Network.Wai.Handler.Warp.SendFile (sendFile)
 import Network.Wai.Handler.Warp.Settings
+import Network.Wai.Handler.Warp.ShuttingDown (writeShuttingDown)
 import Network.Wai.Handler.Warp.Types
 
-
-#if WINDOWS
-import Network.Wai.Handler.Warp.Windows
-#else
-import Network.Socket (fdSocket)
-#endif
-
 -- | Creating 'Connection' for plain HTTP based on a given socket.
+--
+-- (N.B. make sure the 'Settings' have an initialized 'ServerState' to guarantee
+-- a graceful shutdown)
 socketConnection :: Settings -> Socket -> IO Connection
-#if MIN_VERSION_network(3,1,1)
 socketConnection set s = do
-#else
-socketConnection _ s = do
-#endif
+    (ss, _) <- makeServerState set
     bufferPool <- newBufferPool 2048 16384
     writeBuffer <- createWriteBuffer 16384
     writeBufferRef <- newIORef writeBuffer
     isH2 <- newIORef False -- HTTP/1.x
     mysa <- getSocketName s
-    return Connection {
-        connSendMany = Sock.sendMany s
-      , connSendAll = sendall
-      , connSendFile = sendfile writeBufferRef
+    appsInProgress <- newTVarIO 0
+    return
+        Connection
+            { connSendMany = Sock.sendMany s
+            , connSendAll = sendall
+            , connSendFile = sendfile writeBufferRef
 #if MIN_VERSION_network(3,1,1)
-      , connClose = do
-            h2 <- readIORef isH2
-            let tm = if h2 then settingsGracefulCloseTimeout2 set
-                           else settingsGracefulCloseTimeout1 set
-            if tm == 0 then
-                close s
-              else
-                gracefulClose s tm `UnliftIO.catchAny` \(UnliftIO.SomeException _) -> return ()
+            , connClose = do
+                h2 <- readIORef isH2
+                let tm =
+                        if h2
+                            then settingsGracefulCloseTimeout2 set
+                            else settingsGracefulCloseTimeout1 set
+                if tm == 0
+                    then close s
+                    else gracefulClose s tm `E.catch` throughAsync (return ())
 #else
-      , connClose = close s
+            , connClose = close s
 #endif
-      , connRecv = receive' s bufferPool
-      , connRecvBuf = \_ _ -> return True -- obsoleted
-      , connWriteBuffer = writeBufferRef
-      , connHTTP2 = isH2
-      , connMySockAddr = mysa
-      }
+            , connRecv = receive' bufferPool ss appsInProgress
+            , connRecvBuf = \_ _ -> return True -- obsoleted
+            , connWriteBuffer = writeBufferRef
+            , connHTTP2 = isH2
+            , connMySockAddr = mysa
+            , connAppsInProgress = appsInProgress
+            }
   where
-    receive' sock pool = UnliftIO.handleIO handler $ receive sock pool
+    receive' bufferPool ss appsInProgress =
+        E.handle handler $ makeGracefulRecv s bufferPool ss appsInProgress
       where
-        handler :: UnliftIO.IOException -> IO ByteString
+        handler :: E.IOException -> IO ByteString
         handler e
-          | ioeGetErrorType e == InvalidArgument = return ""
-          | otherwise                            = UnliftIO.throwIO e
+            | ioeGetErrorType e == InvalidArgument = return ""
+            | otherwise = E.throwIO e
 
     sendfile writeBufferRef fid offset len hook headers = do
-      writeBuffer <- readIORef writeBufferRef
-      sendFile s (bufBuffer writeBuffer) (bufSize writeBuffer) sendall
-        fid offset len hook headers
+        writeBuffer <- readIORef writeBufferRef
+        sendFile
+            s
+            (bufBuffer writeBuffer)
+            (bufSize writeBuffer)
+            sendall
+            fid
+            offset
+            len
+            hook
+            headers
 
     sendall = sendAll' s
 
-    sendAll' sock bs = UnliftIO.handleJust
-      (\ e -> if ioeGetErrorType e == ResourceVanished
-        then Just ConnectionClosedByPeer
-        else Nothing)
-      UnliftIO.throwIO
-      $ Sock.sendAll sock bs
+    sendAll' sock bs =
+        E.handleJust
+            ( \e ->
+                if ioeGetErrorType e == ResourceVanished
+                    then Just ConnectionClosedByPeer
+                    else Nothing
+            )
+            E.throwIO
+            $ Sock.sendAll sock bs
 
+-- | Create a 'Recv' using 'Network.Socket.BufferPool.Recv.receive', but make
+-- it non-blocking with 'waitReadSocketSTM' /AND/ cut off receiving any bytes
+-- when the server is shutting down and there are no more 'Application's
+-- actively using this 'Socket'.
+makeGracefulRecv :: Socket -> BufferPool -> ServerState -> TVar Int -> Recv
+makeGracefulRecv sock pool ss appsInProgress = do
+    sockWait <-
+#if !WINDOWS && MIN_VERSION_network(3,2,2)
+        waitReadSocketSTM sock
+#else
+        -- FIXME: 'waitReadSocketSTM' doesn't work on WINDOWS, and actually
+        -- blocks indefinitely, so we fall back to going straight to 'recv'.
+        pure (pure ())
+#endif
+    isShuttingDown <- atomically $
+        -- when shutting down
+        (checkShutdown $> True)
+        <|>
+        -- else wait for socket readiness and do non-blocking read
+        (sockWait $> False)
+    if isShuttingDown then pure "" else recv
+  where
+    recv = receive sock pool
+    checkShutdown = do
+       check =<< currentShuttingDownStateSTM ss
+       check . (<= 0) =<< readTVar appsInProgress
+
 -- | Run an 'Application' on the given port.
 -- This calls 'runSettings' with 'defaultSettings'.
 run :: Port -> Application -> IO ()
-run p = runSettings defaultSettings { settingsPort = p }
+run p = runSettings defaultSettings{settingsPort = p}
 
 -- | Run an 'Application' on the port present in the @PORT@
 -- environment variable. Uses the 'Port' given when the variable is unset.
@@ -120,24 +180,25 @@
     mp <- lookupEnv "PORT"
 
     maybe (run p app) runReadPort mp
-
   where
     runReadPort :: String -> IO ()
     runReadPort sp = case reads sp of
-        ((p', _):_) -> run p' app
+        ((p', _) : _) -> run p' app
         _ -> fail $ "Invalid value in $PORT: " ++ sp
 
 -- | Run an 'Application' with the given 'Settings'.
 -- This opens a listen socket on the port defined in 'Settings' and
 -- calls 'runSettingsSocket'.
 runSettings :: Settings -> Application -> IO ()
-runSettings set app = withSocketsDo $
-    UnliftIO.bracket
-        (bindPortTCP (settingsPort set) (settingsHost set))
-        close
-        (\socket -> do
-            setSocketCloseOnExec socket
-            runSettingsSocket set socket app)
+runSettings set app =
+    withSocketsDo $
+        E.bracket
+            (bindPortTCP (settingsPort set) (settingsHost set))
+            close
+            ( \socket -> do
+                setSocketCloseOnExec socket
+                runSettingsSocket set socket app
+            )
 
 -- | This installs a shutdown handler for the given socket and
 -- calls 'runSettingsConnection' with the default connection setup action
@@ -151,15 +212,16 @@
 -- Note that the 'settingsPort' will still be passed to 'Application's via the
 -- 'serverPort' record.
 runSettingsSocket :: Settings -> Socket -> Application -> IO ()
-runSettingsSocket set@Settings{settingsAccept = accept'} socket app = do
-    settingsInstallShutdownHandler set closeListenSocket
-    runSettingsConnection set getConn app
+runSettingsSocket oldSettings@Settings{settingsAccept = accept'} socket app = do
+    settingsInstallShutdownHandler oldSettings closeListenSocket
+    (_, newSettings) <- makeServerState oldSettings
+    runSettingsConnection newSettings (getConn newSettings) app
   where
-    getConn = do
+    getConn set = do
         (s, sa) <- accept' socket
         setSocketCloseOnExec s
         -- NoDelay causes an error for AF_UNIX.
-        setSocketOption s NoDelay 1 `UnliftIO.catchAny` \(UnliftIO.SomeException _) -> return ()
+        setSocketOption s NoDelay 1 `E.catch` throughAsync (return ())
         conn <- socketConnection set s
         return (conn, sa)
 
@@ -174,20 +236,22 @@
 -- in a separate worker thread instead of the main server loop.
 --
 -- Since 1.3.5
-runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
+runSettingsConnection
+    :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
 runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMaker app
   where
     getConnMaker = do
-      (conn, sa) <- getConn
-      return (return conn, sa)
+        (conn, sa) <- getConn
+        return (return conn, sa)
 
 -- | This modifies the connection maker so that it returns 'TCP' for 'Transport'
 -- (i.e. plain HTTP) then calls 'runSettingsConnectionMakerSecure'.
-runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()
+runSettingsConnectionMaker
+    :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()
 runSettingsConnectionMaker x y =
     runSettingsConnectionMakerSecure x (toTCP <$> y)
   where
-    toTCP = first ((, TCP) <$>)
+    toTCP = first ((,TCP) <$>)
 
 ----------------------------------------------------------------
 
@@ -197,11 +261,14 @@
 -- or HTTP over TLS.
 --
 -- Since 2.1.4
-runSettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Transport), SockAddr) -> Application -> IO ()
-runSettingsConnectionMakerSecure set getConnMaker app = do
-    settingsBeforeMainLoop set
-    counter <- newCounter
-    withII set $ acceptConnection set getConnMaker app counter
+runSettingsConnectionMakerSecure
+    :: Settings -> IO (IO (Connection, Transport), SockAddr) -> Application -> IO ()
+runSettingsConnectionMakerSecure oldSettings getConnMaker app = do
+    settingsBeforeMainLoop oldSettings
+    (ServerState{serverConnectionCounter}, newSettings) <- makeServerState oldSettings
+    withII newSettings $ \ii ->
+        initFdExhaustionRef >>=
+            acceptConnection newSettings getConnMaker app serverConnectionCounter ii
 
 -- | Running an action with internal info.
 --
@@ -209,21 +276,22 @@
 withII :: Settings -> (InternalInfo -> IO a) -> IO a
 withII set action =
     withTimeoutManager $ \tm ->
-    D.withDateCache $ \dc ->
-    F.withFdCache fdCacheDurationInSeconds $ \fdc ->
-    I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do
-        let ii = InternalInfo tm dc fdc fic
-        action ii
+        D.withDateCache $ \dc ->
+            F.withFdCache fdCacheDurationInMicroseconds $ \fdc ->
+                I.withFileInfoCache fdFileInfoDurationInMicroseconds $ \fic -> do
+                    let ii = InternalInfo tm dc fdc fic
+                    action ii
   where
-    !fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
-    !fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000
-    !timeoutInSeconds = settingsTimeout set * 1000000
+    !fdCacheDurationInMicroseconds = settingsFdCacheDuration set * 1000000
+    !fdFileInfoDurationInMicroseconds = settingsFileInfoCacheDuration set * 1000000
+    !timeoutInMicroseconds = settingsTimeout set * 1000000
     withTimeoutManager f = case settingsManager set of
         Just tm -> f tm
-        Nothing -> UnliftIO.bracket
-                   (T.initialize timeoutInSeconds)
-                   T.stopManager
-                   f
+        Nothing ->
+            E.bracket
+                (T.initialize timeoutInMicroseconds)
+                T.stopManager
+                f
 
 -- Note that there is a thorough discussion of the exception safety of the
 -- following code at: https://github.com/yesodweb/wai/issues/146
@@ -238,19 +306,24 @@
 --    async exceptions.
 --
 -- Our approach is explained in the comments below.
-acceptConnection :: Settings
-                 -> IO (IO (Connection, Transport), SockAddr)
-                 -> Application
-                 -> Counter
-                 -> InternalInfo
-                 -> IO ()
-acceptConnection set getConnMaker app counter ii = do
+acceptConnection
+    :: Settings
+    -> IO (IO (Connection, Transport), SockAddr)
+    -> Application
+    -> Counter
+    -> InternalInfo
+    -> IORef FdExhaustion
+        -- ^ This ref will be used to "debounce" the call to 'settingsOnException'
+        -- when we hit an 'IOError' with 'eMFILE' in the case that Warp is not
+        -- the reason the file descriptors are exhausted.
+    -> IO ()
+acceptConnection set getConnMaker app counter ii fdRef = do
     -- First mask all exceptions in acceptLoop. This is necessary to
     -- ensure that no async exception is throw between the call to
     -- acceptNewConnection and the registering of connClose.
     --
     -- acceptLoop can be broken by closing the listening socket.
-    void $ UnliftIO.mask_ acceptLoop
+    void $ E.mask_ acceptLoop
     -- In some cases, we want to stop Warp here without graceful shutdown.
     -- So, async exceptions are allowed here.
     -- That's why `finally` is not used.
@@ -258,7 +331,7 @@
   where
     acceptLoop = do
         -- Allow async exceptions before receiving the next connection maker.
-        allowInterrupt
+        E.allowInterrupt
 
         -- acceptNewConnection will try to receive the next incoming
         -- request. It returns a /connection maker/, not a connection,
@@ -269,34 +342,65 @@
         -- negotiation.
         mx <- acceptNewConnection
         case mx of
-            Nothing             -> return ()
+            Nothing -> return ()
             Just (mkConn, addr) -> do
                 fork set mkConn addr app counter ii
                 acceptLoop
 
     acceptNewConnection = do
-        ex <- UnliftIO.tryIO getConnMaker
+        ex <- E.try getConnMaker
         case ex of
-            Right x -> return $ Just x
+            Right x -> do
+                -- Important to mark the exhaustion issue to be resolved
+                -- when we get connections again.
+                resetFdExhaustion fdRef
+                return $ Just x
             Left e -> do
-                let eConnAborted = getErrno eCONNABORTED
-                    getErrno (Errno cInt) = cInt
-                if ioe_errno e == Just eConnAborted
-                    then acceptNewConnection
-                    else do
-                        settingsOnException set Nothing $ toException e
+                let getErrno (Errno cInt) = cInt
+                    isErrno err = ioe_errno e == Just (getErrno err)
+                if | isErrno eCONNABORTED -> do
+                        -- Important to mark the exhaustion issue to be resolved
+                        resetFdExhaustion fdRef
+                        acceptNewConnection
+                     -- Keep in mind to reset the ref when anything other
+                     -- than this branch runs
+                   | isErrno eMFILE -> do
+                        handleFdExhaustion e
+                        acceptNewConnection
+                   | otherwise -> do
+                        -- Maybe not important to mark the exhaustion issue
+                        -- as resolved here, but just for completeness' sake.
+                        resetFdExhaustion fdRef
+                        settingsOnException set Nothing $ E.toException e
                         return Nothing
 
+    handleFdExhaustion e = do
+        fdExhaustion <- readIORef fdRef
+        -- If file descriptors are exhausted while Warp has
+        -- no current connections, 'settingsOnException' would
+        -- get called an enormous amount of times per second.
+        when (fdExhaustion /= FdExhausted) $
+            settingsOnException set Nothing $ E.toException e
+        hasDecreased <- waitForDecreased counter
+        -- If we get 'NoConnections', that means the file
+        -- descriptor exhaustion is outside of our control.
+        -- We flag it so that 'settingsOnException' doesn't get
+        -- called until the exhaustion issue is resolved.
+        when (hasDecreased == NoConnections) $ setFdExhaustion fdRef
+
 -- Fork a new worker thread for this connection maker, and ask for a
 -- function to unmask (i.e., allow async exceptions to be thrown).
-fork :: Settings
-     -> IO (Connection, Transport)
-     -> SockAddr
-     -> Application
-     -> Counter
-     -> InternalInfo
-     -> IO ()
-fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
+fork
+    :: Settings
+    -> IO (Connection, Transport)
+    -> SockAddr
+    -> Application
+    -> Counter
+    -> InternalInfo
+    -> IO ()
+fork set mkConn addr app counter ii = settingsFork set $ \unmask -> do
+    tid <- myThreadId
+    labelThread tid "Warp just forked"
     -- Call the user-supplied on exception code if any
     -- exceptions are thrown.
     --
@@ -304,7 +408,7 @@
     -- catch all exceptions and avoid them from propagating, even
     -- async exceptions. See:
     -- https://github.com/yesodweb/wai/issues/850
-    Control.Exception.handle (settingsOnException set Nothing) $
+    E.handle (settingsOnException set Nothing) $
         -- Run the connection maker to get a new connection, and ensure
         -- that the connection is closed. If the mkConn call throws an
         -- exception, we will leak the connection. If the mkConn call is
@@ -315,54 +419,77 @@
         -- We grab the connection before registering timeouts since the
         -- timeouts will be useless during connection creation, due to the
         -- fact that async exceptions are still masked.
-        UnliftIO.bracket mkConn cleanUp (serve unmask)
+        E.bracket mkConn cleanUp (serve unmask)
   where
-    cleanUp (conn, _) = connClose conn `UnliftIO.finally` do
-                          writeBuffer <- readIORef $ connWriteBuffer conn
-                          bufFree writeBuffer
+    cleanUp (conn, _) =
+        connClose conn `E.finally` do
+            writeBuffer <- readIORef $ connWriteBuffer conn
+            bufFree writeBuffer
 
     -- We need to register a timeout handler for this thread, and
     -- cancel that handler as soon as we exit.
-    serve unmask (conn, transport) = UnliftIO.bracket register cancel $ \th -> do
+    serve unmask (conn, transport) = T.withHandleKillThread (timeoutManager ii) (return ()) $ \th -> do
         -- We now have fully registered a connection close handler in
         -- the case of all exceptions, so it is safe to once again
         -- allow async exceptions.
-        unmask .
+        unmask
+            .
             -- Call the user-supplied code for connection open and
             -- close events
-           UnliftIO.bracket (onOpen addr) (onClose addr) $ \goingon ->
-           -- Actually serve this connection.  bracket with closeConn
-           -- above ensures the connection is closed.
-           when goingon $ serveConnection conn ii th addr transport set app
-      where
-        register = T.registerKillThread (timeoutManager ii) (connClose conn)
-        cancel   = T.cancel
+            E.bracket (onOpen addr) (onClose addr)
+            $ \goingon ->
+                -- Actually serve this connection.  bracket with closeConn
+                -- above ensures the connection is closed.
+                when goingon $ serveConnection conn ii th addr transport set app
 
-    onOpen adr    = increase counter >> settingsOnOpen  set adr
+    onOpen adr = increase counter >> settingsOnOpen set adr
     onClose adr _ = decrease counter >> settingsOnClose set adr
 
-serveConnection :: Connection
-                -> InternalInfo
-                -> T.Handle
-                -> SockAddr
-                -> Transport
-                -> Settings
-                -> Application
-                -> IO ()
+serveConnection
+    :: Connection
+    -> InternalInfo
+    -> T.Handle
+    -> SockAddr
+    -> Transport
+    -> Settings
+    -> Application
+    -> IO ()
 serveConnection conn ii th origAddr transport settings app = do
     -- fixme: Upgrading to HTTP/2 should be supported.
-    (h2,bs) <- if isHTTP2 transport then
-                   return (True, "")
-                 else do
-                   bs0 <- connRecv conn
-                   if S.length bs0 >= 4 && "PRI " `S.isPrefixOf` bs0 then
-                       return (True, bs0)
-                     else
-                       return (False, bs0)
-    if settingsHTTP2Enabled settings && h2 then do
-        http2 settings ii conn transport app origAddr th bs
-      else do
-        http1 settings ii conn transport app origAddr th bs
+    tid <- myThreadId
+    (h2, bs) <-
+        if isHTTP2 transport
+            then return (True, "")
+            else do
+                bs0 <- recv4 ""
+                if "PRI " `S.isPrefixOf` bs0
+                    then return (True, bs0)
+                    else return (False, bs0)
+    let appsInProgress = connAppsInProgress conn
+        app' req rsp =
+            E.bracket_
+                (atomically $ modifyTVar' appsInProgress $ (+ 1))
+                (atomically $ modifyTVar' appsInProgress $ \i -> (i - 1))
+                $ app req rsp
+    if settingsHTTP2Enabled settings && h2
+        then do
+            labelThread tid ("Warp HTTP/2 " ++ show origAddr)
+            http2 settings ii conn transport app' origAddr th bs
+        else do
+            labelThread tid ("Warp HTTP/1.1 " ++ show origAddr)
+            http1 settings ii conn transport app' origAddr th bs
+  where
+    recv4 bs0 = do
+        bs1 <- connRecv conn
+        if S.null bs1 then
+            return bs0
+          else do
+            -- In the case where bs0 is "", (<>) is called unnecessarily.
+            -- But we adopt this logic for simplicity.
+            let bs2 = bs0 <> bs1
+            if S.length bs2 >= 4
+                 then return bs2
+                 else recv4 bs2
 
 -- | Set flag FileCloseOnExec flag on a socket (on Unix)
 --
@@ -383,10 +510,29 @@
 #endif
 
 gracefulShutdown :: Settings -> Counter -> IO ()
-gracefulShutdown set counter =
+gracefulShutdown set counter = do
+    setShuttingDown
     case settingsGracefulShutdownTimeout set of
         Nothing ->
             waitForZero counter
         (Just seconds) ->
             void (timeout (seconds * microsPerSecond) (waitForZero counter))
-            where microsPerSecond = 1000000
+  where
+    microsPerSecond = 1000000
+    setShuttingDown =
+        case settingsServerState set of
+            Nothing -> pure ()
+            Just ServerState{serverShuttingDown} ->
+                writeShuttingDown serverShuttingDown True
+
+data FdExhaustion = NoFdIssue | FdExhausted
+    deriving (Eq, Show)
+
+initFdExhaustionRef :: IO (IORef FdExhaustion)
+initFdExhaustionRef = newIORef NoFdIssue
+
+resetFdExhaustion :: IORef FdExhaustion -> IO ()
+resetFdExhaustion = flip writeIORef NoFdIssue
+
+setFdExhaustion :: IORef FdExhaustion -> IO ()
+setFdExhaustion = flip writeIORef FdExhausted
diff --git a/Network/Wai/Handler/Warp/SendFile.hs b/Network/Wai/Handler/Warp/SendFile.hs
--- a/Network/Wai/Handler/Warp/SendFile.hs
+++ b/Network/Wai/Handler/Warp/SendFile.hs
@@ -1,13 +1,14 @@
-{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
 
 module Network.Wai.Handler.Warp.SendFile (
-    sendFile
-  , readSendFile
-  , packHeader -- for testing
+    sendFile,
+    readSendFile,
+    packHeader, -- for testing
 #ifndef WINDOWS
-  , positionRead
+    positionRead,
 #endif
-  ) where
+) where
 
 import qualified Data.ByteString as BS
 import Network.Socket (Socket)
@@ -18,7 +19,7 @@
 import Foreign.Ptr (plusPtr)
 import qualified System.IO as IO
 #else
-import qualified UnliftIO
+import qualified Control.Exception as E
 import Foreign.C.Error (throwErrno)
 import Foreign.C.Types
 import Foreign.Ptr (Ptr, castPtr, plusPtr)
@@ -42,8 +43,8 @@
 #ifdef SENDFILEFD
 sendFile s _ _ _ fid off len act hdr = case mfid of
     -- settingsFdCacheDuration is 0
-    Nothing -> sendfileWithHeader   s path (PartOfFile off len) act hdr
-    Just fd -> sendfileFdWithHeader s fd   (PartOfFile off len) act hdr
+    Nothing -> sendfileWithHeader s path (PartOfFile off len) act hdr
+    Just fd -> sendfileFdWithHeader s fd (PartOfFile off len) act hdr
   where
     mfid = fileIdFd fid
     path = fileIdPath fid
@@ -53,31 +54,35 @@
 
 ----------------------------------------------------------------
 
-packHeader :: Buffer -> BufSize -> (ByteString -> IO ())
-           -> IO () -> [ByteString]
-           -> Int
-           -> IO Int
-packHeader _   _   _    _    [] n = return n
-packHeader buf siz send hook (bs:bss) n
-  | len < room = do
-      let dst = buf `plusPtr` n
-      void $ copy dst bs
-      packHeader buf siz send hook bss (n + len)
-  | otherwise  = do
-      let dst = buf `plusPtr` n
-          (bs1, bs2) = BS.splitAt room bs
-      void $ copy dst bs1
-      bufferIO buf siz send
-      hook
-      packHeader buf siz send hook (bs2:bss) 0
+packHeader
+    :: Buffer
+    -> BufSize
+    -> (ByteString -> IO ())
+    -> IO ()
+    -> [ByteString]
+    -> Int
+    -> IO Int
+packHeader _ _ _ _ [] n = return n
+packHeader buf siz send hook (bs : bss) n
+    | len < room = do
+        let dst = buf `plusPtr` n
+        void $ copy dst bs
+        packHeader buf siz send hook bss (n + len)
+    | otherwise = do
+        let dst = buf `plusPtr` n
+            (bs1, bs2) = BS.splitAt room bs
+        void $ copy dst bs1
+        bufferIO buf siz send
+        hook
+        packHeader buf siz send hook (bs2 : bss) 0
   where
     len = BS.length bs
     room = siz - n
 
 mini :: Int -> Integer -> Int
 mini i n
-  | fromIntegral i < n = i
-  | otherwise          = fromIntegral n
+    | fromIntegral i < n = i
+    | otherwise = fromIntegral n
 
 -- | Function to send a file based on pread()\/send() for Unix.
 --   This makes use of the file descriptor cache.
@@ -101,50 +106,51 @@
   where
     path = fileIdPath fid
     loop h fptr len
-      | len <= 0  = return ()
-      | otherwise = do
-        n <- IO.hGetBufSome h buf (mini siz len)
-        when (n /= 0) $ do
-            let bs = PS fptr 0 n
-                n' = fromIntegral n
-            send bs
-            hook
-            loop h fptr (len - n')
+        | len <= 0 = return ()
+        | otherwise = do
+            n <- IO.hGetBufSome h buf (mini siz len)
+            when (n /= 0) $ do
+                let bs = PS fptr 0 n
+                    n' = fromIntegral n
+                send bs
+                hook
+                loop h fptr (len - n')
 #else
 readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
 readSendFile buf siz send fid off0 len0 hook headers =
-  UnliftIO.bracket setup teardown $ \fd -> do
-    hn <- packHeader buf siz send hook headers 0
-    let room = siz - hn
-        buf' = buf `plusPtr` hn
-    n <- positionRead fd buf' (mini room len0) off0
-    bufferIO buf (hn + n) send
-    hook
-    let n' = fromIntegral n
-    loop fd (len0 - n') (off0 + n')
+    E.bracket setup teardown $ \fd -> do
+        hn <- packHeader buf siz send hook headers 0
+        let room = siz - hn
+            buf' = buf `plusPtr` hn
+        n <- positionRead fd buf' (mini room len0) off0
+        bufferIO buf (hn + n) send
+        hook
+        let n' = fromIntegral n
+        loop fd (len0 - n') (off0 + n')
   where
     path = fileIdPath fid
     setup = case fileIdFd fid of
-       Just fd -> return fd
-       Nothing -> openFile path
+        Just fd -> return fd
+        Nothing -> openFile path
     teardown fd = case fileIdFd fid of
-       Just _  -> return ()
-       Nothing -> closeFile fd
+        Just _ -> return ()
+        Nothing -> closeFile fd
     loop fd len off
-      | len <= 0  = return ()
-      | otherwise = do
-          n <- positionRead fd buf (mini siz len) off
-          bufferIO buf n send
-          let n' = fromIntegral n
-          hook
-          loop fd (len - n') (off + n')
+        | len <= 0 = return ()
+        | otherwise = do
+            n <- positionRead fd buf (mini siz len) off
+            bufferIO buf n send
+            let n' = fromIntegral n
+            hook
+            loop fd (len - n') (off + n')
 
 positionRead :: Fd -> Buffer -> BufSize -> Integer -> IO Int
 positionRead fd buf siz off = do
-    bytes <- fromIntegral <$> c_pread fd (castPtr buf) (fromIntegral siz) (fromIntegral off)
+    bytes <-
+        fromIntegral <$> c_pread fd (castPtr buf) (fromIntegral siz) (fromIntegral off)
     when (bytes < 0) $ throwErrno "positionRead"
     return bytes
 
 foreign import ccall unsafe "pread"
-  c_pread :: Fd -> Ptr CChar -> ByteCount -> FileOffset -> IO CSsize
+    c_pread :: Fd -> Ptr CChar -> ByteCount -> FileOffset -> IO CSsize
 #endif
diff --git a/Network/Wai/Handler/Warp/Settings.hs b/Network/Wai/Handler/Warp/Settings.hs
--- a/Network/Wai/Handler/Warp/Settings.hs
+++ b/Network/Wai/Handler/Warp/Settings.hs
@@ -1,34 +1,49 @@
-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ViewPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE ImpredicativeTypes, CPP #-}
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Network.Wai.Handler.Warp.Settings where
 
-import GHC.IO (unsafeUnmask, IO (IO))
-import GHC.Prim (fork#)
-import UnliftIO (SomeException, fromException)
-import qualified Data.ByteString.Char8 as C8
+import Control.Concurrent.STM (STM)
+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.Exception (IOErrorType(..), AsyncException (ThreadKilled))
+import GHC.Exts (fork#)
+import GHC.IO (IO (IO), unsafeUnmask)
+import GHC.IO.Exception (IOErrorType (..))
 import qualified Network.HTTP.Types as H
-import Network.Socket (Socket, SockAddr, accept)
+import Network.Socket (SockAddr, Socket, accept)
 import Network.Wai
-import qualified Paths_warp
 import System.IO (stderr)
 import System.IO.Error (ioeGetErrorType)
 import System.TimeManager
 
+import Network.Wai.Handler.Warp.Counter (Counter, getCount, newCounter, getCountSTM)
 import Network.Wai.Handler.Warp.Imports
+import Network.Wai.Handler.Warp.ShuttingDown (
+    ShuttingDown,
+    newShuttingDown,
+    readShuttingDown,
+    readShuttingDownSTM,
+ )
 import Network.Wai.Handler.Warp.Types
 #if WINDOWS
 import Network.Wai.Handler.Warp.Windows (windowsThreadBlockHack)
 #endif
 
+#ifdef INCLUDE_WARP_VERSION
+import Data.Version (showVersion)
+import qualified Paths_warp
+#endif
+
 -- | Various Warp server settings. This is purposely kept as an abstract data
 -- type so that new settings can be added without breaking backwards
 -- compatibility. In order to create a 'Settings' value, use 'defaultSettings'
@@ -36,179 +51,304 @@
 --
 -- > setTimeout 20 defaultSettings
 data Settings = Settings
-    { settingsPort :: Port -- ^ Port to listen on. Default value: 3000
-    , settingsHost :: HostPreference -- ^ Default value: HostIPv4
-    , settingsOnException :: Maybe Request -> SomeException -> IO () -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.
+    { settingsPort :: Port
+    -- ^ Port to listen on. Default value: 3000
+    , settingsHost :: HostPreference
+    -- ^ Default value: HostIPv4
+    , settingsOnException :: Maybe Request -> SomeException -> IO ()
+    -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.
     , settingsOnExceptionResponse :: SomeException -> Response
-      -- ^ A function to create `Response` when an exception occurs.
-      --
-      -- Default: 500, text/plain, \"Something went wrong\"
-      --
-      -- Since 2.0.3
-    , settingsOnOpen :: SockAddr -> IO Bool -- ^ What to do when a connection is open. When 'False' is returned, the connection is closed immediately. Otherwise, the connection is going on. Default: always returns 'True'.
-    , settingsOnClose :: SockAddr -> IO ()  -- ^ What to do when a connection is close. Default: do nothing.
-    , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
-    , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'
-    , settingsFdCacheDuration :: Int -- ^ Cache duration time of file descriptors in seconds. 0 means that the cache mechanism is not used. Default value: 0
-    , settingsFileInfoCacheDuration :: Int -- ^ Cache duration time of file information in seconds. 0 means that the cache mechanism is not used. Default value: 0
+    -- ^ A function to create `Response` when an exception occurs.
+    --
+    -- Default: 500, text/plain, \"Something went wrong\"
+    --
+    -- Since 2.0.3
+    , settingsOnOpen :: SockAddr -> IO Bool
+    -- ^ What to do when a connection is open. When 'False' is returned, the connection is closed immediately. Otherwise, the connection is going on. Default: always returns 'True'.
+    , settingsOnClose :: SockAddr -> IO ()
+    -- ^ What to do when a connection is close. Default: do nothing.
+    , settingsTimeout :: Int
+    -- ^ Timeout value in seconds. Default value: 30
+    , settingsManager :: Maybe Manager
+    -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'
+    , settingsFdCacheDuration :: Int
+    -- ^ Cache duration time of file descriptors in seconds. 0 means that the cache mechanism is not used. Default value: 0
+    , settingsFileInfoCacheDuration :: Int
+    -- ^ Cache duration time of file information in seconds. 0 means that the cache mechanism is not used. Default value: 0
     , settingsBeforeMainLoop :: IO ()
-      -- ^ Code to run after the listening socket is ready but before entering
-      -- the main event loop. Useful for signaling to tests that they can start
-      -- running, or to drop permissions after binding to a restricted port.
-      --
-      -- Default: do nothing.
-      --
-      -- Since 1.3.6
-
+    -- ^ Code to run after the listening socket is ready but before entering
+    -- the main event loop. Useful for signaling to tests that they can start
+    -- running, or to drop permissions after binding to a restricted port.
+    --
+    -- Default: do nothing.
+    --
+    -- Since 1.3.6
     , settingsFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
-      -- ^ Code to fork a new thread to accept a connection.
-      --
-      -- This may be useful if you need OS bound threads, or if
-      -- you wish to develop an alternative threading model.
-      --
-      -- Default: 'defaultFork'
-      --
-      -- Since 3.0.4
-
+    -- ^ Code to fork a new thread to accept a connection.
+    --
+    -- This may be useful if you need OS bound threads, or if
+    -- you wish to develop an alternative threading model.
+    --
+    -- Default: 'defaultFork'
+    --
+    -- Since 3.0.4
     , settingsAccept :: Socket -> IO (Socket, SockAddr)
-      -- ^ Code to accept a new connection.
-      --
-      -- Useful if you need to provide connected sockets from something other
-      -- than a standard accept call.
-      --
-      -- Default: 'defaultAccept'
-      --
-      -- Since 3.3.24
-
+    -- ^ Code to accept a new connection.
+    --
+    -- Useful if you need to provide connected sockets from something other
+    -- than a standard accept call.
+    --
+    -- Default: 'defaultAccept'
+    --
+    -- Since 3.3.24
     , settingsNoParsePath :: Bool
-      -- ^ Perform no parsing on the rawPathInfo.
-      --
-      -- This is useful for writing HTTP proxies.
-      --
-      -- Default: False
-      --
-      -- Since 2.0.3
+    -- ^ Perform no parsing on the rawPathInfo.
+    --
+    -- This is useful for writing HTTP proxies.
+    --
+    -- Default: False
+    --
+    -- Since 2.0.3
     , settingsInstallShutdownHandler :: IO () -> IO ()
-      -- ^ An action to install a handler (e.g. Unix signal handler)
-      -- to close a listen socket.
-      -- The first argument is an action to close the listen socket.
-      --
-      -- Default: no action
-      --
-      -- Since 3.0.1
+    -- ^ An action to install a handler (e.g. Unix signal handler)
+    -- to close a listen socket.
+    -- The first argument is an action to close the listen socket.
+    --
+    -- Default: no action
+    --
+    -- Since 3.0.1
     , settingsServerName :: ByteString
-      -- ^ Default server name if application does not set one.
-      --
-      -- Since 3.0.2
+    -- ^ Default server name if application does not set one.
+    --
+    -- Since 3.0.2
     , settingsMaximumBodyFlush :: Maybe Int
-      -- ^ See @setMaximumBodyFlush@.
-      --
-      -- Since 3.0.3
+    -- ^ See @setMaximumBodyFlush@.
+    --
+    -- Since 3.0.3
     , settingsProxyProtocol :: ProxyProtocol
-      -- ^ Specify usage of the PROXY protocol.
-      --
-      -- Since 3.0.5
+    -- ^ Specify usage of the PROXY protocol.
+    --
+    -- Since 3.0.5
     , settingsSlowlorisSize :: Int
-      -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048
-      --
-      -- Since 3.1.2
+    -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048
+    --
+    -- Since 3.1.2
     , settingsHTTP2Enabled :: Bool
-      -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True
-      --
-      -- Since 3.1.7
+    -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True
+    --
+    -- Since 3.1.7
     , settingsLogger :: Request -> H.Status -> Maybe Integer -> IO ()
-      -- ^ A log function. Default: no action.
-      --
-      -- Since 3.1.10
+    -- ^ A log function. Default: no action.
+    --
+    -- Since 3.1.10
     , settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()
-      -- ^ A HTTP/2 server push log function. Default: no action.
-      --
-      -- Since 3.2.7
+    -- ^ A HTTP/2 server push log function. Default: no action.
+    --
+    -- Since 3.2.7
     , settingsGracefulShutdownTimeout :: Maybe Int
-      -- ^ An optional timeout to limit the time (in seconds) waiting for
-      -- a graceful shutdown of the web server.
-      --
-      -- Since 3.2.8
+    -- ^ An optional timeout to limit the time (in seconds) waiting for
+    -- a graceful shutdown of the web server.
+    --
+    -- Since 3.2.8
     , settingsGracefulCloseTimeout1 :: Int
-      -- ^ A timeout to limit the time (in milliseconds) waiting for
-      -- FIN for HTTP/1.x. 0 means uses immediate close.
-      -- Default: 0.
-      --
-      -- Since 3.3.5
+    -- ^ A timeout to limit the time (in milliseconds) waiting for
+    -- FIN for HTTP/1.x. 0 means uses immediate close.
+    -- Default: 0.
+    --
+    -- Since 3.3.5
     , settingsGracefulCloseTimeout2 :: Int
-      -- ^ A timeout to limit the time (in milliseconds) waiting for
-      -- FIN for HTTP/2. 0 means uses immediate close.
-      -- Default: 2000.
-      --
-      -- Since 3.3.5
+    -- ^ A timeout to limit the time (in milliseconds) waiting for
+    -- FIN for HTTP/2. 0 means uses immediate close.
+    -- Default: 2000.
+    --
+    -- Since 3.3.5
     , settingsMaxTotalHeaderLength :: Int
-      -- ^ Determines the maximum header size that Warp will tolerate when using HTTP/1.x.
-      --
-      -- Since 3.3.8
+    -- ^ Determines the maximum header size that Warp will tolerate when using HTTP/1.x.
+    --
+    -- Since 3.3.8
     , settingsAltSvc :: Maybe ByteString
-      -- ^ Specify the header value of Alternative Services (AltSvc:).
-      --
-      -- Default: Nothing
-      --
-      -- Since 3.3.11
+    -- ^ Specify the header value of Alternative Services (AltSvc:).
+    --
+    -- Default: Nothing
+    --
+    -- Since 3.3.11
     , settingsMaxBuilderResponseBufferSize :: Int
-      -- ^ Determines the maxium buffer size when sending `Builder` responses
-      -- (See `responseBuilder`).
-      --
-      -- When sending a builder response warp uses a 16 KiB buffer to write the
-      -- builder to. When that buffer is too small to fit the builder warp will
-      -- free it and create a new one that will fit the builder.
-      --
-      -- To protect against allocating too large a buffer warp will error if the
-      -- builder requires more than this maximum.
-      --
-      -- Default: 1049_000_000 = 1 MiB.
-      --
-      -- Since 3.3.22
+    -- ^ Determines the maxium buffer size when sending `Builder` responses
+    -- (See `responseBuilder`).
+    --
+    -- When sending a builder response warp uses a 16 KiB buffer to write the
+    -- builder to. When that buffer is too small to fit the builder warp will
+    -- free it and create a new one that will fit the builder.
+    --
+    -- To protect against allocating too large a buffer warp will error if the
+    -- builder requires more than this maximum.
+    --
+    -- Default: 1049_000_000 = 1 MiB.
+    --
+    -- Since 3.3.22
+    , settingsConnectionCounter :: Maybe Counter
+    -- ^ A counter for tracking open connections.
+    -- Use 'makeSettingsAndCounter' to create settings with a counter,
+    -- then use 'getCount' on the returned 'Counter' to read the current value.
+    --
+    -- Default: 'Nothing' (warp creates an internal counter)
+    --
+    -- /DEPRECATED in favor of 'settingsServerState'/
+    --
+    -- Since 3.4.11
+    , settingsServerState :: Maybe ServerState
+    -- ^ Internal read-only server state.
+    -- Use 'makeSettingsAndServerState' to gain access to the state of the server.
+    -- Using functions like 'currentOpenConnections' or 'currentShuttingDownState'
+    -- to gain insight into the current state of the server.
+    --
+    -- Default: 'Nothing' (warp creates its own internal state)
+    --
+    -- Since 3.4.13
     }
 
 -- | Specify usage of the PROXY protocol.
-data ProxyProtocol = ProxyProtocolNone
-                     -- ^ See @setProxyProtocolNone@.
-                   | ProxyProtocolRequired
-                     -- ^ See @setProxyProtocolRequired@.
-                   | ProxyProtocolOptional
-                     -- ^ See @setProxyProtocolOptional@.
+data ProxyProtocol
+    = -- | See @setProxyProtocolNone@.
+      ProxyProtocolNone
+    | -- | See @setProxyProtocolRequired@.
+      ProxyProtocolRequired
+    | -- | See @setProxyProtocolOptional@.
+      ProxyProtocolOptional
 
+-- | Internal read-only state of the server
+--
+-- Since 3.4.13
+data ServerState = ServerState
+    { serverConnectionCounter :: Counter
+    , serverShuttingDown :: ShuttingDown
+    }
+
+-- | Takes 'Settings' and either returns the 'ServerState'
+-- that was already in there, or creates a new 'ServerState'.
+--
+-- The returned 'Settings' will always contain a 'ServerState'.
+--
+-- This makes it idempotent if care is taken that the @oldSettings@
+-- are not used after using this function.
+--
+-- Since 3.4.13
+makeServerState :: Settings -> IO (ServerState, Settings)
+makeServerState oldSettings =
+    case settingsServerState oldSettings of
+        Just serverState -> pure (serverState, oldSettings)
+        Nothing -> do
+            serverState <- newServerState
+            let counter = serverConnectionCounter serverState
+            pure
+                ( serverState
+                , oldSettings
+                    { settingsServerState = Just serverState
+                    , settingsConnectionCounter = Just counter
+                    }
+                )
+
+-- | Initialize a 'ServerState'
+--
+-- Since 3.4.13
+newServerState :: IO ServerState
+newServerState = do
+    counter <- newCounter
+    shuttingDown <- newShuttingDown
+    pure
+        ServerState
+            { serverConnectionCounter = counter
+            , serverShuttingDown = shuttingDown
+            }
+
+-- | Get the currently open connections of the server.
+--
+-- Since 3.4.13
+currentOpenConnections :: ServerState -> IO Int
+currentOpenConnections = getCount . serverConnectionCounter
+
+-- | Get the currently open connections of the server in an 'STM' transaction.
+--
+-- Since 3.4.13
+currentOpenConnectionsSTM :: ServerState -> STM Int
+currentOpenConnectionsSTM = getCountSTM . serverConnectionCounter
+
+-- | Check if the server is currently shutting down.
+--
+-- > False: Server is not shutting down
+-- > True:  Server is shutting down or has shut down.
+--
+-- Since 3.4.13
+currentShuttingDownState :: ServerState -> IO Bool
+currentShuttingDownState = readShuttingDown . serverShuttingDown
+
+-- | Check if the server is currently shutting down in an 'STM' transaction.
+--
+-- (This way you can have a thread wait for server shutdown with 'Control.Concurrent.STM.retry')
+--
+-- > False: Server is not shutting down
+-- > True:  Server is shutting down or has shut down.
+--
+-- Since 3.4.13
+currentShuttingDownStateSTM :: ServerState -> STM Bool
+currentShuttingDownStateSTM = readShuttingDownSTM . serverShuttingDown
+
 -- | The default settings for the Warp server. See the individual settings for
 -- the default value.
 defaultSettings :: Settings
-defaultSettings = Settings
-    { settingsPort = 3000
-    , settingsHost = "*4"
-    , settingsOnException = defaultOnException
-    , settingsOnExceptionResponse = defaultOnExceptionResponse
-    , settingsOnOpen = const $ return True
-    , settingsOnClose = const $ return ()
-    , settingsTimeout = 30
-    , settingsManager = Nothing
-    , settingsFdCacheDuration = 0
-    , settingsFileInfoCacheDuration = 0
-    , settingsBeforeMainLoop = return ()
-    , settingsFork = defaultFork
-    , settingsAccept = defaultAccept
-    , settingsNoParsePath = False
-    , settingsInstallShutdownHandler = const $ return ()
-    , settingsServerName = C8.pack $ "Warp/" ++ showVersion Paths_warp.version
-    , settingsMaximumBodyFlush = Just 8192
-    , settingsProxyProtocol = ProxyProtocolNone
-    , settingsSlowlorisSize = 2048
-    , settingsHTTP2Enabled = True
-    , settingsLogger = \_ _ _ -> return ()
-    , settingsServerPushLogger = \_ _ _ -> return ()
-    , settingsGracefulShutdownTimeout = Nothing
-    , settingsGracefulCloseTimeout1 = 0
-    , settingsGracefulCloseTimeout2 = 2000
-    , settingsMaxTotalHeaderLength = 50 * 1024
-    , settingsAltSvc = Nothing
-    , settingsMaxBuilderResponseBufferSize = 1049000000
-    }
+defaultSettings =
+    Settings
+        { settingsPort = 3000
+        , settingsHost = "*4"
+        , settingsOnException = defaultOnException
+        , settingsOnExceptionResponse = defaultOnExceptionResponse
+        , settingsOnOpen = const $ return True
+        , settingsOnClose = const $ return ()
+        , settingsTimeout = 30
+        , settingsManager = Nothing
+        , settingsFdCacheDuration = 0
+        , settingsFileInfoCacheDuration = 0
+        , settingsBeforeMainLoop = return ()
+        , settingsFork = defaultFork
+        , settingsAccept = defaultAccept
+        , settingsNoParsePath = False
+        , settingsInstallShutdownHandler = const $ return ()
+        , settingsServerName = C8.pack $ "Warp/" ++ warpVersion
+        , settingsMaximumBodyFlush = Just 8192
+        , settingsProxyProtocol = ProxyProtocolNone
+        , settingsSlowlorisSize = 2048
+        , settingsHTTP2Enabled = True
+        , settingsLogger = \_ _ _ -> return ()
+        , settingsServerPushLogger = \_ _ _ -> return ()
+        , settingsGracefulShutdownTimeout = Nothing
+        , settingsGracefulCloseTimeout1 = 0
+        , settingsGracefulCloseTimeout2 = 2000
+        , settingsMaxTotalHeaderLength = 50 * 1024
+        , settingsAltSvc = Nothing
+        , settingsMaxBuilderResponseBufferSize = 1049000000
+        , settingsConnectionCounter = Nothing
+        , settingsServerState = Nothing
+        }
 
+-- | Create 'defaultSettings' with a connection counter.
+-- Use 'getCount' on the returned 'Counter' to check open connections.
+--
+-- /DEPRECATED in favor of 'makeSettingsAndServerState'/
+--
+-- Since 3.4.11
+makeSettingsAndCounter :: IO (Counter, Settings)
+makeSettingsAndCounter = do
+    (serverState, settings) <- makeSettingsAndServerState
+    pure (serverConnectionCounter serverState, settings)
+
+-- | Create 'defaultSettings' with a 'ServerState'.
+-- Use functions like 'currentOpenConnections' and 'currentShuttingDownState'
+-- to gain insight into the state of the server.
+--
+-- Since 3.4.13
+makeSettingsAndServerState :: IO (ServerState, Settings)
+makeSettingsAndServerState = makeServerState defaultSettings
+
 -- | Apply the logic provided by 'defaultOnException' to determine if an
 -- exception should be shown or not. The goal is to hide exceptions which occur
 -- under the normal course of the web server running.
@@ -216,11 +356,11 @@
 -- 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
+    , et == ResourceVanished || et == InvalidArgument =
+        False
+    | isAsyncException se = False
     | otherwise = True
 
 -- | Printing an exception to standard error
@@ -229,8 +369,10 @@
 -- Since: 3.1.0
 defaultOnException :: Maybe Request -> SomeException -> IO ()
 defaultOnException _ e =
-    when (defaultShouldDisplayException e)
-        $ TIO.hPutStrLn stderr $ T.pack $ show e
+    when (defaultShouldDisplayException e) $
+        TIO.hPutStrLn stderr $
+            T.pack $
+                show e
 
 -- | Sending 400 for bad requests.
 --   Sending 500 for internal server errors.
@@ -240,21 +382,27 @@
 -- Since 3.2.27
 defaultOnExceptionResponse :: SomeException -> Response
 defaultOnExceptionResponse e
-  | Just PayloadTooLarge <-
-    fromException e = responseLBS H.status413
-                                 [(H.hContentType, "text/plain; charset=utf-8")]
-                                  "Payload too large"
-  | Just RequestHeaderFieldsTooLarge <-
-    fromException e = responseLBS H.status431
-                                [(H.hContentType, "text/plain; charset=utf-8")]
-                                 "Request header fields too large"
-  | Just (_ :: InvalidRequest) <-
-    fromException e = responseLBS H.badRequest400
-                                [(H.hContentType, "text/plain; charset=utf-8")]
-                                 "Bad Request"
-  | otherwise       = responseLBS H.internalServerError500
-                                [(H.hContentType, "text/plain; charset=utf-8")]
-                                 "Something went wrong"
+    | isAsyncException e = throw e
+    | Just PayloadTooLarge <- fromException e =
+        responseLBS
+            H.status413
+            [(H.hContentType, "text/plain; charset=utf-8")]
+            "Payload too large"
+    | Just RequestHeaderFieldsTooLarge <- fromException e =
+        responseLBS
+            H.status431
+            [(H.hContentType, "text/plain; charset=utf-8")]
+            "Request header fields too large"
+    | Just (_ :: InvalidRequest) <- fromException e =
+        responseLBS
+            H.badRequest400
+            [(H.hContentType, "text/plain; charset=utf-8")]
+            "Bad Request"
+    | otherwise =
+        responseLBS
+            H.internalServerError500
+            [(H.hContentType, "text/plain; charset=utf-8")]
+            "Something went wrong"
 
 -- | Exception handler for the debugging purpose.
 --   500, text/plain, a showed exception.
@@ -262,9 +410,10 @@
 -- Since: 2.0.3.2
 exceptionResponseForDebug :: SomeException -> Response
 exceptionResponseForDebug e =
-    responseBuilder H.internalServerError500
-                    [(H.hContentType, "text/plain; charset=utf-8")]
-                    $ "Exception: " <> Builder.stringUtf8 (show e)
+    responseBuilder
+        H.internalServerError500
+        [(H.hContentType, "text/plain; charset=utf-8")]
+        $ "Exception: " <> Builder.stringUtf8 (show e)
 
 -- | Similar to @forkIOWithUnmask@, but does not set up the default exception handler.
 --
@@ -276,18 +425,15 @@
 -- @since 3.3.17
 defaultFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
 defaultFork io =
+    IO $ \s0 ->
 #if __GLASGOW_HASKELL__ >= 904
-  IO $ \s0 ->
-    case io unsafeUnmask of
-      IO io' ->
-        case (fork# io' s0) of
-          (# s1, _tid #) ->
-            (# s1, () #)
+        case io unsafeUnmask of
+            IO io' ->
+                case fork# io' s0 of
+                    (# s1, _tid #) -> (# s1, () #)
 #else
-  IO $ \s0 ->
-    case (fork# (io unsafeUnmask) s0) of
-      (# s1, _tid #) ->
-        (# s1, () #)
+        case fork# (io unsafeUnmask) s0 of
+            (# s1, _tid #) -> (# s1, () #)
 #endif
 
 -- | Standard "accept" call for a listening socket.
@@ -299,4 +445,13 @@
     windowsThreadBlockHack . accept
 #else
     accept
+#endif
+
+-- | The version of Warp.
+warpVersion :: String
+warpVersion =
+#ifdef INCLUDE_WARP_VERSION
+  showVersion Paths_warp.version
+#else
+  "unknown"
 #endif
diff --git a/Network/Wai/Handler/Warp/ShuttingDown.hs b/Network/Wai/Handler/Warp/ShuttingDown.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Handler/Warp/ShuttingDown.hs
@@ -0,0 +1,34 @@
+-- Most important is to not export the data constructor from this module
+-- and to not expose 'writeShuttingDown' to the end user.
+module Network.Wai.Handler.Warp.ShuttingDown (
+    ShuttingDown,
+    newShuttingDown,
+    readShuttingDown,
+    readShuttingDownSTM,
+    writeShuttingDown,
+) where
+
+import Control.Concurrent.STM (
+    STM,
+    TVar,
+    atomically,
+    newTVarIO,
+    readTVar,
+    readTVarIO,
+    writeTVar,
+ )
+
+newtype ShuttingDown = ShuttingDown (TVar Bool)
+
+newShuttingDown :: IO ShuttingDown
+newShuttingDown = ShuttingDown <$> newTVarIO False
+
+readShuttingDown :: ShuttingDown -> IO Bool
+readShuttingDown (ShuttingDown var) = readTVarIO var
+
+readShuttingDownSTM :: ShuttingDown -> STM Bool
+readShuttingDownSTM (ShuttingDown var) = readTVar var
+
+writeShuttingDown :: ShuttingDown -> Bool -> IO ()
+writeShuttingDown (ShuttingDown var) b =
+    atomically $ writeTVar var b
diff --git a/Network/Wai/Handler/Warp/Types.hs b/Network/Wai/Handler/Warp/Types.hs
--- a/Network/Wai/Handler/Warp/Types.hs
+++ b/Network/Wai/Handler/Warp/Types.hs
@@ -1,13 +1,12 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.Types where
 
-import qualified UnliftIO
+import Control.Concurrent.STM (TVar)
+import qualified Control.Exception as E
 import qualified Data.ByteString as S
-import Data.IORef (IORef, readIORef, writeIORef, newIORef)
-import Data.Typeable (Typeable)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 #ifdef MIN_VERSION_crypton_x509
 import Data.X509
 #endif
@@ -34,16 +33,19 @@
 ----------------------------------------------------------------
 
 -- | Error types for bad 'Request'.
-data InvalidRequest = NotEnoughLines [String]
-                    | BadFirstLine String
-                    | NonHttp
-                    | IncompleteHeaders
-                    | ConnectionClosedByPeer
-                    | OverLargeHeader
-                    | BadProxyHeader String
-                    | PayloadTooLarge -- ^ Since 3.3.22
-                    | RequestHeaderFieldsTooLarge -- ^ Since 3.3.22
-                    deriving (Eq, Typeable)
+data InvalidRequest
+    = NotEnoughLines [String]
+    | BadFirstLine String
+    | NonHttp
+    | IncompleteHeaders
+    | ConnectionClosedByPeer
+    | OverLargeHeader
+    | BadProxyHeader String
+    | -- | Since 3.3.22
+      PayloadTooLarge
+    | -- | Since 3.3.22
+      RequestHeaderFieldsTooLarge
+    deriving (Eq)
 
 instance Show InvalidRequest where
     show (NotEnoughLines xs) = "Warp: Incomplete request headers, received: " ++ show xs
@@ -51,12 +53,13 @@
     show NonHttp = "Warp: Request line specified a non-HTTP request"
     show IncompleteHeaders = "Warp: Request headers did not finish transmission"
     show ConnectionClosedByPeer = "Warp: Client closed connection prematurely"
-    show OverLargeHeader = "Warp: Request headers too large, possible memory attack detected. Closing connection."
+    show OverLargeHeader =
+        "Warp: Request headers too large, possible memory attack detected. Closing connection."
     show (BadProxyHeader s) = "Warp: Invalid PROXY protocol header: " ++ show s
     show RequestHeaderFieldsTooLarge = "Request header fields too large"
     show PayloadTooLarge = "Payload too large"
 
-instance UnliftIO.Exception InvalidRequest
+instance E.Exception InvalidRequest
 
 ----------------------------------------------------------------
 
@@ -66,11 +69,10 @@
 --
 -- Used to determine whether keeping the HTTP1.1 connection / HTTP2 stream alive is safe
 -- or irrecoverable.
-
-newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody UnliftIO.SomeException
-    deriving (Show, Typeable)
+newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody E.SomeException
+    deriving (Show)
 
-instance UnliftIO.Exception ExceptionInsideResponseBody
+instance E.Exception ExceptionInsideResponseBody
 
 ----------------------------------------------------------------
 
@@ -79,10 +81,10 @@
 --   the file descriptor cache.
 --
 -- Since: 3.1.0
-data FileId = FileId {
-    fileIdPath :: FilePath
-  , fileIdFd   :: Maybe Fd
-  }
+data FileId = FileId
+    { fileIdPath :: FilePath
+    , fileIdFd :: Maybe Fd
+    }
 
 -- |  fileid, offset, length, hook action, HTTP headers
 --
@@ -91,58 +93,64 @@
 
 -- | A write buffer of a specified size
 -- containing bytes and a way to free the buffer.
-data WriteBuffer = WriteBuffer {
-      bufBuffer :: Buffer
-      -- | The size of the write buffer.
+data WriteBuffer = WriteBuffer
+    { bufBuffer :: Buffer
     , bufSize :: !BufSize
-      -- | Free the allocated buffer. Warp guarantees it will only be
-      -- called once, and no other functions will be called after it.
+    -- ^ The size of the write buffer.
     , bufFree :: IO ()
+    -- ^ Free the allocated buffer. Warp guarantees it will only be
+    -- called once, and no other functions will be called after it.
     }
 
 type RecvBuf = Buffer -> BufSize -> IO Bool
 
 -- | Data type to manipulate IO actions for connections.
 --   This is used to abstract IO actions for plain HTTP and HTTP over TLS.
-data Connection = Connection {
-    -- | This is not used at this moment.
-      connSendMany    :: [ByteString] -> IO ()
-    -- | The sending function.
-    , connSendAll     :: ByteString -> IO ()
-    -- | The sending function for files in HTTP/1.1.
-    , connSendFile    :: SendFile
-    -- | The connection closing function. Warp guarantees it will only be
+data Connection = Connection
+    { connSendMany :: [ByteString] -> IO ()
+    -- ^ This is not used at this moment.
+    , connSendAll :: ByteString -> IO ()
+    -- ^ The sending function.
+    , connSendFile :: SendFile
+    -- ^ The sending function for files in HTTP/1.1.
+    , connClose :: IO ()
+    -- ^ The connection closing function. Warp guarantees it will only be
     -- called once. Other functions (like 'connRecv') may be called after
     -- 'connClose' is called.
-    , connClose       :: IO ()
-    -- | The connection receiving function. This returns "" for EOF or exceptions.
-    , connRecv        :: Recv
-    -- | Obsoleted.
-    , connRecvBuf     :: RecvBuf
-    -- | Reference to a write buffer. When during sending of a 'Builder'
+    , connRecv :: Recv
+    -- ^ The connection receiving function. This returns "" for EOF or exceptions.
+    , connRecvBuf :: RecvBuf
+    -- ^ Obsoleted.
+    , connWriteBuffer :: IORef WriteBuffer
+    -- ^ Reference to a write buffer. When during sending of a 'Builder'
     -- response it's detected the current 'WriteBuffer' is too small it will be
     -- freed and a new bigger buffer will be created and written to this
     -- reference.
-    , connWriteBuffer :: IORef WriteBuffer
-    -- | Is this connection HTTP/2?
-    , connHTTP2       :: IORef Bool
-    , connMySockAddr  :: SockAddr
+    , connHTTP2 :: IORef Bool
+    -- ^ Is this connection HTTP/2?
+    , connMySockAddr :: SockAddr
+    , connAppsInProgress :: TVar Int
+    -- ^ Amount of apps currently in progress on this connection.
+    --
+    -- /HTTP2 can handle more than one request concurrently/
+    --
+    -- @since 3.4.13
     }
 
 getConnHTTP2 :: Connection -> IO Bool
-getConnHTTP2 conn = readIORef (connHTTP2 conn)
+getConnHTTP2 = readIORef . connHTTP2
 
 setConnHTTP2 :: Connection -> Bool -> IO ()
-setConnHTTP2 conn b = writeIORef (connHTTP2 conn) b
+setConnHTTP2 = writeIORef . connHTTP2
 
 ----------------------------------------------------------------
 
-data InternalInfo = InternalInfo {
-    timeoutManager :: T.Manager
-  , getDate        :: IO D.GMTDate
-  , getFd          :: FilePath -> IO (Maybe F.Fd, F.Refresh)
-  , getFileInfo    :: FilePath -> IO I.FileInfo
-  }
+data InternalInfo = InternalInfo
+    { timeoutManager :: T.Manager
+    , getDate :: IO D.GMTDate
+    , getFd :: FilePath -> IO (Maybe F.Fd, F.Refresh)
+    , getFileInfo :: FilePath -> IO I.FileInfo
+    }
 
 ----------------------------------------------------------------
 
@@ -168,7 +176,7 @@
 readSource' (Source _ func) = func
 
 leftoverSource :: Source -> ByteString -> IO ()
-leftoverSource (Source ref _) bs = writeIORef ref bs
+leftoverSource (Source ref _) = writeIORef ref
 
 readLeftoverSource :: Source -> IO ByteString
 readLeftoverSource (Source ref _) = readIORef ref
@@ -176,31 +184,35 @@
 ----------------------------------------------------------------
 
 -- | What kind of transport is used for this connection?
-data Transport = TCP -- ^ Plain channel: TCP
-               | TLS {
-                   tlsMajorVersion :: Int
-                 , tlsMinorVersion :: Int
-                 , tlsNegotiatedProtocol :: Maybe ByteString -- ^ The result of Application Layer Protocol Negociation in RFC 7301
-                 , tlsChiperID :: Word16
+data Transport
+    = -- | Plain channel: TCP
+      TCP
+    | TLS
+        { tlsMajorVersion :: Int
+        , tlsMinorVersion :: Int
+        , tlsNegotiatedProtocol :: Maybe ByteString
+        -- ^ The result of Application Layer Protocol Negociation in RFC 7301
+        , tlsChiperID :: Word16
+        -- ^ Encrypted channel: TLS or SSL
 #ifdef MIN_VERSION_crypton_x509
-                 , tlsClientCertificate :: Maybe CertificateChain
+        , tlsClientCertificate :: Maybe CertificateChain
 #endif
-                 }  -- ^ Encrypted channel: TLS or SSL
-               | QUIC {
-                   quicNegotiatedProtocol :: Maybe ByteString
-                 , quicChiperID :: Word16
+        }
+    | QUIC
+        { quicNegotiatedProtocol :: Maybe ByteString
+        , quicChiperID :: Word16
 #ifdef MIN_VERSION_crypton_x509
-                 , quicClientCertificate :: Maybe CertificateChain
+        , quicClientCertificate :: Maybe CertificateChain
 #endif
-                 }
+        }
 
 isTransportSecure :: Transport -> Bool
 isTransportSecure TCP = False
-isTransportSecure _   = True
+isTransportSecure _ = True
 
 isTransportQUIC :: Transport -> Bool
 isTransportQUIC QUIC{} = True
-isTransportQUIC _      = False
+isTransportQUIC _ = False
 
 #ifdef MIN_VERSION_crypton_x509
 getTransportClientCertificate :: Transport -> Maybe CertificateChain
diff --git a/Network/Wai/Handler/Warp/Windows.hs b/Network/Wai/Handler/Warp/Windows.hs
--- a/Network/Wai/Handler/Warp/Windows.hs
+++ b/Network/Wai/Handler/Warp/Windows.hs
@@ -1,14 +1,15 @@
 {-# LANGUAGE CPP #-}
-module Network.Wai.Handler.Warp.Windows
-  ( windowsThreadBlockHack
-  ) where
 
+module Network.Wai.Handler.Warp.Windows (
+    windowsThreadBlockHack,
+) where
+
 #if WINDOWS
 import Control.Concurrent.MVar
 import Control.Concurrent
 import qualified Control.Exception
 
-import Network.Wai.Handler.Warp.Imports
+import GHC.Conc (labelThread)
 
 -- | Allow main socket listening thread to be interrupted on Windows platform
 --
@@ -17,7 +18,8 @@
 windowsThreadBlockHack act = do
     var <- newEmptyMVar :: IO (MVar (Either Control.Exception.SomeException a))
     -- Catch and rethrow even async exceptions, so don't bother with UnliftIO
-    void . forkIO $ Control.Exception.try act >>= putMVar var
+    threadId <- forkIO $ Control.Exception.try act >>= putMVar var
+    labelThread threadId "Windows Thread Block Hack (warp)"
     res <- takeMVar var
     case res of
       Left  e -> Control.Exception.throwIO e
diff --git a/Network/Wai/Handler/Warp/WithApplication.hs b/Network/Wai/Handler/Warp/WithApplication.hs
--- a/Network/Wai/Handler/Warp/WithApplication.hs
+++ b/Network/Wai/Handler/Warp/WithApplication.hs
@@ -1,23 +1,24 @@
 {-# LANGUAGE OverloadedStrings #-}
+
 module Network.Wai.Handler.Warp.WithApplication (
-  withApplication,
-  withApplicationSettings,
-  testWithApplication,
-  testWithApplicationSettings,
-  openFreePort,
-  withFreePort,
+    withApplication,
+    withApplicationSettings,
+    testWithApplication,
+    testWithApplicationSettings,
+    openFreePort,
+    withFreePort,
 ) where
 
-import           Control.Concurrent
-import qualified UnliftIO
-import           UnliftIO.Async
-import           Control.Monad (when)
-import           Data.Streaming.Network (bindRandomPortTCP)
-import           Network.Socket
-import           Network.Wai
-import           Network.Wai.Handler.Warp.Run
-import           Network.Wai.Handler.Warp.Settings
-import           Network.Wai.Handler.Warp.Types
+import Control.Concurrent
+import Control.Concurrent.Async
+import qualified Control.Exception as E
+import Control.Monad (when)
+import Data.Streaming.Network (bindRandomPortTCP)
+import Network.Socket
+import Network.Wai
+import Network.Wai.Handler.Warp.Run
+import Network.Wai.Handler.Warp.Settings
+import Network.Wai.Handler.Warp.Types
 
 -- | Runs the given 'Application' on a free port. Passes the port to the given
 -- operation and executes it, while the 'Application' is running. Shuts down the
@@ -33,20 +34,21 @@
 -- @since 3.2.7
 withApplicationSettings :: Settings -> IO Application -> (Port -> IO a) -> IO a
 withApplicationSettings settings' mkApp action = do
-  app <- mkApp
-  withFreePort $ \ (port, sock) -> do
-    started <- mkWaiter
-    let settings =
-          settings' {
-            settingsBeforeMainLoop
-              = notify started () >> settingsBeforeMainLoop settings'
-          }
-    result <- race
-      (runSettingsSocket settings sock app)
-      (waitFor started >> action port)
-    case result of
-      Left () -> UnliftIO.throwString "Unexpected: runSettingsSocket exited"
-      Right x -> return x
+    app <- mkApp
+    withFreePort $ \(port, sock) -> do
+        started <- mkWaiter
+        let settings =
+                settings'
+                    { settingsBeforeMainLoop =
+                        notify started () >> settingsBeforeMainLoop settings'
+                    }
+        result <-
+            race
+                (runSettingsSocket settings sock app)
+                (waitFor started >> action port)
+        case result of
+            Left () -> E.throwIO $ E.ErrorCall "Unexpected: runSettingsSocket exited"
+            Right x -> return x
 
 -- | Same as 'withApplication' but with different exception handling: If the
 -- given 'Application' throws an exception, 'testWithApplication' will re-throw
@@ -67,31 +69,32 @@
 -- | 'testWithApplication' with given 'Settings'.
 --
 -- @since 3.2.7
-testWithApplicationSettings :: Settings -> IO Application -> (Port -> IO a) -> IO a
+testWithApplicationSettings
+    :: Settings -> IO Application -> (Port -> IO a) -> IO a
 testWithApplicationSettings settings mkApp action = do
-  callingThread <- myThreadId
-  app <- mkApp
-  let wrappedApp request respond =
-        app request respond `UnliftIO.catchAny` \ e -> do
-          when
-            (defaultShouldDisplayException e)
-            (throwTo callingThread e)
-          UnliftIO.throwIO e
-  withApplicationSettings settings (return wrappedApp) action
+    callingThread <- myThreadId
+    app <- mkApp
+    let wrappedApp request respond =
+            app request respond `E.catch` \e -> do
+                when
+                    (defaultShouldDisplayException e)
+                    (throwTo callingThread e)
+                E.throwIO e
+    withApplicationSettings settings (return wrappedApp) action
 
-data Waiter a
-  = Waiter {
-    notify :: a -> IO (),
-    waitFor :: IO a
-  }
+data Waiter a = Waiter
+    { notify :: a -> IO ()
+    , waitFor :: IO a
+    }
 
 mkWaiter :: IO (Waiter a)
 mkWaiter = do
-  mvar <- newEmptyMVar
-  return Waiter {
-    notify = putMVar mvar,
-    waitFor = readMVar mvar
-  }
+    mvar <- newEmptyMVar
+    return
+        Waiter
+            { notify = putMVar mvar
+            , waitFor = readMVar mvar
+            }
 
 -- | Opens a socket on a free port and returns both port and socket.
 --
@@ -101,4 +104,4 @@
 
 -- | Like 'openFreePort' but closes the socket before exiting.
 withFreePort :: ((Port, Socket) -> IO a) -> IO a
-withFreePort = UnliftIO.bracket openFreePort (close . snd)
+withFreePort = E.bracket openFreePort (close . snd)
diff --git a/bench/Parser.hs b/bench/Parser.hs
--- a/bench/Parser.hs
+++ b/bench/Parser.hs
@@ -1,30 +1,28 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 
+import Control.Exception (throw, throwIO)
 import Control.Monad
 import qualified Data.ByteString as S
---import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B (unpack)
-import qualified Network.HTTP.Types as H
-import Network.Wai.Handler.Warp.Types
-import Prelude hiding (lines)
-import UnliftIO.Exception (throwIO, impureThrow)
-
+import qualified Data.ByteString.Char8 as B (pack, unpack)
 import Data.ByteString.Internal
-import Data.Word
+import Data.IORef (atomicModifyIORef', newIORef)
+import qualified Data.List as L
+import Data.Word8
 import Foreign.ForeignPtr
 import Foreign.Ptr
 import Foreign.Storable
+import qualified Network.HTTP.Types as H
+import Prelude hiding (lines)
 
-#if MIN_VERSION_gauge(0, 2, 0)
-import Gauge
-#else
-import Gauge.Main
-#endif
+import Network.Wai.Handler.Warp.Request (FirstRequest (..), headerLines)
+import Network.Wai.Handler.Warp.Types
 
+import Criterion.Main
+
 -- $setup
 -- >>> :set -XOverloadedStrings
 
@@ -34,20 +32,31 @@
 main = do
     let requestLine1 = "GET http://www.example.com HTTP/1.1"
     let requestLine2 = "GET http://www.example.com/cgi-path/search.cgi?key=parser HTTP/1.0"
-    defaultMain [
-        bgroup "requestLine1" [
-             bench "parseRequestLine3" $ whnf parseRequestLine3 requestLine1
-           , bench "parseRequestLine2" $ whnfIO $ parseRequestLine2 requestLine1
-           , bench "parseRequestLine1" $ whnfIO $ parseRequestLine1 requestLine1
-           , bench "parseRequestLine0" $ whnfIO $ parseRequestLine0 requestLine1
-           ]
-      , bgroup "requestLine2" [
-             bench "parseRequestLine3" $ whnf parseRequestLine3 requestLine2
-           , bench "parseRequestLine2" $ whnfIO $ parseRequestLine2 requestLine2
-           , bench "parseRequestLine1" $ whnfIO $ parseRequestLine1 requestLine2
-           , bench "parseRequestLine0" $ whnfIO $ parseRequestLine0 requestLine2
-           ]
-      ]
+    defaultMain
+        [ bgroup
+            "requestLine1"
+            [ bench "parseRequestLine3" $ whnf parseRequestLine3 requestLine1
+            , bench "parseRequestLine2" $ whnfIO $ parseRequestLine2 requestLine1
+            , bench "parseRequestLine1" $ whnfIO $ parseRequestLine1 requestLine1
+            , bench "parseRequestLine0" $ whnfIO $ parseRequestLine0 requestLine1
+            ]
+        , bgroup
+            "requestLine2"
+            [ bench "parseRequestLine3" $ whnf parseRequestLine3 requestLine2
+            , bench "parseRequestLine2" $ whnfIO $ parseRequestLine2 requestLine2
+            , bench "parseRequestLine1" $ whnfIO $ parseRequestLine1 requestLine2
+            , bench "parseRequestLine0" $ whnfIO $ parseRequestLine0 requestLine2
+            ]
+        , bgroup
+            "parsing request"
+            [ bench "new parsing 4" $ whnfAppIO testIt (chunkRequest 4)
+            , bench "new parsing 10" $ whnfAppIO testIt (chunkRequest 10)
+            , bench "new parsing 25" $ whnfAppIO testIt (chunkRequest 25)
+            , bench "new parsing 100" $ whnfAppIO testIt (chunkRequest 100)
+            ]
+        ]
+  where
+    testIt req = producer req >>= headerLines 800 FirstRequest
 
 ----------------------------------------------------------------
 
@@ -61,26 +70,29 @@
 -- *** Exception: BadFirstLine "GET "
 -- >>> parseRequestLine3 "GET /NotHTTP UNKNOWN/1.1"
 -- *** Exception: NonHttp
-parseRequestLine3 :: ByteString
-                  -> (H.Method
-                     ,ByteString -- Path
-                     ,ByteString -- Query
-                     ,H.HttpVersion)
+parseRequestLine3
+    :: ByteString
+    -> ( H.Method
+       , ByteString -- Path
+       , ByteString -- Query
+       , H.HttpVersion
+       )
 parseRequestLine3 requestLine = ret
   where
-    (!method,!rest) = S.break (== 32) requestLine -- ' '
-    (!pathQuery,!httpVer')
-      | rest == "" = impureThrow badmsg
-      | otherwise  = S.break (== 32) (S.drop 1 rest) -- ' '
-    (!path,!query) = S.break (== 63) pathQuery -- '?'
+    (!method, !rest) = S.break (== _space) requestLine
+    (!pathQuery, !httpVer')
+        | rest == "" = throw badmsg
+        | otherwise = S.break (== _space) (S.drop 1 rest)
+    (!path, !query) = S.break (== _question) pathQuery
     !httpVer = S.drop 1 httpVer'
-    (!http,!ver)
-      | httpVer == "" = impureThrow badmsg
-      | otherwise     = S.break (== 47) httpVer -- '/'
-    !hv | http /= "HTTP" = impureThrow NonHttp
-        | ver == "/1.1"  = H.http11
-        | otherwise      = H.http10
-    !ret = (method,path,query,hv)
+    (!http, !ver)
+        | httpVer == "" = throw badmsg
+        | otherwise = S.break (== _slash) httpVer
+    !hv
+        | http /= "HTTP" = throw NonHttp
+        | ver == "/1.1" = H.http11
+        | otherwise = H.http10
+    !ret = (method, path, query, hv)
     badmsg = BadFirstLine $ B.unpack requestLine
 
 ----------------------------------------------------------------
@@ -95,24 +107,27 @@
 -- *** Exception: BadFirstLine "GET "
 -- >>> parseRequestLine2 "GET /NotHTTP UNKNOWN/1.1"
 -- *** Exception: NonHttp
-parseRequestLine2 :: ByteString
-                  -> IO (H.Method
-                        ,ByteString -- Path
-                        ,ByteString -- Query
-                        ,H.HttpVersion)
+parseRequestLine2
+    :: ByteString
+    -> IO
+        ( H.Method
+        , ByteString -- Path
+        , ByteString -- Query
+        , H.HttpVersion
+        )
 parseRequestLine2 requestLine@(PS fptr off len) = withForeignPtr fptr $ \ptr -> do
     when (len < 14) $ throwIO baderr
     let methodptr = ptr `plusPtr` off
         limptr = methodptr `plusPtr` len
         lim0 = fromIntegral len
 
-    pathptr0 <- memchr methodptr 32 lim0 -- ' '
+    pathptr0 <- memchr methodptr _space lim0
     when (pathptr0 == nullPtr || (limptr `minusPtr` pathptr0) < 11) $
         throwIO baderr
     let pathptr = pathptr0 `plusPtr` 1
         lim1 = fromIntegral (limptr `minusPtr` pathptr0)
 
-    httpptr0 <- memchr pathptr 32 lim1 -- ' '
+    httpptr0 <- memchr pathptr _space lim1
     when (httpptr0 == nullPtr || (limptr `minusPtr` httpptr0) < 9) $
         throwIO baderr
     let httpptr = httpptr0 `plusPtr` 1
@@ -120,17 +135,16 @@
 
     checkHTTP httpptr
     !hv <- httpVersion httpptr
-    queryptr <- memchr pathptr 63 lim2 -- '?'
-
+    queryptr <- memchr pathptr _question lim2
     let !method = bs ptr methodptr pathptr0
         !path
-          | queryptr == nullPtr = bs ptr pathptr httpptr0
-          | otherwise           = bs ptr pathptr queryptr
+            | queryptr == nullPtr = bs ptr pathptr httpptr0
+            | otherwise = bs ptr pathptr queryptr
         !query
-          | queryptr == nullPtr = S.empty
-          | otherwise           = bs ptr queryptr httpptr0
+            | queryptr == nullPtr = S.empty
+            | otherwise = bs ptr queryptr httpptr0
 
-    return (method,path,query,hv)
+    return (method, path, query, hv)
   where
     baderr = BadFirstLine $ B.unpack requestLine
     check :: Ptr Word8 -> Int -> Word8 -> IO ()
@@ -138,19 +152,18 @@
         w0 <- peek $ p `plusPtr` n
         when (w0 /= w) $ throwIO NonHttp
     checkHTTP httpptr = do
-        check httpptr 0 72 -- 'H'
-        check httpptr 1 84 -- 'T'
-        check httpptr 2 84 -- 'T'
-        check httpptr 3 80 -- 'P'
-        check httpptr 4 47 -- '/'
-        check httpptr 6 46 -- '.'
+        check httpptr 0 _H
+        check httpptr 1 _T
+        check httpptr 2 _T
+        check httpptr 3 _P
+        check httpptr 4 _slash
+        check httpptr 6 _period
     httpVersion httpptr = do
         major <- peek $ httpptr `plusPtr` 5
         minor <- peek $ httpptr `plusPtr` 7
-        if major == (49 :: Word8) && minor == (49 :: Word8) then
-            return H.http11
-          else
-            return H.http10
+        if major == _1 && minor == _1
+            then return H.http11
+            else return H.http10
     bs ptr p0 p1 = PS fptr o l
       where
         o = p0 `minusPtr` ptr
@@ -168,23 +181,29 @@
 -- *** Exception: BadFirstLine "GET "
 -- >>> parseRequestLine1 "GET /NotHTTP UNKNOWN/1.1"
 -- *** Exception: NonHttp
-parseRequestLine1 :: ByteString
-                  -> IO (H.Method
-                        ,ByteString -- Path
-                        ,ByteString -- Query
-                        ,H.HttpVersion)
+parseRequestLine1
+    :: ByteString
+    -> IO
+        ( H.Method
+        , ByteString -- Path
+        , ByteString -- Query
+        , H.HttpVersion
+        )
 parseRequestLine1 requestLine = do
-    let (!method,!rest) = S.break (== 32) requestLine -- ' '
-        (!pathQuery,!httpVer') = S.break (== 32) (S.drop 1 rest) -- ' '
+    let (!method, !rest) = S.break (== _space) requestLine
+        (!pathQuery, !httpVer') = S.break (== _space) (S.drop 1 rest)
         !httpVer = S.drop 1 httpVer'
     when (rest == "" || httpVer == "") $
-        throwIO $ BadFirstLine $ B.unpack requestLine
-    let (!path,!query) = S.break (== 63) pathQuery -- '?'
-        (!http,!ver)   = S.break (== 47) httpVer -- '/'
+        throwIO $
+            BadFirstLine $
+                B.unpack requestLine
+    let (!path, !query) = S.break (== _question) pathQuery
+        (!http, !ver) = S.break (== _slash) httpVer
     when (http /= "HTTP") $ throwIO NonHttp
-    let !hv | ver == "/1.1" = H.http11
-            | otherwise     = H.http10
-    return $! (method,path,query,hv)
+    let !hv
+            | ver == "/1.1" = H.http11
+            | otherwise = H.http10
+    return $! (method, path, query, hv)
 
 ----------------------------------------------------------------
 
@@ -198,23 +217,68 @@
 -- *** Exception: BadFirstLine "GET "
 -- >>> parseRequestLine0 "GET /NotHTTP UNKNOWN/1.1"
 -- *** Exception: NonHttp
-parseRequestLine0 :: ByteString
-                 -> IO (H.Method
-                       ,ByteString -- Path
-                       ,ByteString -- Query
-                       ,H.HttpVersion)
+parseRequestLine0
+    :: ByteString
+    -> IO
+        ( H.Method
+        , ByteString -- Path
+        , ByteString -- Query
+        , H.HttpVersion
+        )
 parseRequestLine0 s =
-    case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of  --  '
-        (method':query:http'') -> do
+    case filter (not . S.null) $ S.splitWith (\c -> c == _space || c == _tab) s of
+        (method' : query : http'') -> do
             let !method = method'
                 !http' = S.concat http''
                 (!hfirst, !hsecond) = S.splitAt 5 http'
             if hfirst == "HTTP/"
-               then let (!rpath, !qstring) = S.break (== 63) query  -- '?'
+                then
+                    let (!rpath, !qstring) = S.break (== _question) query
                         !hv =
                             case hsecond of
                                 "1.1" -> H.http11
                                 _ -> H.http10
-                    in return $! (method, rpath, qstring, hv)
-               else throwIO NonHttp
+                     in return $! (method, rpath, qstring, hv)
+                else throwIO NonHttp
         _ -> throwIO $ BadFirstLine $ B.unpack s
+
+producer :: [ByteString] -> IO Source
+producer a = do
+    ref <- newIORef a
+    mkSource $
+        atomicModifyIORef' ref $ \case
+            [] -> ([], S.empty)
+            b : bs -> (bs, b)
+
+chunkRequest :: Int -> [ByteString]
+chunkRequest chunkAmount =
+    go basicRequest
+  where
+    len = L.length basicRequest
+    chunkSize = (len `div` chunkAmount) + 1
+    go [] = []
+    go xs =
+        let (a, b) = L.splitAt chunkSize xs
+         in B.pack a : go b
+
+-- Random google search request
+basicRequest :: String
+basicRequest =
+    mconcat
+        [ "GET /search?q=test&sca_esv=600090652&source=hp&uact=5&oq=test&sclient=gws-wiz HTTP/3\r\n"
+        , "Host: www.google.com\r\n"
+        , "User-Agent: Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:121.0) Gecko/20100101 Firefox/121.0\r\n"
+        , "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8\r\n"
+        , "Accept-Language: en-US,en;q=0.5\r\n"
+        , "Accept-Encoding: gzip, deflate, br\r\n"
+        , "Referer: https://www.google.com/\r\n"
+        , "Alt-Used: www.google.com\r\n"
+        , "Connection: keep-alive\r\n"
+        , "Cookie: CONSENT=PENDING+252\r\n"
+        , "Upgrade-Insecure-Requests: 1\r\n"
+        , "Sec-Fetch-Dest: document\r\n"
+        , "Sec-Fetch-Mode: navigate\r\n"
+        , "Sec-Fetch-Site: same-origin\r\n"
+        , "Sec-Fetch-User: ?1\r\n"
+        , "TE: trailers\r\n\r\n"
+        ]
diff --git a/test/ConduitSpec.hs b/test/ConduitSpec.hs
--- a/test/ConduitSpec.hs
+++ b/test/ConduitSpec.hs
@@ -1,12 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
+
 module ConduitSpec (main, spec) where
 
+import Control.Monad (replicateM)
+import qualified Data.ByteString as S
+import Data.IORef as I
 import Network.Wai.Handler.Warp.Conduit
 import Network.Wai.Handler.Warp.Types
-import Control.Monad (replicateM)
 import Test.Hspec
-import Data.IORef as I
-import qualified Data.ByteString as S
 
 main :: IO ()
 main = hspec spec
@@ -14,23 +15,23 @@
 spec :: Spec
 spec = describe "conduit" $ do
     it "IsolatedBSSource" $ do
-        ref <- newIORef $ map S.singleton [1..50]
+        ref <- newIORef $ map S.singleton [1 .. 50]
         src <- mkSource $ do
             x <- readIORef ref
             case x of
                 [] -> return S.empty
-                y:z -> do
+                y : z -> do
                     writeIORef ref z
                     return y
         isrc <- mkISource src 40
         x <- replicateM 20 $ readISource isrc
-        S.concat x `shouldBe` S.pack [1..20]
+        S.concat x `shouldBe` S.pack [1 .. 20]
 
         y <- replicateM 40 $ readISource isrc
-        S.concat y `shouldBe` S.pack [21..40]
+        S.concat y `shouldBe` S.pack [21 .. 40]
 
         z <- replicateM 40 $ readSource src
-        S.concat z `shouldBe` S.pack [41..50]
+        S.concat z `shouldBe` S.pack [41 .. 50]
     it "chunkedSource" $ do
         ref <- newIORef "5\r\n12345\r\n3\r\n678\r\n0\r\n\r\nBLAH"
         src <- mkSource $ do
@@ -45,17 +46,18 @@
         y <- replicateM 15 $ readSource src
         S.concat y `shouldBe` "BLAH"
     it "chunk boundaries" $ do
-        ref <- newIORef
-            [ "5\r\n"
-            , "12345\r\n3\r"
-            , "\n678\r\n0\r\n"
-            , "\r\nBLAH"
-            ]
+        ref <-
+            newIORef
+                [ "5\r\n"
+                , "12345\r\n3\r"
+                , "\n678\r\n0\r\n"
+                , "\r\nBLAH"
+                ]
         src <- mkSource $ do
             x <- readIORef ref
             case x of
                 [] -> return S.empty
-                y:z -> do
+                y : z -> do
                     writeIORef ref z
                     return y
         csrc <- mkCSource src
diff --git a/test/ConnectionSpec.hs b/test/ConnectionSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/ConnectionSpec.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ConnectionSpec (spec) where
+
+import Network.HTTP.Types
+import Network.Wai
+import Network.Wai.Handler.Warp
+import RunSpec (withApp, withMySocket, msWrite, msRead)
+import Test.Hspec
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as S8
+
+spec :: Spec
+spec = describe "Connection header" $ do
+        it "sends Connection: close when response implies close (HTTP/1.0 Keep-Alive, no Content-Length)" $ do
+            let app _ f = f $ responseLBS status200 [] "foo"
+            withApp defaultSettings app $ withMySocket $ \ms -> do
+                -- HTTP/1.0 defaults to close. We ask for Keep-Alive.
+                -- But we provide no Content-Length in response.
+                -- So Warp should decide to close (because it can't keep alive without length or chunking),
+                -- and MUST send "Connection: close" to inform the client.
+                msWrite ms "GET / HTTP/1.0\r\nConnection: Keep-Alive\r\n\r\n"
+                
+                -- We expect the connection to be closed by the server, so reading a large amount 
+                -- should return whatever was sent and then finish.
+                response <- msRead ms 4096
+                
+                let headers = parseHeaders response
+                lookup "Connection" headers `shouldBe` Just "close"
+    
+        describe "HTTP/1.1 Connection: close behavior" $ do
+            it "sends Connection: close for HEAD request without Content-Length" $ do
+                -- Response has no Content-Length and is not chunked (HEAD implies no body).
+                -- In HTTP/1.1 this requires closing the connection to delimit the response (or rather, lack of persistence info).
+                let app _ f = f $ responseBuilder status200 [] "foo"
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms "HEAD / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+                    response <- msRead ms 4096
+                    let headers = parseHeaders response
+                    lookup "Connection" headers `shouldBe` Just "close"
+    
+            it "sends Connection: close when request has Connection: close (200 OK)" $ do
+                let app _ f = f $ responseLBS status200 [] "foo"
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms "GET / HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"
+                    response <- msRead ms 4096
+                    let headers = parseHeaders response
+                    lookup "Connection" headers `shouldBe` Just "close"
+    
+            it "sends Connection: close when request has Connection: close (204 No Content)" $ do
+                let app _ f = f $ responseLBS status204 [] ""
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms "GET / HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"
+                    response <- msRead ms 4096
+                    let headers = parseHeaders response
+                    lookup "Connection" headers `shouldBe` Just "close"
+    
+            it "sends Connection: close when request has Connection: close (500 Internal Server Error)" $ do
+                let app _ f = f $ responseLBS status500 [] "error"
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms "GET / HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"
+                    response <- msRead ms 4096
+                    let headers = parseHeaders response
+                    lookup "Connection" headers `shouldBe` Just "close"
+parseHeaders :: ByteString -> [(ByteString, ByteString)]
+parseHeaders bs = 
+    let lines = S8.lines bs
+        -- Drop status line
+        headerLines = takeWhile (not . S8.null . S8.filter (/= '\r')) $ drop 1 lines
+        parseLine line = 
+            let (k, v) = S8.break (== ':') line
+                v' = S8.takeWhile (/= '\r') v
+            in (k, S8.dropWhile (== ' ') $ S8.drop 1 v')
+    in map parseLine headerLines
diff --git a/test/ExceptionSpec.hs b/test/ExceptionSpec.hs
--- a/test/ExceptionSpec.hs
+++ b/test/ExceptionSpec.hs
@@ -1,20 +1,21 @@
-{-# LANGUAGE OverloadedStrings, CPP #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module ExceptionSpec (main, spec) where
 
 #if __GLASGOW_HASKELL__ < 709
 import Control.Applicative
 #endif
+import Control.Concurrent.Async (withAsync)
+import Control.Exception
 import Control.Monad
+import qualified Data.Streaming.Network as N
 import Network.HTTP.Types hiding (Header)
+import Network.Socket (close)
 import Network.Wai hiding (Response, responseStatus)
-import Network.Wai.Internal (Request(..))
 import Network.Wai.Handler.Warp
+import Network.Wai.Internal (Request (..))
 import Test.Hspec
-import UnliftIO.Exception
-import qualified Data.Streaming.Network as N
-import UnliftIO.Async (withAsync)
-import Network.Socket (close)
 
 import HTTP
 
@@ -26,11 +27,11 @@
     (N.bindRandomPortTCP "127.0.0.1")
     (close . snd)
     $ \(prt, lsocket) -> do
-        withAsync (runSettingsSocket defaultSettings lsocket testApp)
-            $ \_ -> inner prt
+        withAsync (runSettingsSocket defaultSettings lsocket testApp) $
+            \_ -> inner prt
 
 testApp :: Application
-testApp (Network.Wai.Internal.Request {pathInfo = [x]}) f
+testApp (Network.Wai.Internal.Request{pathInfo = [x]}) f
     | x == "statusError" =
         f $ responseLBS undefined [] "foo"
     | x == "headersError" =
@@ -43,24 +44,25 @@
         void $ fail "ioException"
         f $ responseLBS ok200 [] "foo"
 testApp _ f =
-        f $ responseLBS ok200 [] "foo"
+    f $ responseLBS ok200 [] "foo"
 
 spec :: Spec
 spec = describe "responds even if there is an exception" $ do
-        {- Disabling these tests. We can consider forcing evaluation in Warp.
-        it "statusError" $ do
-            sc <- responseStatus <$> sendGET "http://127.0.0.1:2345/statusError"
-            sc `shouldBe` internalServerError500
-        it "headersError" $ do
-            sc <- responseStatus <$> sendGET "http://127.0.0.1:2345/headersError"
-            sc `shouldBe` internalServerError500
-        it "headerError" $ do
-            sc <- responseStatus <$> sendGET "http://127.0.0.1:2345/headerError"
-            sc `shouldBe` internalServerError500
-        it "bodyError" $ do
-            sc <- responseStatus <$> sendGET "http://127.0.0.1:2345/bodyError"
-            sc `shouldBe` internalServerError500
-        -}
-        it "ioException" $ withTestServer $ \prt -> do
-            sc <- responseStatus <$> sendGET ("http://127.0.0.1:" ++ show prt ++ "/ioException")
-            sc `shouldBe` internalServerError500
+    {- Disabling these tests. We can consider forcing evaluation in Warp.
+    it "statusError" $ do
+        sc <- responseStatus <$> sendGET "http://127.0.0.1:2345/statusError"
+        sc `shouldBe` internalServerError500
+    it "headersError" $ do
+        sc <- responseStatus <$> sendGET "http://127.0.0.1:2345/headersError"
+        sc `shouldBe` internalServerError500
+    it "headerError" $ do
+        sc <- responseStatus <$> sendGET "http://127.0.0.1:2345/headerError"
+        sc `shouldBe` internalServerError500
+    it "bodyError" $ do
+        sc <- responseStatus <$> sendGET "http://127.0.0.1:2345/bodyError"
+        sc `shouldBe` internalServerError500
+    -}
+    it "ioException" $ withTestServer $ \prt -> do
+        sc <-
+            responseStatus <$> sendGET ("http://127.0.0.1:" ++ show prt ++ "/ioException")
+        sc `shouldBe` internalServerError500
diff --git a/test/FdCacheSpec.hs b/test/FdCacheSpec.hs
--- a/test/FdCacheSpec.hs
+++ b/test/FdCacheSpec.hs
@@ -6,7 +6,7 @@
 #ifndef WINDOWS
 import Data.IORef
 import Network.Wai.Handler.Warp.FdCache
-import System.Posix.IO (fdRead)
+import System.Posix.IO.ByteString (fdRead)
 import System.Posix.Types (Fd(..))
 
 main :: IO ()
diff --git a/test/FileSpec.hs b/test/FileSpec.hs
--- a/test/FileSpec.hs
+++ b/test/FileSpec.hs
@@ -15,7 +15,8 @@
 main :: IO ()
 main = hspec spec
 
-changeHeaders :: (ResponseHeaders -> ResponseHeaders) -> RspFileInfo -> RspFileInfo
+changeHeaders
+    :: (ResponseHeaders -> ResponseHeaders) -> RspFileInfo -> RspFileInfo
 changeHeaders f rfi =
     case rfi of
         WithBody s hs off len -> WithBody s (f hs) off len
@@ -27,10 +28,11 @@
         WithBody _ hs _ _ -> hs
         _ -> []
 
-testFileRange :: String
-              -> RequestHeaders
-              -> RspFileInfo
-              -> Spec
+testFileRange
+    :: String
+    -> RequestHeaders
+    -> RspFileInfo
+    -> Spec
 testFileRange desc reqhs ans = it desc $ do
     finfo <- getInfo "attic/hex"
     let f = (:) ("Last-Modified", fileInfoDate finfo)
@@ -41,21 +43,25 @@
         []
         methodGet
         (indexResponseHeader hs)
-        (indexRequestHeader reqhs) `shouldBe` ans'
+        (indexRequestHeader reqhs)
+        `shouldBe` ans'
 
 farPast, farFuture :: ByteString
 farPast = "Thu, 01 Jan 1970 00:00:00 GMT"
 farFuture = "Sun, 05 Oct 3000 00:00:00 GMT"
 
 regularBody :: RspFileInfo
-regularBody = WithBody ok200 [("Content-Length","16"),("Accept-Ranges","bytes")] 0 16
+regularBody = WithBody ok200 [("Content-Length", "16"), ("Accept-Ranges", "bytes")] 0 16
 
 make206Body :: Integer -> Integer -> RspFileInfo
 make206Body start len =
-    WithBody status206 [crHeader, lenHeader, ("Accept-Ranges","bytes")] start len
+    WithBody status206 [crHeader, lenHeader, ("Accept-Ranges", "bytes")] start len
   where
     lenHeader = ("Content-Length", fromString $ show len)
-    crHeader = ("Content-Range", fromString $ "bytes " <> show start <> "-" <> show (start + len - 1) <> "/16")
+    crHeader =
+        ( "Content-Range"
+        , fromString $ "bytes " <> show start <> "-" <> show (start + len - 1) <> "/16"
+        )
 
 spec :: Spec
 spec = do
@@ -66,15 +72,15 @@
             regularBody
         testFileRange
             "gets a file size from file system and handles Range and returns Partical Content"
-            [("Range","bytes=2-14")]
+            [("Range", "bytes=2-14")]
             $ make206Body 2 13
         testFileRange
             "truncates end point of range to file size"
-            [("Range","bytes=10-20")]
+            [("Range", "bytes=10-20")]
             $ make206Body 10 6
         testFileRange
             "gets a file size from file system and handles Range and returns OK if Range means the entire"
-            [("Range:","bytes=0-15")]
+            [("Range:", "bytes=0-15")]
             regularBody
         testFileRange
             "returns a 412 if the file has been changed in the meantime"
@@ -90,7 +96,10 @@
             regularBody
         testFileRange
             "still gives only a range, even after conditionals"
-            [("If-Match", "SomeETag"), ("If-Unmodified-Since", farPast), ("Range","bytes=10-20")]
+            [ ("If-Match", "SomeETag")
+            , ("If-Unmodified-Since", farPast)
+            , ("Range", "bytes=10-20")
+            ]
             $ make206Body 10 6
         testFileRange
             "gets a file if the file has been changed in the meantime"
@@ -106,13 +115,18 @@
             regularBody
         testFileRange
             "still gives only a range, even after conditionals"
-            [("If-None-Match", "SomeETag"), ("If-Modified-Since", farFuture), ("Range","bytes=10-13")]
+            [ ("If-None-Match", "SomeETag")
+            , ("If-Modified-Since", farFuture)
+            , ("Range", "bytes=10-13")
+            ]
             $ make206Body 10 4
         testFileRange
             "gives the a range, if the condition is met"
-            [("If-Range", fileInfoDate (unsafePerformIO $ getInfo "attic/hex")), ("Range","bytes=2-7")]
+            [ ("If-Range", fileInfoDate (unsafePerformIO $ getInfo "attic/hex"))
+            , ("Range", "bytes=2-7")
+            ]
             $ make206Body 2 6
         testFileRange
             "gives the entire body and ignores the Range header if the condition isn't met"
-            [("If-Range", farPast), ("Range","bytes=2-7")]
+            [("If-Range", farPast), ("Range", "bytes=2-7")]
             regularBody
diff --git a/test/GracefulShutdownSpec.hs b/test/GracefulShutdownSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/GracefulShutdownSpec.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module GracefulShutdownSpec (spec) where
+
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Exception (bracket)
+import Control.Monad (void)
+import Network.HTTP.Client
+import Network.HTTP.Types (ok200, status200)
+import Network.Socket (close)
+import Network.Wai (responseLBS)
+import Network.Wai.Handler.Warp
+import System.Timeout (timeout)
+import Test.Hspec
+
+spec :: Spec
+spec = describe "graceful shutdown" $
+    it "serves the request in flight, then closes keep-alive connections and exits" $ do
+        shutdownSignal <- newEmptyMVar
+        allowResponse <- newEmptyMVar
+        receivedRequests <- newQSemN 0
+        allowSecondRequest <- newEmptyMVar
+
+        let installShutdownHandler closeListenSocket =
+                void . forkIO $ do
+                    readMVar shutdownSignal
+                    closeListenSocket
+
+            settings =
+                setInstallShutdownHandler installShutdownHandler defaultSettings
+
+            app _ respond = do
+                -- signal 1 received request
+                signalQSemN receivedRequests 1
+                -- block until signaled
+                readMVar allowResponse
+                respond $ responseLBS status200 [("Content-Length", "0")] ""
+
+            client sendRequest = do
+                -- first request should return OK
+                response <- sendRequest
+                responseStatus response `shouldBe` ok200
+                lookup "Connection" (responseHeaders response) `shouldBe` Just "close"
+                -- wait with the second request
+                void $ readMVar allowSecondRequest
+                -- second request should end with connection refused
+                sendRequest `shouldThrow` connectionRefused
+
+        bracket openFreePort (close . snd) $ \(testPort, sock) ->
+            withAsync (runSettingsSocket settings sock app) $ \server -> do
+                manager <- newManager defaultManagerSettings
+                request <- parseRequest ("http://127.0.0.1:" ++ show testPort)
+                withAsync
+                    -- start all clients
+                    ( replicateConcurrently_ numClients $
+                        client (httpNoBody request manager)
+                    )
+                    $ \clients -> do
+                        -- wait for all clients to send requests
+                        waitQSemN receivedRequests numClients
+                        -- shutdown the server before serving requests
+                        putMVar shutdownSignal ()
+                        -- wait a little - otherwise some requests might not get
+                        -- Connection: close response header
+                        threadDelay 100_000
+                        -- let requests be handled
+                        putMVar allowResponse ()
+                        -- server should exit
+                        timeout 5_000_000 (wait server)
+                            >>= maybe (expectationFailure "Timeout waiting for server shutdown") pure
+                        -- let clients proceed with the second request
+                        putMVar allowSecondRequest ()
+                        -- wait for all clients and propagate any exceptions
+                        wait clients
+  where
+    -- set number of clients to the number of keep-alive connections
+    numClients = managerConnCount defaultManagerSettings
+    connectionRefused = \case
+        (HttpExceptionRequest _ (ConnectionFailure _)) -> True
+        _ -> False
diff --git a/test/HTTP.hs b/test/HTTP.hs
--- a/test/HTTP.hs
+++ b/test/HTTP.hs
@@ -1,19 +1,19 @@
 module HTTP (
-    sendGET
-  , sendGETwH
-  , sendHEAD
-  , sendHEADwH
-  , responseBody
-  , responseStatus
-  , responseHeaders
-  , getHeaderValue
-  , HeaderName
-  ) where
+    sendGET,
+    sendGETwH,
+    sendHEAD,
+    sendHEADwH,
+    responseBody,
+    responseStatus,
+    responseHeaders,
+    getHeaderValue,
+    HeaderName,
+) where
 
-import Network.HTTP.Client
-import Network.HTTP.Types
 import Data.ByteString
 import qualified Data.ByteString.Lazy as BL
+import Network.HTTP.Client
+import Network.HTTP.Types
 
 sendGET :: String -> IO (Response BL.ByteString)
 sendGET url = sendGETwH url []
@@ -22,7 +22,7 @@
 sendGETwH url hdr = do
     manager <- newManager defaultManagerSettings
     request <- parseRequest url
-    let request' = request { requestHeaders = hdr }
+    let request' = request{requestHeaders = hdr}
     response <- httpLbs request' manager
     return response
 
@@ -33,7 +33,7 @@
 sendHEADwH url hdr = do
     manager <- newManager defaultManagerSettings
     request <- parseRequest url
-    let request' = request { requestHeaders = hdr, method = methodHead }
+    let request' = request{requestHeaders = hdr, method = methodHead}
     response <- httpLbs request' manager
     return response
 
diff --git a/test/PackIntSpec.hs b/test/PackIntSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/PackIntSpec.hs
@@ -0,0 +1,14 @@
+module PackIntSpec (spec) where
+
+import qualified Data.ByteString.Char8 as C8
+import Network.Wai.Handler.Warp.PackInt
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import qualified Test.QuickCheck as QC
+
+spec :: Spec
+spec = describe "readInt64" $ do
+    prop "" $ \n -> packIntegral (abs n :: Int) == C8.pack (show (abs n))
+    prop "" $ \(QC.Large n) ->
+        let n' = fromIntegral (abs n :: Int)
+         in packIntegral (n' :: Int) == C8.pack (show n')
diff --git a/test/ReadIntSpec.hs b/test/ReadIntSpec.hs
--- a/test/ReadIntSpec.hs
+++ b/test/ReadIntSpec.hs
@@ -1,9 +1,9 @@
 module ReadIntSpec (main, spec) where
 
 import Data.ByteString (ByteString)
-import Test.Hspec
-import Network.Wai.Handler.Warp.ReadInt
 import qualified Data.ByteString.Char8 as B
+import Network.Wai.Handler.Warp.ReadInt
+import Test.Hspec
 import qualified Test.QuickCheck as QC
 
 main :: IO ()
@@ -11,7 +11,8 @@
 
 spec :: Spec
 spec = describe "readInt64" $ do
-    it "converts ByteString to Int" $ QC.property (prop_read_show_idempotent readInt64)
+    it "converts ByteString to Int" $
+        QC.property (prop_read_show_idempotent readInt64)
 
 -- A QuickCheck property. Test that for a number >= 0, converting it to
 -- a string using show and then reading the value back with the function
@@ -19,7 +20,8 @@
 -- The functions under test only work on Natural numbers (the Conent-Length
 -- field in a HTTP header is always >= 0) so we check the absolute value of
 -- the value that QuickCheck generates for us.
-prop_read_show_idempotent :: (Integral a, Show a) => (ByteString -> a) -> a -> Bool
+prop_read_show_idempotent
+    :: (Integral a, Show a) => (ByteString -> a) -> a -> Bool
 prop_read_show_idempotent freader x = px == freader (toByteString px)
   where
     px = abs x
diff --git a/test/RequestSpec.hs b/test/RequestSpec.hs
--- a/test/RequestSpec.hs
+++ b/test/RequestSpec.hs
@@ -1,18 +1,22 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module RequestSpec (main, spec) where
 
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
+import Data.IORef
+import Data.Monoid (Sum (..))
+import qualified Network.HTTP.Types.Header as HH
 import Network.Wai.Handler.Warp.File (parseByteRanges)
 import Network.Wai.Handler.Warp.Request
+import Network.Wai.Handler.Warp.Settings (
+    defaultSettings,
+    settingsMaxTotalHeaderLength,
+ )
 import Network.Wai.Handler.Warp.Types
-import Network.Wai.Handler.Warp.Settings (settingsMaxTotalHeaderLength, defaultSettings)
 import Test.Hspec
 import Test.Hspec.QuickCheck
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Char8 as S8
-import qualified Network.HTTP.Types.Header as HH
-import Data.IORef
 
 main :: IO ()
 main = hspec spec
@@ -22,86 +26,92 @@
 
 spec :: Spec
 spec = do
-  describe "headerLines" $ do
-    it "takes until blank" $
-        blankSafe `shouldReturn` ("", ["foo", "bar", "baz"])
-    it "ignored leading whitespace in bodies" $
-        whiteSafe `shouldReturn` (" hi there", ["foo", "bar", "baz"])
-    it "throws OverLargeHeader when too many" $
-        tooMany `shouldThrow` overLargeHeader
-    it "throws OverLargeHeader when too large" $
-        tooLarge `shouldThrow` overLargeHeader
-    it "known bad chunking behavior #239" $ do
-        let chunks =
-                [ "GET / HTTP/1.1\r\nConnection: Close\r"
-                , "\n\r\n"
-                ]
-        (actual, src) <- headerLinesList' chunks
-        leftover <- readLeftoverSource src
-        leftover `shouldBe` S.empty
-        actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
-    prop "random chunking" $ \breaks extraS -> do
-        let bsFull = "GET / HTTP/1.1\r\nConnection: Close\r\n\r\n" `S8.append` extra
-            extra = S8.pack extraS
-            chunks = loop breaks bsFull
-            loop [] bs = [bs, undefined]
-            loop (x:xs) bs =
-                bs1 : loop xs bs2
-              where
-                (bs1, bs2) = S8.splitAt ((x `mod` 10) + 1) bs
-        (actual, src) <- headerLinesList' chunks
-        leftover <- consumeLen (length extraS) src
+    describe "headerLines" $ do
+        it "takes until blank" $
+            blankSafe `shouldReturn` ("", ["foo", "bar", "baz"])
+        it "ignored leading whitespace in bodies" $
+            whiteSafe `shouldReturn` (" hi there", ["foo", "bar", "baz"])
+        it "throws OverLargeHeader when too many" $
+            tooMany `shouldThrow` overLargeHeader
+        it "throws OverLargeHeader when too large" $
+            tooLarge `shouldThrow` overLargeHeader
+        it "known bad chunking behavior #239" $ do
+            let chunks =
+                    [ "GET / HTTP/1.1\r\nConnection: Close\r"
+                    , "\n\r\n"
+                    ]
+            (actual, src) <- headerLinesList' chunks
+            leftover <- readLeftoverSource src
+            leftover `shouldBe` S.empty
+            actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
+        prop "random chunking" $ \breaks extraS -> do
+            let bsFull = "GET / HTTP/1.1\r\nConnection: Close\r\n\r\n" `S8.append` extra
+                extra = S8.pack extraS
+                chunks = loop breaks bsFull
+                loop [] bs = [bs, undefined]
+                loop (x : xs) bs =
+                    bs1 : loop xs bs2
+                  where
+                    (bs1, bs2) = S8.splitAt ((x `mod` 10) + 1) bs
+            (actual, src) <- headerLinesList' chunks
+            leftover <- consumeLen (length extraS) src
 
-        actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
-        leftover `shouldBe` extra
-  describe "parseByteRanges" $ do
-    let test x y = it x $ parseByteRanges (S8.pack x) `shouldBe` y
-    test "bytes=0-499" $ Just [HH.ByteRangeFromTo 0 499]
-    test "bytes=500-999" $ Just [HH.ByteRangeFromTo 500 999]
-    test "bytes=-500" $ Just [HH.ByteRangeSuffix 500]
-    test "bytes=9500-" $ Just [HH.ByteRangeFrom 9500]
-    test "foobytes=9500-" Nothing
-    test "bytes=0-0,-1" $ Just [HH.ByteRangeFromTo 0 0, HH.ByteRangeSuffix 1]
+            actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
+            leftover `shouldBe` extra
+    describe "parseByteRanges" $ do
+        let test x y = it x $ parseByteRanges (S8.pack x) `shouldBe` y
+        test "bytes=0-499" $ Just [HH.ByteRangeFromTo 0 499]
+        test "bytes=500-999" $ Just [HH.ByteRangeFromTo 500 999]
+        test "bytes=-500" $ Just [HH.ByteRangeSuffix 500]
+        test "bytes=9500-" $ Just [HH.ByteRangeFrom 9500]
+        test "foobytes=9500-" Nothing
+        test "bytes=0-0,-1" $ Just [HH.ByteRangeFromTo 0 0, HH.ByteRangeSuffix 1]
 
-  describe "headerLines" $ do
-      it "can handle a normal case" $ do
-          src <- mkSourceFunc ["Status: 200\r\nContent-Type: text/plain\r\n\r\n"] >>= mkSource
-          x <- headerLines defaultMaxTotalHeaderLength True src
-          x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
+    describe "headerLines" $ do
+        let parseHeaderLine chunks = do
+                src <- mkSourceFunc chunks >>= mkSource
+                x <- headerLines defaultMaxTotalHeaderLength FirstRequest src
+                x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
 
-      it "can handle a nasty case (1)" $ do
-          src <- mkSourceFunc ["Status: 200", "\r\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource
-          x <- headerLines defaultMaxTotalHeaderLength True src
-          x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
+        it "can handle a normal case" $
+            parseHeaderLine ["Status: 200\r\nContent-Type: text/plain\r\n\r\n"]
 
-      it "can handle a nasty case (1)" $ do
-          src <- mkSourceFunc ["Status: 200", "\r", "\nContent-Type: text/plain", "\r", "\n\r\n"] >>= mkSource
-          x <- headerLines defaultMaxTotalHeaderLength True src
-          x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
+        it "can handle a nasty case (1)" $ do
+            parseHeaderLine ["Status: 200", "\r\nContent-Type: text/plain", "\r\n\r\n"]
+            parseHeaderLine ["Status: 200\r\n", "Content-Type: text/plain", "\r\n\r\n"]
 
-      it "can handle a nasty case (1)" $ do
-          src <- mkSourceFunc ["Status: 200", "\r", "\n", "Content-Type: text/plain", "\r", "\n", "\r", "\n"] >>= mkSource
-          x <- headerLines defaultMaxTotalHeaderLength True src
-          x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
+        it "can handle a nasty case (2)" $ do
+            parseHeaderLine
+                ["Status: 200", "\r", "\nContent-Type: text/plain", "\r", "\n\r\n"]
 
-      it "can handle an illegal case (1)" $ do
-          src <- mkSourceFunc ["\nStatus:", "\n 200", "\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource
-          x <- headerLines defaultMaxTotalHeaderLength True src
-          x `shouldBe` []
-          y <- headerLines defaultMaxTotalHeaderLength True src
-          y `shouldBe` ["Status: 200", "Content-Type: text/plain"]
+        it "can handle a nasty case (3)" $ do
+            parseHeaderLine
+                ["Status: 200", "\r", "\n", "Content-Type: text/plain", "\r", "\n", "\r", "\n"]
 
-      -- Length is 39, this shouldn't fail
-      let testLengthHeaders = ["Sta", "tus: 200\r", "\n", "Content-Type: ", "text/plain\r\n\r\n"]
-      it "doesn't throw on correct length" $ do
-          src <- mkSourceFunc testLengthHeaders >>= mkSource
-          x <- headerLines 39 True src
-          x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
-      -- Length is still 39, this should fail
-      it "throws error on correct length too long" $ do
-          src <- mkSourceFunc testLengthHeaders >>= mkSource
-          headerLines 38 True src `shouldThrow` (== OverLargeHeader)
+        it "can handle a stupid case (3)" $
+            parseHeaderLine $
+                S8.pack . (: []) <$> "Status: 200\r\nContent-Type: text/plain\r\n\r\n"
 
+        it "can (not) handle an illegal case (1)" $ do
+            let chunks = ["\nStatus:", "\n 200", "\nContent-Type: text/plain", "\r\n\r\n"]
+            src <- mkSourceFunc chunks >>= mkSource
+            x <- headerLines defaultMaxTotalHeaderLength FirstRequest src
+            x `shouldBe` []
+            y <- headerLines defaultMaxTotalHeaderLength FirstRequest src
+            y `shouldBe` ["Status:", " 200", "Content-Type: text/plain"]
+
+        let testLengthHeaders = ["Sta", "tus: 200\r", "\n", "Content-Type: ", "text/plain\r\n\r\n"]
+            headerLength = getSum $ foldMap (Sum . S.length) testLengthHeaders
+            testLength = headerLength - 2 -- Because the second CRLF at the end isn't counted
+            -- Length is 39, this shouldn't fail
+        it "doesn't throw on correct length" $ do
+            src <- mkSourceFunc testLengthHeaders >>= mkSource
+            x <- headerLines testLength FirstRequest src
+            x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
+        -- Length is still 39, this should fail
+        it "throws error on correct length too long" $ do
+            src <- mkSourceFunc testLengthHeaders >>= mkSource
+            headerLines (testLength - 1) FirstRequest src `shouldThrow` (== OverLargeHeader)
   where
     blankSafe = headerLinesList ["f", "oo\n", "bar\nbaz\n\r\n"]
     whiteSafe = headerLinesList ["foo\r\nbar\r\nbaz\r\n\r\n hi there"]
@@ -121,11 +131,11 @@
             x <- readIORef ref
             case x of
                 [] -> return S.empty
-                y:z -> do
+                y : z -> do
                     writeIORef ref z
                     return y
     src' <- mkSource src
-    res <- headerLines defaultMaxTotalHeaderLength True src'
+    res <- headerLines defaultMaxTotalHeaderLength FirstRequest src'
     return (res, src')
 
 consumeLen :: Int -> Source -> IO S8.ByteString
@@ -140,7 +150,7 @@
                 then loop front 0
                 else do
                     let (x, _) = S.splitAt len bs
-                    loop (front . (x:)) (len - S.length x)
+                    loop (front . (x :)) (len - S.length x)
 
 overLargeHeader :: Selector InvalidRequest
 overLargeHeader e = e == OverLargeHeader
@@ -153,7 +163,7 @@
     reader ref = do
         xss <- readIORef ref
         case xss of
-            []     -> return S.empty
-            (x:xs) -> do
+            [] -> return S.empty
+            (x : xs) -> do
                 writeIORef ref xs
                 return x
diff --git a/test/ResponseHeaderSpec.hs b/test/ResponseHeaderSpec.hs
--- a/test/ResponseHeaderSpec.hs
+++ b/test/ResponseHeaderSpec.hs
@@ -4,9 +4,9 @@
 
 import Data.ByteString
 import qualified Network.HTTP.Types as H
-import Network.Wai.Handler.Warp.ResponseHeader
-import Network.Wai.Handler.Warp.Response
 import Network.Wai.Handler.Warp.Header
+import Network.Wai.Handler.Warp.Response
+import Network.Wai.Handler.Warp.ResponseHeader
 import Test.Hspec
 
 main :: IO ()
@@ -21,9 +21,9 @@
         it "adds Server if not exist" $ do
             let hdrs = []
                 rspidxhdr = indexResponseHeader hdrs
-            addServer "MyServer" rspidxhdr hdrs `shouldBe` [("Server","MyServer")]
+            addServer "MyServer" rspidxhdr hdrs `shouldBe` [("Server", "MyServer")]
         it "does not add Server if exists" $ do
-            let hdrs = [("Server","MyServer")]
+            let hdrs = [("Server", "MyServer")]
                 rspidxhdr = indexResponseHeader hdrs
             addServer "MyServer2" rspidxhdr hdrs `shouldBe` hdrs
         it "does not add Server if empty" $ do
@@ -31,18 +31,19 @@
                 rspidxhdr = indexResponseHeader hdrs
             addServer "" rspidxhdr hdrs `shouldBe` hdrs
         it "deletes Server " $ do
-            let hdrs = [("Server","MyServer")]
+            let hdrs = [("Server", "MyServer")]
                 rspidxhdr = indexResponseHeader hdrs
             addServer "" rspidxhdr hdrs `shouldBe` []
 
 headers :: H.ResponseHeaders
-headers = [
-    ("Date", "Mon, 13 Aug 2012 04:22:55 GMT")
-  , ("Content-Length", "151")
-  , ("Server", "Mighttpd/2.5.8")
-  , ("Last-Modified", "Fri, 22 Jun 2012 01:18:08 GMT")
-  , ("Content-Type", "text/html")
-  ]
+headers =
+    [ ("Date", "Mon, 13 Aug 2012 04:22:55 GMT")
+    , ("Content-Length", "151")
+    , ("Server", "Mighttpd/2.5.8")
+    , ("Last-Modified", "Fri, 22 Jun 2012 01:18:08 GMT")
+    , ("Content-Type", "text/html")
+    ]
 
 composedHeader :: ByteString
-composedHeader = "HTTP/1.1 200 OK\r\nDate: Mon, 13 Aug 2012 04:22:55 GMT\r\nContent-Length: 151\r\nServer: Mighttpd/2.5.8\r\nLast-Modified: Fri, 22 Jun 2012 01:18:08 GMT\r\nContent-Type: text/html\r\n\r\n"
+composedHeader =
+    "HTTP/1.1 200 OK\r\nDate: Mon, 13 Aug 2012 04:22:55 GMT\r\nContent-Length: 151\r\nServer: Mighttpd/2.5.8\r\nLast-Modified: Fri, 22 Jun 2012 01:18:08 GMT\r\nContent-Type: text/html\r\n\r\n"
diff --git a/test/ResponseSpec.hs b/test/ResponseSpec.hs
--- a/test/ResponseSpec.hs
+++ b/test/ResponseSpec.hs
@@ -10,16 +10,20 @@
 import Network.Wai hiding (responseHeaders)
 import Network.Wai.Handler.Warp
 import Network.Wai.Handler.Warp.Response
-import RunSpec (withApp, msWrite, msRead, withMySocket)
+import RunSpec (msRead, msWrite, withApp, withMySocket)
 import Test.Hspec
 
 main :: IO ()
 main = hspec spec
 
-testRange :: S.ByteString -- ^ range value
-          -> String -- ^ expected output
-          -> Maybe String -- ^ expected content-range value
-          -> Spec
+testRange
+    :: S.ByteString
+    -- ^ range value
+    -> String
+    -- ^ expected output
+    -> Maybe String
+    -- ^ expected content-range value
+    -> Spec
 testRange range out crange = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do
     msWrite ms "GET / HTTP/1.0\r\n"
     msWrite ms "Range: bytes="
@@ -36,14 +40,19 @@
     title = show (range, out, crange)
     toHeader s =
         case break (== ':') s of
-            (x, ':':y) -> Just (x, dropWhile (== ' ') y)
+            (x, ':' : y) -> Just (x, dropWhile (== ' ') y)
             _ -> Nothing
 
-testPartial :: Integer -- ^ file size
-            -> Integer -- ^ offset
-            -> Integer -- ^ byte count
-            -> String -- ^ expected output
-            -> Spec
+testPartial
+    :: Integer
+    -- ^ file size
+    -> Integer
+    -- ^ offset
+    -> Integer
+    -- ^ byte count
+    -> String
+    -- ^ expected output
+    -> Spec
 testPartial size offset count out = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do
     msWrite ms "GET / HTTP/1.0\r\n\r\n"
     threadDelay 10000
@@ -57,21 +66,22 @@
     title = show (offset, count, out)
     toHeader s =
         case break (== ':') s of
-            (x, ':':y) -> Just (x, dropWhile (== ' ') y)
+            (x, ':' : y) -> Just (x, dropWhile (== ' ') y)
             _ -> Nothing
-    range = "bytes " ++ show offset ++ "-" ++ show (offset + count - 1) ++ "/" ++ show size
+    range =
+        "bytes " ++ show offset ++ "-" ++ show (offset + count - 1) ++ "/" ++ show size
 
 spec :: Spec
 spec = do
-{- http-client does not support this.
-    describe "preventing response splitting attack" $ do
-        it "sanitizes header values" $ do
-            let app _ respond = respond $ responseLBS status200 [("foo", "foo\r\nbar")] "Hello"
-            withApp defaultSettings app $ \port -> do
-                res <- sendGET $ "http://127.0.0.1:" ++ show port
-                getHeaderValue "foo" (responseHeaders res) `shouldBe`
-                  Just "foo   bar" -- HTTP inserts two spaces for \r\n.
--}
+    {- http-client does not support this.
+        describe "preventing response splitting attack" $ do
+            it "sanitizes header values" $ do
+                let app _ respond = respond $ responseLBS status200 [("foo", "foo\r\nbar")] "Hello"
+                withApp defaultSettings app $ \port -> do
+                    res <- sendGET $ "http://127.0.0.1:" ++ show port
+                    getHeaderValue "foo" (responseHeaders res) `shouldBe`
+                      Just "foo   bar" -- HTTP inserts two spaces for \r\n.
+    -}
 
     describe "sanitizeHeaderValue" $ do
         it "doesn't alter valid multiline header values" $ do
diff --git a/test/RunSpec.hs b/test/RunSpec.hs
--- a/test/RunSpec.hs
+++ b/test/RunSpec.hs
@@ -4,10 +4,10 @@
 module RunSpec (main, spec, withApp, MySocket, msWrite, msRead, withMySocket) where
 
 import Control.Concurrent (forkIO, killThread, threadDelay)
-import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Concurrent.STM
-import qualified UnliftIO.Exception as E
-import UnliftIO.Exception (bracket, try, IOException, onException)
+import Control.Exception (IOException, bracket, onException, try)
+import qualified Control.Exception as E
 import Control.Monad (forM_, replicateM_, unless)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.ByteString (ByteString)
@@ -21,7 +21,7 @@
 import Network.Socket
 import Network.Socket.ByteString (sendAll)
 import Network.Wai hiding (responseHeaders)
-import Network.Wai.Handler.Warp
+import Network.Wai.Handler.Warp hiding (Counter)
 import System.IO.Unsafe (unsafePerformIO)
 import System.Timeout (timeout)
 import Test.Hspec
@@ -35,35 +35,35 @@
 type CounterApplication = Counter -> Application
 
 data MySocket = MySocket
-  { msSocket :: !Socket
-  , msBuffer :: !(I.IORef ByteString)
-  }
+    { msSocket :: !Socket
+    , msBuffer :: !(I.IORef ByteString)
+    }
 
 msWrite :: MySocket -> ByteString -> IO ()
 msWrite = sendAll . msSocket
 
 msRead :: MySocket -> Int -> IO ByteString
 msRead (MySocket s ref) expected = do
-  bs <- I.readIORef ref
-  inner (bs:) (S.length bs)
+    bs <- I.readIORef ref
+    inner (bs :) (S.length bs)
   where
     inner front total =
-      case compare total expected of
-        EQ -> do
-          I.writeIORef ref mempty
-          pure $ S.concat $ front []
-        GT -> do
-          let bs = S.concat $ front []
-              (x, y) = S.splitAt expected bs
-          I.writeIORef ref y
-          pure x
-        LT -> do
-          bs <- safeRecv s 4096
-          if S.null bs
-            then do
-              I.writeIORef ref mempty
-              pure $ S.concat $ front []
-            else inner (front . (bs:)) (total + S.length bs)
+        case compare total expected of
+            EQ -> do
+                I.writeIORef ref mempty
+                pure $ S.concat $ front []
+            GT -> do
+                let bs = S.concat $ front []
+                    (x, y) = S.splitAt expected bs
+                I.writeIORef ref y
+                pure x
+            LT -> do
+                bs <- safeRecv s 4096
+                if S.null bs
+                    then do
+                        I.writeIORef ref mempty
+                        pure $ S.concat $ front []
+                    else inner (front . (bs :)) (total + S.length bs)
 
 msClose :: MySocket -> IO ()
 msClose = Network.Socket.close . msSocket
@@ -72,19 +72,22 @@
 connectTo port = do
     s <- fst <$> getSocketTCP "127.0.0.1" port
     ref <- I.newIORef mempty
-    return MySocket {
-        msSocket = s
-      , msBuffer = ref
-      }
+    return
+        MySocket
+            { msSocket = s
+            , msBuffer = ref
+            }
 
 withMySocket :: (MySocket -> IO a) -> Int -> IO a
 withMySocket body port = bracket (connectTo port) msClose body
 
 incr :: MonadIO m => Counter -> m ()
 incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount ->
-    (case ecount of
+    ( case ecount of
         Left s -> Left s
-        Right i -> Right $ i + 1, ())
+        Right i -> Right $ i + 1
+    , ()
+    )
 
 err :: (MonadIO m, Show a) => Counter -> a -> m ()
 err icount msg = liftIO $ I.writeIORef icount $ Left $ show msg
@@ -94,12 +97,12 @@
     body <- consumeBody $ getRequestBodyChunk req
     case () of
         ()
-            | pathInfo req == ["hello"] && L.fromChunks body /= "Hello"
-                -> err icount ("Invalid hello" :: String, body)
-            | requestMethod req == "GET" && L.fromChunks body /= ""
-                -> err icount ("Invalid GET" :: String, body)
-            | requestMethod req `notElem` ["GET", "POST"]
-                -> err icount ("Invalid request method (readBody)" :: String, requestMethod req)
+            | pathInfo req == ["hello"] && L.fromChunks body /= "Hello" ->
+                err icount ("Invalid hello" :: String, body)
+            | requestMethod req == "GET" && L.fromChunks body /= "" ->
+                err icount ("Invalid GET" :: String, body)
+            | requestMethod req `notElem` ["GET", "POST"] ->
+                err icount ("Invalid request method (readBody)" :: String, requestMethod req)
             | otherwise -> incr icount
     f $ responseLBS status200 [] "Read the body"
 
@@ -135,25 +138,31 @@
 withApp settings app f = do
     port <- RunSpec.getPort
     baton <- newEmptyMVar
-    let settings' = setPort port
-                  $ setHost "127.0.0.1"
-                  $ setBeforeMainLoop (putMVar baton ())
-                    settings
+    let settings' =
+            setPort port $
+                setHost "127.0.0.1" $
+                    setBeforeMainLoop
+                        (putMVar baton ())
+                        settings
     bracket
         (forkIO $ runSettings settings' app `onException` putMVar baton ())
         killThread
-        (const $ do
+        ( const $ do
             takeMVar baton
             -- use timeout to make sure we don't take too long
             mres <- timeout (60 * 1000 * 1000) (f port)
             case mres of
-              Nothing -> error "Timeout triggered, too slow!"
-              Just a -> pure a)
+                Nothing -> error "Timeout triggered, too slow!"
+                Just a -> pure a
+        )
 
-runTest :: Int -- ^ expected number of requests
-        -> CounterApplication
-        -> [ByteString] -- ^ chunks to send
-        -> IO ()
+runTest
+    :: Int
+    -- ^ expected number of requests
+    -> CounterApplication
+    -> [ByteString]
+    -- ^ chunks to send
+    -> IO ()
 runTest expected app chunks = do
     ref <- I.newIORef (Right 0)
     withApp defaultSettings (app ref) $ withMySocket $ \ms -> do
@@ -167,9 +176,10 @@
 dummyApp :: Application
 dummyApp _ f = f $ responseLBS status200 [] "foo"
 
-runTerminateTest :: InvalidRequest
-                 -> ByteString
-                 -> IO ()
+runTerminateTest
+    :: InvalidRequest
+    -> ByteString
+    -> IO ()
 runTerminateTest expected input = do
     ref <- I.newIORef Nothing
     let onExc _ = I.writeIORef ref . Just
@@ -197,77 +207,108 @@
     describe "non-pipelining" $ do
         it "no body, read" $ runTest 5 readBody $ replicate 5 singleGet
         it "no body, ignore" $ runTest 5 ignoreBody $ replicate 5 singleGet
-        it "has body, read" $ runTest 2 readBody
-            [ singlePostHello
-            , singleGet
-            ]
-        it "has body, ignore" $ runTest 2 ignoreBody
-            [ singlePostHello
-            , singleGet
-            ]
-        it "chunked body, read" $ runTest 2 readBody $
-            singleChunkedPostHello ++ [singleGet]
-        it "chunked body, ignore" $ runTest 2 ignoreBody $
-            singleChunkedPostHello ++ [singleGet]
+        it "has body, read" $
+            runTest
+                2
+                readBody
+                [ singlePostHello
+                , singleGet
+                ]
+        it "has body, ignore" $
+            runTest
+                2
+                ignoreBody
+                [ singlePostHello
+                , singleGet
+                ]
+        it "chunked body, read" $
+            runTest 2 readBody $
+                singleChunkedPostHello ++ [singleGet]
+        it "chunked body, ignore" $
+            runTest 2 ignoreBody $
+                singleChunkedPostHello ++ [singleGet]
     describe "pipelining" $ do
         it "no body, read" $ runTest 5 readBody [S.concat $ replicate 5 singleGet]
         it "no body, ignore" $ runTest 5 ignoreBody [S.concat $ replicate 5 singleGet]
-        it "has body, read" $ runTest 2 readBody $ return $ S.concat
-            [ singlePostHello
-            , singleGet
-            ]
-        it "has body, ignore" $ runTest 2 ignoreBody $ return $ S.concat
-            [ singlePostHello
-            , singleGet
-            ]
-        it "chunked body, read" $ runTest 2 readBody $ return $ S.concat
-            [ S.concat singleChunkedPostHello
-            , singleGet
-            ]
-        it "chunked body, ignore" $ runTest 2 ignoreBody $ return $ S.concat
-            [ S.concat singleChunkedPostHello
-            , singleGet
-            ]
+        it "has body, read" $
+            runTest 2 readBody $
+                return $
+                    S.concat
+                        [ singlePostHello
+                        , singleGet
+                        ]
+        it "has body, ignore" $
+            runTest 2 ignoreBody $
+                return $
+                    S.concat
+                        [ singlePostHello
+                        , singleGet
+                        ]
+        it "chunked body, read" $
+            runTest 2 readBody $
+                return $
+                    S.concat
+                        [ S.concat singleChunkedPostHello
+                        , singleGet
+                        ]
+        it "chunked body, ignore" $
+            runTest 2 ignoreBody $
+                return $
+                    S.concat
+                        [ S.concat singleChunkedPostHello
+                        , singleGet
+                        ]
     describe "no hanging" $ do
-        it "has body, read" $ runTest 1 readBody $ map S.singleton $ S.unpack singlePostHello
+        it "has body, read" $
+            runTest 1 readBody $
+                map S.singleton $
+                    S.unpack singlePostHello
         it "double connect" $ runTest 1 doubleConnect [singlePostHello]
 
     describe "connection termination" $ do
---        it "ConnectionClosedByPeer" $ runTerminateTest ConnectionClosedByPeer "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r\nhello"
-        it "IncompleteHeaders" $
+        -- it "ConnectionClosedByPeer" $ runTerminateTest ConnectionClosedByPeer "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r\nhello"
+        it "IncompleteHeaders" $ do
+            runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r"
             runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n"
+            runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r"
+            runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-lengt"
 
     describe "special input" $ do
+        let appWithSocket f = do
+                iheaders <- I.newIORef []
+                let app req respond = do
+                        liftIO $ I.writeIORef iheaders $ requestHeaders req
+                        respond $ responseLBS status200 [] ""
+                withApp defaultSettings app $ withMySocket $ f iheaders
+
         it "multiline headers" $ do
-            iheaders <- I.newIORef []
-            let app req f = do
-                    liftIO $ I.writeIORef iheaders $ requestHeaders req
-                    f $ responseLBS status200 [] ""
-            withApp defaultSettings app $ withMySocket $ \ms -> do
-                let input = S.concat
-                        [ "GET / HTTP/1.1\r\nfoo:    bar\r\n baz\r\n\tbin\r\n\r\n"
-                        ]
+            appWithSocket $ \iheaders ms -> do
+                let input = "GET / HTTP/1.1\r\nfoo:    bar\r\n baz\r\n\tbin\r\n\r\n"
                 msWrite ms input
                 threadDelay 5000
                 headers <- I.readIORef iheaders
-                headers `shouldBe`
-                    [ ("foo", "bar baz\tbin")
-                    ]
+                headers
+                    `shouldBe` [ ("foo", "bar")
+                               , (" baz", "")
+                               , ("\tbin", "")
+                               ]
         it "no space between colon and value" $ do
-            iheaders <- I.newIORef []
-            let app req f = do
-                    liftIO $ I.writeIORef iheaders $ requestHeaders req
-                    f $ responseLBS status200 [] ""
-            withApp defaultSettings app $ withMySocket $ \ms -> do
-                let input = S.concat
-                        [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
-                        ]
+            appWithSocket $ \iheaders ms -> do
+                let input = "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
                 msWrite ms input
                 threadDelay 5000
                 headers <- I.readIORef iheaders
-                headers `shouldBe`
-                    [ ("foo", "bar")
-                    ]
+                headers `shouldBe` [("foo", "bar")]
+        it "does not recognize multiline headers" $ do
+            appWithSocket $ \iheaders ms -> do
+                msWrite ms "GET / HTTP/1.1\r\nfoo: and\r\n"
+                msWrite ms " baz as well\r\n\r\n"
+                threadDelay 5000
+                headers <- I.readIORef iheaders
+                headers
+                    `shouldBe` [ ("foo", "and")
+                               , (" baz as well", "")
+                               ]
 
     describe "chunked bodies" $ do
         it "works" $ do
@@ -275,81 +316,92 @@
             ifront <- I.newIORef id
             let app req f = do
                     bss <- consumeBody $ getRequestBodyChunk req
-                    liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
+                    liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ())
                     atomically $ modifyTVar countVar (+ 1)
                     f $ responseLBS status200 [] ""
             withApp defaultSettings app $ withMySocket $ \ms -> do
-                let input = S.concat
-                        [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
-                        , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n"
-                        , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
-                        , "b\r\nHello World\r\n0\r\n\r\n"
-                        ]
+                let input =
+                        S.concat
+                            [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
+                            , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n"
+                            , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
+                            , "b\r\nHello World\r\n0\r\n\r\n"
+                            ]
                 msWrite ms input
                 atomically $ do
-                  count <- readTVar countVar
-                  check $ count == 2
+                    count <- readTVar countVar
+                    check $ count == 2
                 front <- I.readIORef ifront
-                front [] `shouldBe`
-                    [ "Hello World\nBye"
-                    , "Hello World"
-                    ]
+                front []
+                    `shouldBe` [ "Hello World\nBye"
+                               , "Hello World"
+                               ]
         it "lots of chunks" $ do
             ifront <- I.newIORef id
             countVar <- newTVarIO (0 :: Int)
             let app req f = do
                     bss <- consumeBody $ getRequestBodyChunk req
-                    I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
+                    I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ())
                     atomically $ modifyTVar countVar (+ 1)
                     f $ responseLBS status200 [] ""
             withApp defaultSettings app $ withMySocket $ \ms -> do
-                let input = concat $ replicate 2 $
-                        ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++
-                        replicate 50 "5\r\n12345\r\n" ++
-                        ["0\r\n\r\n"]
+                let input =
+                        concat $
+                            replicate 2 $
+                                ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"]
+                                    ++ replicate 50 "5\r\n12345\r\n"
+                                    ++ ["0\r\n\r\n"]
                 mapM_ (msWrite ms) input
                 atomically $ do
-                  count <- readTVar countVar
-                  check $ count == 2
+                    count <- readTVar countVar
+                    check $ count == 2
                 front <- I.readIORef ifront
                 front [] `shouldBe` replicate 2 (S.concat $ replicate 50 "12345")
--- For some reason, the following test on Windows causes the socket
--- to be killed prematurely. Worth investigating in the future if possible.
+        -- For some reason, the following test on Windows causes the socket
+        -- to be killed prematurely. Worth investigating in the future if possible.
         it "in chunks" $ do
             ifront <- I.newIORef id
             countVar <- newTVarIO (0 :: Int)
             let app req f = do
                     bss <- consumeBody $ getRequestBodyChunk req
-                    liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
+                    liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ())
                     atomically $ modifyTVar countVar (+ 1)
                     f $ responseLBS status200 [] ""
             withApp defaultSettings app $ withMySocket $ \ms -> do
-                let input = S.concat
-                        [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
-                        , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n"
-                        , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
-                        , "b\r\nHello World\r\n0\r\n\r\n"
-                        ]
+                let input =
+                        S.concat
+                            [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
+                            , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n"
+                            , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
+                            , "b\r\nHello World\r\n0\r\n\r\n"
+                            ]
                 mapM_ (msWrite ms . S.singleton) $ S.unpack input
                 atomically $ do
-                  count <- readTVar countVar
-                  check $ count == 2
+                    count <- readTVar countVar
+                    check $ count == 2
                 front <- I.readIORef ifront
-                front [] `shouldBe`
-                    [ "Hello World\nBye"
-                    , "Hello World"
-                    ]
+                front []
+                    `shouldBe` [ "Hello World\nBye"
+                               , "Hello World"
+                               ]
         it "timeout in request body" $ do
             ifront <- I.newIORef id
             let app req f = do
-                    bss <- consumeBody (getRequestBodyChunk req) `onException`
-                        liftIO (I.atomicModifyIORef ifront (\front -> (front . ("consume interrupted":), ())))
-                    liftIO $ threadDelay 4000000 `E.catch` \e -> do
-                        I.atomicModifyIORef ifront (\front ->
-                            ( front . ((S8.pack $ "threadDelay interrupted: " ++ show e):)
-                            , ()))
-                        E.throwIO (e :: E.SomeException)
-                    liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
+                    bss <-
+                        consumeBody (getRequestBodyChunk req)
+                            `onException` liftIO
+                                (I.atomicModifyIORef ifront (\front -> (front . ("consume interrupted" :), ())))
+                    liftIO $
+                        threadDelay 4000000 `E.catch` \e -> do
+                            I.atomicModifyIORef
+                                ifront
+                                ( \front ->
+                                    ( front . ((S8.pack $ "threadDelay interrupted: " ++ show e) :)
+                                    , ()
+                                    )
+                                )
+                            E.throwIO (e :: E.SomeException)
+                    liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ())
                     f $ responseLBS status200 [] ""
             withApp (setTimeout 1 defaultSettings) app $ withMySocket $ \ms -> do
                 let bs1 = S.replicate 2048 88
@@ -384,13 +436,18 @@
                 msWrite ms "67890"
                 timeout 100000 (msRead ms 10) `shouldReturn` Just "6677889900"
     it "only one date and server header" $ do
-        let app _ f = f $ responseLBS status200
-                [ ("server", "server")
-                , ("date", "date")
-                ] ""
-            getValues key = map snd
-                          . filter (\(key', _) -> key == key')
-                          . responseHeaders
+        let app _ f =
+                f $
+                    responseLBS
+                        status200
+                        [ ("server", "server")
+                        , ("date", "date")
+                        ]
+                        ""
+            getValues key =
+                map snd
+                    . filter (\(key', _) -> key == key')
+                    . responseHeaders
         withApp defaultSettings app $ \port -> do
             res <- sendGET $ "http://127.0.0.1:" ++ show port
             getValues hServer res `shouldBe` ["server"]
@@ -399,20 +456,20 @@
     it "streaming echo #249" $ do
         countVar <- newTVarIO (0 :: Int)
         let app req f = f $ responseStream status200 [] $ \write _ -> do
-             let loop = do
-                    bs <- getRequestBodyChunk req
-                    unless (S.null bs) $ do
-                        write $ byteString bs
-                        atomically $ modifyTVar countVar (+ 1)
-                        loop
-             loop
+                let loop = do
+                        bs <- getRequestBodyChunk req
+                        unless (S.null bs) $ do
+                            write $ byteString bs
+                            atomically $ modifyTVar countVar (+ 1)
+                            loop
+                loop
         withApp defaultSettings app $ withMySocket $ \ms -> do
             msWrite ms "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"
             threadDelay 10000
             msWrite ms "5\r\nhello\r\n0\r\n\r\n"
             atomically $ do
-              count <- readTVar countVar
-              check $ count >= 1
+                count <- readTVar countVar
+                check $ count >= 1
             bs <- safeRecv (msSocket ms) 4096 -- must not use msRead
             S.takeWhile (/= 13) bs `shouldBe` "HTTP/1.1 200 OK"
 
@@ -441,11 +498,13 @@
         it "file, no range" $ withApp defaultSettings app $ \port -> do
             bs <- S.readFile fp
             res <- sendHEAD $ concat ["http://127.0.0.1:", show port, "/file"]
-            getHeaderValue hContentLength (responseHeaders res) `shouldBe` Just (S8.pack $ show $ S.length bs)
+            getHeaderValue hContentLength (responseHeaders res)
+                `shouldBe` Just (S8.pack $ show $ S.length bs)
         it "file, with range" $ withApp defaultSettings app $ \port -> do
-            res <- sendHEADwH
-                (concat ["http://127.0.0.1:", show port, "/file"])
-                [(hRange, "bytes=0-1")]
+            res <-
+                sendHEADwH
+                    (concat ["http://127.0.0.1:", show port, "/file"])
+                    [(hRange, "bytes=0-1")]
             getHeaderValue hContentLength (responseHeaders res) `shouldBe` Just "2"
 
 consumeBody :: IO ByteString -> IO [ByteString]
@@ -456,4 +515,4 @@
         bs <- body
         if S.null bs
             then return $ front []
-            else loop $ front . (bs:)
+            else loop $ front . (bs :)
diff --git a/test/SendFileSpec.hs b/test/SendFileSpec.hs
--- a/test/SendFileSpec.hs
+++ b/test/SendFileSpec.hs
@@ -2,6 +2,7 @@
 
 module SendFileSpec where
 
+import Control.Exception
 import Control.Monad (when)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
@@ -13,47 +14,50 @@
 import qualified System.IO as IO
 import System.Process (system)
 import Test.Hspec
-import UnliftIO.Exception
 
 main :: IO ()
 main = hspec spec
 
 spec :: Spec
 spec = do
-  describe "packHeader" $ do
-    it "returns how much the buffer is consumed (1)" $
-        tryPackHeader 10 ["foo"] `shouldReturn` 3
-    it "returns how much the buffer is consumed (2)" $
-        tryPackHeader 10 ["foo", "bar"] `shouldReturn` 6
-    it "returns how much the buffer is consumed (3)" $
-        tryPackHeader 10 ["0123456789"] `shouldReturn` 0
-    it "returns how much the buffer is consumed (4)" $
-        tryPackHeader 10 ["01234", "56789"] `shouldReturn` 0
-    it "returns how much the buffer is consumed (5)" $
-        tryPackHeader 10 ["01234567890", "12"] `shouldReturn` 3
-    it "returns how much the buffer is consumed (6)" $
-        tryPackHeader 10 ["012345678901234567890123456789012", "34"] `shouldReturn` 5
+    describe "packHeader" $ do
+        it "returns how much the buffer is consumed (1)" $
+            tryPackHeader 10 ["foo"] `shouldReturn` 3
+        it "returns how much the buffer is consumed (2)" $
+            tryPackHeader 10 ["foo", "bar"] `shouldReturn` 6
+        it "returns how much the buffer is consumed (3)" $
+            tryPackHeader 10 ["0123456789"] `shouldReturn` 0
+        it "returns how much the buffer is consumed (4)" $
+            tryPackHeader 10 ["01234", "56789"] `shouldReturn` 0
+        it "returns how much the buffer is consumed (5)" $
+            tryPackHeader 10 ["01234567890", "12"] `shouldReturn` 3
+        it "returns how much the buffer is consumed (6)" $
+            tryPackHeader 10 ["012345678901234567890123456789012", "34"] `shouldReturn` 5
 
-    it "sends headers correctly (1)" $
-        tryPackHeader2 10 ["foo"] "" `shouldReturn` True
-    it "sends headers correctly (2)" $
-        tryPackHeader2 10 ["foo", "bar"] "" `shouldReturn` True
-    it "sends headers correctly (3)" $
-        tryPackHeader2 10 ["0123456789"] "0123456789" `shouldReturn` True
-    it "sends headers correctly (4)" $
-        tryPackHeader2 10 ["01234", "56789"] "0123456789" `shouldReturn` True
-    it "sends headers correctly (5)" $
-        tryPackHeader2 10 ["01234567890", "12"] "0123456789" `shouldReturn` True
-    it "sends headers correctly (6)" $
-        tryPackHeader2 10 ["012345678901234567890123456789012", "34"] "012345678901234567890123456789" `shouldReturn` True
+        it "sends headers correctly (1)" $
+            tryPackHeader2 10 ["foo"] "" `shouldReturn` True
+        it "sends headers correctly (2)" $
+            tryPackHeader2 10 ["foo", "bar"] "" `shouldReturn` True
+        it "sends headers correctly (3)" $
+            tryPackHeader2 10 ["0123456789"] "0123456789" `shouldReturn` True
+        it "sends headers correctly (4)" $
+            tryPackHeader2 10 ["01234", "56789"] "0123456789" `shouldReturn` True
+        it "sends headers correctly (5)" $
+            tryPackHeader2 10 ["01234567890", "12"] "0123456789" `shouldReturn` True
+        it "sends headers correctly (6)" $
+            tryPackHeader2
+                10
+                ["012345678901234567890123456789012", "34"]
+                "012345678901234567890123456789"
+                `shouldReturn` True
 
-  describe "readSendFile" $ do
-    it "sends a file correctly (1)" $
-        tryReadSendFile 10 0 1474 ["foo"] `shouldReturn` ExitSuccess
-    it "sends a file correctly (2)" $
-        tryReadSendFile 10 0 1474 ["012345678", "901234"] `shouldReturn` ExitSuccess
-    it "sends a file correctly (3)" $
-        tryReadSendFile 10 20 100 ["012345678", "901234"] `shouldReturn` ExitSuccess
+    describe "readSendFile" $ do
+        it "sends a file correctly (1)" $
+            tryReadSendFile 10 0 1474 ["foo"] `shouldReturn` ExitSuccess
+        it "sends a file correctly (2)" $
+            tryReadSendFile 10 0 1474 ["012345678", "901234"] `shouldReturn` ExitSuccess
+        it "sends a file correctly (3)" $
+            tryReadSendFile 10 20 100 ["012345678", "901234"] `shouldReturn` ExitSuccess
 
 tryPackHeader :: Int -> [ByteString] -> IO Int
 tryPackHeader siz hdrs = bracket (allocateBuffer siz) freeBuffer $ \buf ->
@@ -95,20 +99,20 @@
 checkFile :: FilePath -> ByteString -> IO Bool
 checkFile path bs = do
     exist <- doesFileExist path
-    if exist then do
-        bs' <- BS.readFile path
-        return $ bs == bs'
-      else
-        return $ bs == ""
+    if exist
+        then do
+            bs' <- BS.readFile path
+            return $ bs == bs'
+        else return $ bs == ""
 
 compareFiles :: FilePath -> FilePath -> IO ExitCode
 compareFiles file1 file2 = system $ "cmp -s " ++ file1 ++ " " ++ file2
 
 copyfile :: FilePath -> FilePath -> Integer -> Integer -> IO ()
 copyfile src dst off len =
-  IO.withBinaryFile src IO.ReadMode $ \h -> do
-     IO.hSeek h IO.AbsoluteSeek off
-     BS.hGet h (fromIntegral len) >>= BS.appendFile dst
+    IO.withBinaryFile src IO.ReadMode $ \h -> do
+        IO.hSeek h IO.AbsoluteSeek off
+        BS.hGet h (fromIntegral len) >>= BS.appendFile dst
 
 removeFileIfExists :: FilePath -> IO ()
 removeFileIfExists file = do
diff --git a/test/ServerStateSpec.hs b/test/ServerStateSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/ServerStateSpec.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ServerStateSpec where
+
+import Network.Wai.Handler.Warp (getServerState)
+import Network.Wai.Handler.Warp.Counter (getCount, increase)
+import Network.Wai.Handler.Warp.Settings (
+    ServerState (..),
+    currentOpenConnections,
+    currentShuttingDownState,
+    defaultSettings,
+    makeServerState,
+    newServerState,
+ )
+import Network.Wai.Handler.Warp.ShuttingDown (writeShuttingDown)
+import Test.Hspec
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+    describe "ServerState" $ do
+        it "has the correct initialization" $ do
+            ss <- newServerState
+            currentOpenConnections ss `shouldReturn` 0
+            currentShuttingDownState ss `shouldReturn` False
+    describe "makeServerState" $ do
+        it "has the same state in settings" $ do
+            (outerSS, set) <- makeServerState defaultSettings
+            case getServerState set of
+                Nothing -> expectationFailure "'makeServerState' should set the 'ServerState'"
+                Just innerSS -> do
+                    let bothCount i = do
+                            a <- currentOpenConnections outerSS
+                            b <- currentOpenConnections innerSS
+                            (a, b) `shouldBe` (i, i)
+                    increase $ serverConnectionCounter outerSS
+                    bothCount 1
+                    increase $ serverConnectionCounter innerSS
+                    bothCount 2
+                    let bothDown bool = do
+                            a <- currentShuttingDownState outerSS
+                            b <- currentShuttingDownState innerSS
+                            (a, b) `shouldBe` (bool, bool)
+                    writeShuttingDown (serverShuttingDown outerSS) True
+                    bothDown True
+                    writeShuttingDown (serverShuttingDown innerSS) False
+                    bothDown False
+        it "is idempotent" $ do
+            let incAndCheck ss i = do
+                    increase $ serverConnectionCounter ss
+                    currentOpenConnections ss `shouldReturn` i
+            (ss1, set1) <- makeServerState defaultSettings
+            incAndCheck ss1 1
+            (ss2, _set2) <- makeServerState set1
+            incAndCheck ss2 2
+            incAndCheck ss1 3
diff --git a/test/WithApplicationSpec.hs b/test/WithApplicationSpec.hs
--- a/test/WithApplicationSpec.hs
+++ b/test/WithApplicationSpec.hs
@@ -2,41 +2,45 @@
 
 module WithApplicationSpec where
 
-import           Network.HTTP.Types
-import           Network.Wai
-import           System.Environment
-import           System.Process
-import           Test.Hspec
-import           UnliftIO.Exception
+import Control.Exception
+import Network.HTTP.Types
+import Network.Wai
+import System.Environment
+import System.Process
+import Test.Hspec
 
-import           Network.Wai.Handler.Warp.WithApplication
+import Network.Wai.Handler.Warp.WithApplication
 
 -- All these tests assume the "curl" process can be called directly.
 spec :: Spec
 spec = do
-  runIO $ do
-      unsetEnv "http_proxy"
-      unsetEnv "https_proxy"
-  describe "\"curl\" dependency" $
-    let msg = "All \"WithApplication\" tests assume the \"curl\" process can be called directly."
-        underline = replicate (length msg) '^'
-     in it (msg ++ "\n    " ++ underline) True
-  describe "withApplication" $ do
-    it "runs a wai Application while executing the given action" $ do
-      let mkApp = return $ \ _request respond -> respond $ responseLBS ok200 [] "foo"
-      withApplication mkApp $ \ port -> do
-        output <- readProcess "curl" ["-s", "localhost:" ++ show port] ""
-        output `shouldBe` "foo"
+    runIO $ do
+        unsetEnv "http_proxy"
+        unsetEnv "https_proxy"
+    describe "\"curl\" dependency" $
+        let msg =
+                "All \"WithApplication\" tests assume the \"curl\" process can be called directly."
+            underline = replicate (length msg) '^'
+         in it (msg ++ "\n    " ++ underline) True
+    describe "withApplication" $ do
+        it "runs a wai Application while executing the given action" $ do
+            let mkApp = return $ \_request respond -> respond $ responseLBS ok200 [] "foo"
+            withApplication mkApp $ \port -> do
+                output <- readProcess "curl" ["-s", "localhost:" ++ show port] ""
+                output `shouldBe` "foo"
 
-    it "does not propagate exceptions from the server to the executing thread" $ do
-      let mkApp = return $ \ _request _respond -> throwString "foo"
-      withApplication mkApp $ \ port -> do
-        output <- readProcess "curl" ["-s", "localhost:" ++ show port] ""
-        output `shouldContain` "Something went wron"
+        it "does not propagate exceptions from the server to the executing thread" $ do
+            let mkApp = return $ \_request _respond -> throwIO $ ErrorCall "foo"
+            withApplication mkApp $ \port -> do
+                output <- readProcess "curl" ["-s", "localhost:" ++ show port] ""
+                output `shouldContain` "Something went wron"
 
-  describe "testWithApplication" $ do
-    it "propagates exceptions from the server to the executing thread" $ do
-      let mkApp = return $ \ _request _respond -> throwString "foo"
-      testWithApplication mkApp (\ port -> do
-          readProcess "curl" ["-s", "localhost:" ++ show port] "")
-        `shouldThrow` (\(StringException str _) -> str == "foo")
+    describe "testWithApplication" $ do
+        it "propagates exceptions from the server to the executing thread" $ do
+            let mkApp = return $ \_request _respond -> throwIO $ ErrorCall "foo"
+            testWithApplication
+                mkApp
+                ( \port -> do
+                    readProcess "curl" ["-s", "localhost:" ++ show port] ""
+                )
+                `shouldThrow` (errorCall "foo")
diff --git a/warp.cabal b/warp.cabal
--- a/warp.cabal
+++ b/warp.cabal
@@ -1,279 +1,356 @@
-Name:                warp
-Version:             3.3.31
-Synopsis:            A fast, light-weight web server for WAI applications.
-License:             MIT
-License-file:        LICENSE
-Author:              Michael Snoyman, Kazu Yamamoto, Matt Brown
-Maintainer:          michael@snoyman.com
-Homepage:            http://github.com/yesodweb/wai
-Category:            Web, Yesod
-Build-Type:          Simple
-Cabal-Version:       >= 1.10
-Stability:           Stable
-description:         HTTP\/1.0, HTTP\/1.1 and HTTP\/2 are supported.
-                     For HTTP\/2,  Warp supports direct and ALPN (in TLS)
-                     but not upgrade.
-                     API docs and the README are available at
-                     <http://www.stackage.org/package/warp>.
-extra-source-files:  attic/hex
-                     ChangeLog.md
-                     README.md
-                     test/head-response
-                     test/inputFile
+cabal-version:      >=1.10
+name:               warp
+version:            3.4.14
+license:            MIT
+license-file:       LICENSE
+maintainer:         michael@snoyman.com
+author:             Michael Snoyman, Kazu Yamamoto, Matt Brown
+stability:          Stable
+homepage:           https://github.com/yesodweb/wai
+synopsis:           A fast, light-weight web server for WAI applications.
+description:
+    HTTP\/1.0, HTTP\/1.1 and HTTP\/2 are supported.
+    For HTTP\/2,  Warp supports direct and ALPN (in TLS)
+    but not upgrade.
+    API docs and the README are available at
+    <https://www.stackage.org/package/warp>.
 
-Flag network-bytestring
-    Default: False
+category:           Web, Yesod
+build-type:         Simple
+extra-source-files:
+    attic/hex
+    ChangeLog.md
+    README.md
+    test/head-response
+    test/inputFile
 
-Flag allow-sendfilefd
-    Description: Allow use of sendfileFd (not available on GNU/kFreeBSD)
-    Default:     True
+source-repository head
+    type:     git
+    location: https://github.com/yesodweb/wai.git
+    subdir:   warp
 
-Flag warp-debug
-    Description: print debug output. not suitable for production
-    Default:     False
+flag network-bytestring
+    default: False
 
-Flag x509
-    Description: Adds a dependency on the x509 library to enable getting TLS client certificates.
-    Default:     True
+flag allow-sendfilefd
+    description: Allow use of sendfileFd (not available on GNU/kFreeBSD)
 
-Library
-  Build-Depends:     base                      >= 4.12       && < 5
-                   , array
-                   , auto-update               >= 0.1.3    && < 0.2
-                   , bsb-http-chunked                         < 0.1
-                   , bytestring                >= 0.9.1.4
-                   , case-insensitive          >= 0.2
-                   , containers
-                   , ghc-prim
-                   , hashable
-                   , http-date
-                   , http-types                >= 0.12
-                   , http2                     >= 5.0      && < 5.1
-                   , iproute                   >= 1.3.1
-                   , recv                      >= 0.1.0    && < 0.2.0
-                   , simple-sendfile           >= 0.2.7    && < 0.3
-                   , stm                       >= 2.3
-                   , streaming-commons         >= 0.1.10
-                   , text
-                   , time-manager
-                   , vault                     >= 0.3
-                   , wai                       >= 3.2      && < 3.3
-                   , word8
-                   , unliftio
-  if flag(x509)
-      Build-Depends: crypton-x509
-  if impl(ghc < 8)
-      Build-Depends: semigroups
-  if flag(network-bytestring)
-      Build-Depends: network                   >= 2.2.1.5  && < 2.2.3
-                   , network-bytestring        >= 0.1.3    && < 0.1.4
-  else
-      Build-Depends: network               >= 2.3
-  Exposed-modules:   Network.Wai.Handler.Warp
-                     Network.Wai.Handler.Warp.Internal
-  Other-modules:     Network.Wai.Handler.Warp.Buffer
-                     Network.Wai.Handler.Warp.Conduit
-                     Network.Wai.Handler.Warp.Counter
-                     Network.Wai.Handler.Warp.Date
-                     Network.Wai.Handler.Warp.FdCache
-                     Network.Wai.Handler.Warp.File
-                     Network.Wai.Handler.Warp.FileInfoCache
-                     Network.Wai.Handler.Warp.HashMap
-                     Network.Wai.Handler.Warp.HTTP1
-                     Network.Wai.Handler.Warp.HTTP2
-                     Network.Wai.Handler.Warp.HTTP2.File
-                     Network.Wai.Handler.Warp.HTTP2.PushPromise
-                     Network.Wai.Handler.Warp.HTTP2.Request
-                     Network.Wai.Handler.Warp.HTTP2.Response
-                     Network.Wai.Handler.Warp.HTTP2.Types
-                     Network.Wai.Handler.Warp.Header
-                     Network.Wai.Handler.Warp.IO
-                     Network.Wai.Handler.Warp.Imports
-                     Network.Wai.Handler.Warp.PackInt
-                     Network.Wai.Handler.Warp.ReadInt
-                     Network.Wai.Handler.Warp.Request
-                     Network.Wai.Handler.Warp.RequestHeader
-                     Network.Wai.Handler.Warp.Response
-                     Network.Wai.Handler.Warp.ResponseHeader
-                     Network.Wai.Handler.Warp.Run
-                     Network.Wai.Handler.Warp.SendFile
-                     Network.Wai.Handler.Warp.Settings
-                     Network.Wai.Handler.Warp.Types
-                     Network.Wai.Handler.Warp.Windows
-                     Network.Wai.Handler.Warp.WithApplication
-                     Paths_warp
-  Ghc-Options:       -Wall
+flag include-warp-version
+    description:
+        Exposes the version in Network.Wai.Handler.Warp.warpVersion.
+        This adds a dependency on Paths_warp so application binaries may
+        reference subpaths of GHC. For nix users this may result in binaries
+        with a large transitive runtime dependency closure that includes GHC
+        itself.
+    default:     True
+    manual:      True
 
-  if flag(warp-debug)
-      Cpp-Options:   -DWARP_DEBUG
-  if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)
-      Cpp-Options:   -DSENDFILEFD
-  if os(windows)
-      Cpp-Options:   -DWINDOWS
-      Build-Depends: time
-                   , unix-compat >= 0.2
-  else
-      Build-Depends: unix
-      Other-modules: Network.Wai.Handler.Warp.MultiMap
-  if impl(ghc >= 8)
-      Default-Extensions:  Strict StrictData
-  Default-Language:     Haskell2010
+flag warp-debug
+    description: print debug output. not suitable for production
+    default:     False
 
-Test-Suite doctest
-  buildable:            False
-  Type:                 exitcode-stdio-1.0
-  HS-Source-Dirs:       test
-  Ghc-Options:          -threaded -Wall
-  Main-Is:              doctests.hs
-  Build-Depends:        base >= 4.8 && < 5
-                      , doctest >= 0.10.1
-  if os(windows)
-    Buildable: False
-  if impl(ghc >= 8)
-      Default-Extensions:  Strict StrictData
-  Default-Language:     Haskell2010
+flag x509
+    description:
+        Adds a dependency on the x509 library to enable getting TLS client certificates.
 
-Test-Suite spec
-    Main-Is:         Spec.hs
-    Other-modules:   ConduitSpec
-                     ExceptionSpec
-                     FdCacheSpec
-                     FileSpec
-                     ReadIntSpec
-                     RequestSpec
-                     ResponseHeaderSpec
-                     ResponseSpec
-                     RunSpec
-                     SendFileSpec
-                     WithApplicationSpec
-                     HTTP
-                     Network.Wai.Handler.Warp
-                     Network.Wai.Handler.Warp.Buffer
-                     Network.Wai.Handler.Warp.Conduit
-                     Network.Wai.Handler.Warp.Counter
-                     Network.Wai.Handler.Warp.Date
-                     Network.Wai.Handler.Warp.FdCache
-                     Network.Wai.Handler.Warp.File
-                     Network.Wai.Handler.Warp.FileInfoCache
-                     Network.Wai.Handler.Warp.HTTP1
-                     Network.Wai.Handler.Warp.HTTP2
-                     Network.Wai.Handler.Warp.HTTP2.File
-                     Network.Wai.Handler.Warp.HTTP2.PushPromise
-                     Network.Wai.Handler.Warp.HTTP2.Request
-                     Network.Wai.Handler.Warp.HTTP2.Response
-                     Network.Wai.Handler.Warp.HTTP2.Types
-                     Network.Wai.Handler.Warp.HashMap
-                     Network.Wai.Handler.Warp.Header
-                     Network.Wai.Handler.Warp.IO
-                     Network.Wai.Handler.Warp.Imports
-                     Network.Wai.Handler.Warp.MultiMap
-                     Network.Wai.Handler.Warp.PackInt
-                     Network.Wai.Handler.Warp.ReadInt
-                     Network.Wai.Handler.Warp.Request
-                     Network.Wai.Handler.Warp.RequestHeader
-                     Network.Wai.Handler.Warp.Response
-                     Network.Wai.Handler.Warp.ResponseHeader
-                     Network.Wai.Handler.Warp.Run
-                     Network.Wai.Handler.Warp.SendFile
-                     Network.Wai.Handler.Warp.Settings
-                     Network.Wai.Handler.Warp.Types
-                     Network.Wai.Handler.Warp.Windows
-                     Network.Wai.Handler.Warp.WithApplication
-                     Paths_warp
+library
+    exposed-modules:
+        Network.Wai.Handler.Warp
+        Network.Wai.Handler.Warp.Internal
 
-    Hs-Source-Dirs:  test, .
-    Type:            exitcode-stdio-1.0
+    other-modules:
+        Network.Wai.Handler.Warp.Buffer
+        Network.Wai.Handler.Warp.Conduit
+        Network.Wai.Handler.Warp.Counter
+        Network.Wai.Handler.Warp.Date
+        Network.Wai.Handler.Warp.FdCache
+        Network.Wai.Handler.Warp.File
+        Network.Wai.Handler.Warp.FileInfoCache
+        Network.Wai.Handler.Warp.HTTP1
+        Network.Wai.Handler.Warp.HTTP2
+        Network.Wai.Handler.Warp.HTTP2.File
+        Network.Wai.Handler.Warp.HTTP2.PushPromise
+        Network.Wai.Handler.Warp.HTTP2.Request
+        Network.Wai.Handler.Warp.HTTP2.Response
+        Network.Wai.Handler.Warp.HTTP2.Types
+        Network.Wai.Handler.Warp.HashMap
+        Network.Wai.Handler.Warp.Header
+        Network.Wai.Handler.Warp.IO
+        Network.Wai.Handler.Warp.Imports
+        Network.Wai.Handler.Warp.PackInt
+        Network.Wai.Handler.Warp.ReadInt
+        Network.Wai.Handler.Warp.Request
+        Network.Wai.Handler.Warp.RequestHeader
+        Network.Wai.Handler.Warp.Response
+        Network.Wai.Handler.Warp.ResponseHeader
+        Network.Wai.Handler.Warp.Run
+        Network.Wai.Handler.Warp.SendFile
+        Network.Wai.Handler.Warp.Settings
+        Network.Wai.Handler.Warp.ShuttingDown
+        Network.Wai.Handler.Warp.Types
+        Network.Wai.Handler.Warp.Windows
+        Network.Wai.Handler.Warp.WithApplication
 
-    Ghc-Options:     -Wall -threaded
-    Build-Tool-Depends: hspec-discover:hspec-discover
-    Build-Depends:   base >= 4.8 && < 5
-                   , QuickCheck
-                   , array
-                   , auto-update
-                   , bsb-http-chunked                         < 0.1
-                   , bytestring                >= 0.9.1.4
-                   , case-insensitive          >= 0.2
-                   , containers
-                   , directory
-                   , ghc-prim
-                   , hashable
-                   , hspec                     >= 1.3
-                   , http-client
-                   , http-date
-                   , http-types                >= 0.12
-                   , http2                     >= 5.0      && < 5.1
-                   , iproute                   >= 1.3.1
-                   , network
-                   , process
-                   , recv                      >= 0.1.0    && < 0.2.0
-                   , simple-sendfile           >= 0.2.4    && < 0.3
-                   , stm                       >= 2.3
-                   , streaming-commons         >= 0.1.10
-                   , text
-                   , time-manager
-                   , vault
-                   , wai                       >= 3.2.2.1  && < 3.3
-                   , word8
-                   , unliftio
-  if flag(x509)
-      Build-Depends: crypton-x509
-  if impl(ghc < 8)
-      Build-Depends: semigroups
-                   , transformers
+    if flag(include-warp-version)
+        other-modules: Paths_warp
 
-  if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)
-      Cpp-Options:   -DSENDFILEFD
-  if os(windows)
-      Cpp-Options:   -DWINDOWS
-      Build-Depends: time
-                 , unix-compat >= 0.2
-  else
-      Build-Depends: unix
-      Other-modules: Network.Wai.Handler.Warp.MultiMap
-  if impl(ghc >= 8)
-      Default-Extensions:  Strict StrictData
-  Default-Language:     Haskell2010
+    default-language: Haskell2010
+    ghc-options:      -Wall
+    build-depends:
+        base >=4.12 && <5,
+        array,
+        auto-update >=0.2.2 && <0.3,
+        async >= 2,
+        bsb-http-chunked <0.1,
+        bytestring >=0.9.1.4,
+        case-insensitive >=0.2,
+        containers,
+        hashable,
+        http-date,
+        http-types >=0.12,
+        http2 >=5.4 && <5.5,
+        iproute >=1.3.1,
+        recv >=0.1.0 && <0.2.0,
+        simple-sendfile >=0.2.7 && <0.3,
+        stm >=2.3,
+        streaming-commons >=0.1.10,
+        text,
+        time-manager >=0.2 && <0.4,
+        vault >=0.3,
+        wai >=3.2.4 && <3.3,
+        word8
 
-Benchmark parser
-    Type:           exitcode-stdio-1.0
-    Main-Is:        Parser.hs
-    other-modules:  Network.Wai.Handler.Warp.Date
-                    Network.Wai.Handler.Warp.FdCache
-                    Network.Wai.Handler.Warp.FileInfoCache
-                    Network.Wai.Handler.Warp.HashMap
-                    Network.Wai.Handler.Warp.Imports
-                    Network.Wai.Handler.Warp.MultiMap
-                    Network.Wai.Handler.Warp.Types
-    HS-Source-Dirs: bench .
-    Build-Depends:  base >= 4.8 && < 5
-                  , auto-update
-                  , bytestring
-                  , containers
-                  , gauge
-                  , hashable
-                  , http-date
-                  , http-types
-                  , network
-                  , network
-                  , recv
-                  , time-manager
-                  , unliftio
-  if flag(x509)
-      Build-Depends: crypton-x509
-  if impl(ghc < 8)
-      Build-Depends: semigroups
+    if flag(x509)
+        build-depends: crypton-x509
 
-  if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)
-    Cpp-Options:   -DSENDFILEFD
-    Build-Depends: unix
-  if os(windows)
-    Cpp-Options:   -DWINDOWS
-    Build-Depends: time
-                 , unix-compat >= 0.2
-  if impl(ghc >= 8)
-      Default-Extensions:  Strict StrictData
-  Default-Language:     Haskell2010
+    if impl(ghc <8)
+        build-depends: semigroups
 
-Source-Repository head
-  Type:     git
-  Location: git://github.com/yesodweb/wai.git
+    if flag(network-bytestring)
+        build-depends:
+            network >=2.2.1.5 && <2.2.3,
+            network-bytestring >=0.1.3 && <0.1.4
+
+    else
+        build-depends: network >=2.3
+
+    if flag(warp-debug)
+        cpp-options: -DWARP_DEBUG
+
+    if (((os(linux) || os(freebsd)) || os(osx)) && flag(allow-sendfilefd))
+        cpp-options: -DSENDFILEFD
+
+    if os(windows)
+        cpp-options:   -DWINDOWS
+        build-depends:
+            time,
+            unix-compat >=0.2
+
+    else
+        other-modules: Network.Wai.Handler.Warp.MultiMap
+        build-depends: unix
+
+    if impl(ghc >=8)
+        default-extensions: Strict StrictData
+
+    if flag(include-warp-version)
+        cpp-options: -DINCLUDE_WARP_VERSION
+
+test-suite doctest
+    type:             exitcode-stdio-1.0
+    main-is:          doctests.hs
+    buildable:        False
+    hs-source-dirs:   test
+    default-language: Haskell2010
+    ghc-options:      -threaded -Wall
+    build-depends:
+        base >=4.8 && <5,
+        doctest >=0.10.1
+
+    if os(windows)
+        buildable: False
+
+    if impl(ghc >=8)
+        default-extensions: Strict StrictData
+
+test-suite spec
+    type:               exitcode-stdio-1.0
+    main-is:            Spec.hs
+    build-tool-depends: hspec-discover:hspec-discover
+    hs-source-dirs:     test .
+    other-modules:
+        ConduitSpec
+        ConnectionSpec
+        ExceptionSpec
+        FdCacheSpec
+        FileSpec
+        GracefulShutdownSpec
+        HTTP
+        PackIntSpec
+        ReadIntSpec
+        RequestSpec
+        ResponseHeaderSpec
+        ResponseSpec
+        RunSpec
+        SendFileSpec
+        ServerStateSpec
+        WithApplicationSpec
+        Network.Wai.Handler.Warp
+        Network.Wai.Handler.Warp.Internal
+        Network.Wai.Handler.Warp.Buffer
+        Network.Wai.Handler.Warp.Conduit
+        Network.Wai.Handler.Warp.Counter
+        Network.Wai.Handler.Warp.Date
+        Network.Wai.Handler.Warp.FdCache
+        Network.Wai.Handler.Warp.File
+        Network.Wai.Handler.Warp.FileInfoCache
+        Network.Wai.Handler.Warp.HTTP1
+        Network.Wai.Handler.Warp.HTTP2
+        Network.Wai.Handler.Warp.HTTP2.File
+        Network.Wai.Handler.Warp.HTTP2.PushPromise
+        Network.Wai.Handler.Warp.HTTP2.Request
+        Network.Wai.Handler.Warp.HTTP2.Response
+        Network.Wai.Handler.Warp.HTTP2.Types
+        Network.Wai.Handler.Warp.HashMap
+        Network.Wai.Handler.Warp.Header
+        Network.Wai.Handler.Warp.IO
+        Network.Wai.Handler.Warp.Imports
+        Network.Wai.Handler.Warp.PackInt
+        Network.Wai.Handler.Warp.ReadInt
+        Network.Wai.Handler.Warp.Request
+        Network.Wai.Handler.Warp.RequestHeader
+        Network.Wai.Handler.Warp.Response
+        Network.Wai.Handler.Warp.ResponseHeader
+        Network.Wai.Handler.Warp.Run
+        Network.Wai.Handler.Warp.SendFile
+        Network.Wai.Handler.Warp.Settings
+        Network.Wai.Handler.Warp.ShuttingDown
+        Network.Wai.Handler.Warp.Types
+        Network.Wai.Handler.Warp.Windows
+        Network.Wai.Handler.Warp.WithApplication
+
+    if flag(include-warp-version)
+        other-modules: Paths_warp
+
+    default-language:   Haskell2010
+    ghc-options:        -Wall -threaded
+    build-depends:
+        base >=4.8 && <5,
+        QuickCheck,
+        array,
+        auto-update,
+        async,
+        bsb-http-chunked <0.1,
+        bytestring >=0.9.1.4,
+        case-insensitive >=0.2,
+        containers,
+        directory,
+        hashable,
+        hspec >=1.3,
+        http-client,
+        http-date,
+        http-types >=0.12,
+        http2 >=5.4 && <5.5,
+        iproute >=1.3.1,
+        network,
+        process,
+        recv >=0.1.0 && <0.2.0,
+        simple-sendfile >=0.2.4 && <0.3,
+        stm >=2.3,
+        streaming-commons >=0.1.10,
+        text,
+        time-manager,
+        vault,
+        wai >=3.2.2.1 && <3.3,
+        -- workaround: this should be unnecessary
+        warp,
+        word8
+
+    if flag(x509)
+        build-depends: crypton-x509
+
+    if impl(ghc <8)
+        build-depends:
+            semigroups,
+            transformers
+
+    if (((os(linux) || os(freebsd)) || os(osx)) && flag(allow-sendfilefd))
+        cpp-options: -DSENDFILEFD
+
+    if os(windows)
+        cpp-options:   -DWINDOWS
+        build-depends:
+            time,
+            unix-compat >=0.2
+
+    else
+        other-modules: Network.Wai.Handler.Warp.MultiMap
+        build-depends: unix
+
+    if impl(ghc >=8)
+        default-extensions: Strict StrictData
+
+benchmark parser
+    type:             exitcode-stdio-1.0
+    main-is:          Parser.hs
+    hs-source-dirs:   bench .
+    other-modules:
+        Network.Wai.Handler.Warp.Conduit
+        Network.Wai.Handler.Warp.Counter
+        Network.Wai.Handler.Warp.Date
+        Network.Wai.Handler.Warp.FdCache
+        Network.Wai.Handler.Warp.FileInfoCache
+        Network.Wai.Handler.Warp.HashMap
+        Network.Wai.Handler.Warp.Header
+        Network.Wai.Handler.Warp.Imports
+        Network.Wai.Handler.Warp.MultiMap
+        Network.Wai.Handler.Warp.ReadInt
+        Network.Wai.Handler.Warp.Request
+        Network.Wai.Handler.Warp.RequestHeader
+        Network.Wai.Handler.Warp.Settings
+        Network.Wai.Handler.Warp.Types
+
+    if flag(include-warp-version)
+        other-modules: Paths_warp
+
+    default-language: Haskell2010
+    build-depends:
+        base >=4.8 && <5,
+        array,
+        auto-update,
+        bytestring,
+        case-insensitive,
+        containers,
+        criterion,
+        hashable,
+        http-date,
+        http-types,
+        network,
+        network,
+        recv,
+        stm,
+        streaming-commons,
+        text,
+        time-manager,
+        vault,
+        wai,
+        word8
+
+    if flag(x509)
+        build-depends: crypton-x509
+
+    if impl(ghc <8)
+        build-depends: semigroups
+
+    if (((os(linux) || os(freebsd)) || os(osx)) && flag(allow-sendfilefd))
+        cpp-options:   -DSENDFILEFD
+        build-depends: unix
+
+    if os(windows)
+        cpp-options:   -DWINDOWS
+        build-depends:
+            time,
+            unix-compat >=0.2
+
+    if impl(ghc >=8)
+        default-extensions: Strict StrictData