diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,279 @@
+# 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.
+
+## 3.3.30
+
+* Length of `ResponseBuilder` responses will now also be passed to the logger.
+   [#946](https://github.com/yesodweb/wai/pull/946)
+* Using `If-(None-)Match` headers simultaneously with `If-(Un)Modified-Since` headers now
+  follow the RFC 9110 standard. So `If-(Un)Modified-Since` headers will be correctly ignored
+  if their respective `-Match` counterpart is also present in the request headers.
+   [#945](https://github.com/yesodweb/wai/pull/945)
+* Fixed adding superfluous `Server` header when using HTTP/2.0 if response already has it.
+   [#943](https://github.com/yesodweb/wai/pull/943)
+
+## 3.3.29
+
+* Preparing coming "http2" v4.2.0.
+
+## 3.3.28
+
+* Fix for the "-x509" flag
+   [#935](https://github.com/yesodweb/wai/pull/935)
+
+## 3.3.27
+
+* Fixing busy loop due to eMFILE
+  [#933](https://github.com/yesodweb/wai/pull/933)
+
+## 3.3.26
+
+* Using crypton instead of cryptonite.
+  [#931](https://github.com/yesodweb/wai/pull/931)
+
+## 3.3.25
+
+* Catching up the signature change of openFd in the unix package v2.8.
+  [#926](https://github.com/yesodweb/wai/pull/926)
+
+## 3.3.24
+
+* Switching the version of the "recv" package from 0.0.x to 0.1.x.
+
+## 3.3.23
+
+* Add `setAccept` for hooking the socket `accept` call.
+  [#912](https://github.com/yesodweb/wai/pull/912)
+* Removed some package dependencies from test suite
+  [#902](https://github.com/yesodweb/wai/pull/902)
+* Factored out `Network.Wai.Handler.Warp.Recv` to its own package `recv`.
+  [#899](https://github.com/yesodweb/wai/pull/899)
+
+## 3.3.22
+
+* Creating a bigger buffer when the current one is too small to fit the Builder
+  [#895](https://github.com/yesodweb/wai/pull/895)
+* Using InvalidRequest instead of HTTP2Error
+  [#890](https://github.com/yesodweb/wai/pull/890)
+
+## 3.3.21
+
+* Support GHC 9.4 [#889](https://github.com/yesodweb/wai/pull/889)
+
+## 3.3.20
+
+* Adding "x509" flag.
+  [#871](https://github.com/yesodweb/wai/pull/871)
+
+## 3.3.19
+
+* Allowing the eMFILE exception in acceptNewConnection.
+  [#831](https://github.com/yesodweb/wai/pull/831)
+
+## 3.3.18
+
+* Tidy up HashMap and MultiMap [#864](https://github.com/yesodweb/wai/pull/864)
+* Support GHC 9.2 [#863](https://github.com/yesodweb/wai/pull/863)
+
+## 3.3.17
+
+* Modify exception handling to swallow async exceptions in forked thread [#850](https://github.com/yesodweb/wai/issues/850)
+* Switch default forking function to not install the global exception handler (minor optimization) [#851](https://github.com/yesodweb/wai/pull/851)
+
+## 3.3.16
+
+* Move exception handling over to `unliftio` for better async exception support [#845](https://github.com/yesodweb/wai/issues/845)
+
+## 3.3.15
+
+* Using http2 v3.
+
+## 3.3.14
+
+* Drop support for GHC < 8.2.
+* Fix header length calculation for `settingsMaxTotalHeaderLength`
+  [#838](https://github.com/yesodweb/wai/pull/838)
+* UTF-8 encoding in `exceptionResponseForDebug`.
+  [#836](https://github.com/yesodweb/wai/pull/836)
+
+## 3.3.13
+
+* pReadMaker is exported from the Internal module.
+
+## 3.3.12
+
+* Fixing HTTP/2 logging relating to status and push.
+* Adding QUIC constructor to Transport.
+
+## 3.3.11
+
+* Adding setAltSvc.
+  [#801](https://github.com/yesodweb/wai/pull/801)
+* Fixing timeout of builder for HTTP/1.1.
+  [#800](https://github.com/yesodweb/wai/pull/800)
+* `http2server` and `withII` are exported from `Internal` module.
+
+## 3.3.10
+
+* Convert ResourceVanished error to ConnectionClosedByPeer exception
+  [#795](https://github.com/yesodweb/wai/pull/795)
+* Expand the documentation for `setTimeout`.
+  [#796](https://github.com/yesodweb/wai/pull/796)
+
+## 3.3.9
+
+* Don't insert Last-Modified: if exists.
+  [#791](https://github.com/yesodweb/wai/pull/791)
+
+## 3.3.8
+
+* Maximum header size is configurable.
+  [#781](https://github.com/yesodweb/wai/pull/781)
+* Ignoring an exception from shutdown (gracefulClose).
+
+## 3.3.7
+
+* InvalidArgument (Bad file descriptor) is ignored in `receive`.
+  [#787](https://github.com/yesodweb/wai/pull/787)
+
+## 3.3.6
+
+* Fixing a bug of thread killed in the case of event source with
+  HTTP/2 (fixing #692 and #785)
+* New APIs: clientCertificate to get client's certificate
+  [#783](https://github.com/yesodweb/wai/pull/783)
+
+## 3.3.5
+
+* New APIs: setGracefulCloseTimeout1 and setGracefulCloseTimeout2.
+  For HTTP/1.x, connections are closed immediately by default.
+  gracefullClose is used for HTTP/2 by default.
+  [#782](https://github.com/yesodweb/wai/pull/782)
+
+## 3.3.4
+
+* Setting isSecure of HTTP/2 correctly.
+
+## 3.3.3
+
+* Calling setOnException in HTTP/2.
+  [#771](https://github.com/yesodweb/wai/pull/771)
+
+## 3.3.2
+
+* Fixing a bug of HTTP/2 without fd cache.
+
+## 3.3.1
+
+* Using gracefullClose of network 3.1.1 or later if available.
+* If the first line of an HTTP request is really invalid,
+  don't send an error response
+
+## 3.3.0
+
+* Switching from the original implementation to HTTP/2 server library.
+  [#754](https://github.com/yesodweb/wai/pull/754)
+* Breaking change: The type of `http2dataTrailers` is now
+  `HTTP2Data -> TrailersMaker`.
+
 ## 3.2.28
 
 * Using the Strict and StrictData language extensions for GHC >8.
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,104 +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
-  , setProxyProtocolNone
-  , setProxyProtocolRequired
-  , setProxyProtocolOptional
-  , setSlowlorisSize
-  , setHTTP2Disabled
-  , setLogger
-  , setServerPushLogger
-  , setGracefulShutdownTimeout
+    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
+    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
-  , withApplication
-  , withApplicationSettings
-  , testWithApplication
-  , testWithApplicationSettings
-  , openFreePort
+    pauseTimeout,
+    FileInfo (..),
+    getFileInfo,
+#ifdef MIN_VERSION_crypton_x509
+    clientCertificate,
+#endif
+    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 Control.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 (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)
@@ -141,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'
@@ -171,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.
@@ -179,26 +233,32 @@
 --
 -- 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}
 
--- | Timeout value in seconds. Default value: 30
+-- | "Slow-loris" timeout lower-bound value in seconds.  Connections where
+-- network progress is made less frequently than this may be closed.  In
+-- practice many connections may be allowed to go without progress for up to
+-- twice this amount of time.  Note that this timeout is not applied to
+-- application code, only network progress.
 --
+-- Default value: 30
+--
 -- 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.
 --
@@ -214,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.
 --
@@ -228,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
@@ -238,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.
 --
@@ -248,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.
 --
@@ -298,7 +358,7 @@
 --
 -- Note that by default, the graceful shutdown mode lasts indefinitely
 -- (see 'setGracefulShutdownTimeout'). If you install a signal handler as above,
--- upon receiving that signal, the custon shutdown action will run /and/ all
+-- upon receiving that signal, the custom shutdown action will run /and/ all
 -- outstanding requests will be handled.
 --
 -- You may instead prefer to do one or both of the following:
@@ -312,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.
@@ -321,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.
 --
@@ -338,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.
 --
@@ -348,14 +408,26 @@
 -- 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.
+--
+-- Useful if you need to provide connected sockets from something other
+-- than a standard accept call.
+--
+-- Default: 'defaultAccept'
+--
+-- Since 3.3.24
+setAccept :: (Socket -> IO (Socket, SockAddr)) -> Settings -> Settings
+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.
 --
@@ -371,14 +443,14 @@
 --
 -- 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'.
 --
 -- WARNING: This is contrary to the PROXY protocol specification and
 -- using it can indicate a security problem with your
--- architecture if the web server is directly accessable
+-- architecture if the web server is directly accessible
 -- to the public, since it would allow easy IP address
 -- spoofing.  However, it can be useful in some cases,
 -- such as if a load balancer health check uses regular
@@ -387,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
@@ -426,10 +502,33 @@
 -- 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
+        }
+
+-- | Setting the header value of Alternative Services (AltSvc:).
+--
+-- Since 3.3.11
+setAltSvc :: ByteString -> Settings -> Settings
+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}
+
 -- | Explicitly pause the slowloris timeout.
 --
 -- This is useful for cases where you partially consume a request body. For
@@ -456,4 +555,66 @@
 --
 -- 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.
+--   Default: 0.
+--
+-- Since 3.3.5
+setGracefulCloseTimeout1 :: Int -> Settings -> Settings
+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.
+--
+-- Since 3.3.5
+getGracefulCloseTimeout1 :: Settings -> Int
+getGracefulCloseTimeout1 = settingsGracefulCloseTimeout1
+
+-- | 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
+setGracefulCloseTimeout2 :: Int -> Settings -> Settings
+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.
+--
+-- 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.
+--
+-- Since 3.3.5
+clientCertificate :: Request -> Maybe CertificateChain
+clientCertificate = join . Vault.lookup getClientCertificateKey . vault
+#endif
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,38 +1,37 @@
-{-# LANGUAGE BangPatterns #-}
-
 module Network.Wai.Handler.Warp.Buffer (
-    bufferSize
-  , allocateBuffer
-  , freeBuffer
-  , mallocBS
-  , newBufferPool
-  , withBufferPool
-  , toBuilderBuffer
-  , copy
-  , bufferIO
-  ) where
+    createWriteBuffer,
+    allocateBuffer,
+    freeBuffer,
+    toBuilderBuffer,
+    bufferIO,
+) where
 
-import qualified Data.ByteString as BS
-import Data.ByteString.Internal (memcpy)
-import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)
-import Data.IORef (newIORef, readIORef, writeIORef)
+import Data.IORef (IORef, readIORef)
 import qualified Data.Streaming.ByteString.Builder.Buffer as B (Buffer (..))
 import Foreign.ForeignPtr
-import Foreign.Marshal.Alloc (mallocBytes, free, finalizerFree)
-import Foreign.Ptr (castPtr, plusPtr)
+import Foreign.Marshal.Alloc (free, mallocBytes)
+import Foreign.Ptr (plusPtr)
+import Network.Socket.BufferPool
 
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.Types
 
 ----------------------------------------------------------------
 
--- | The default size of the write buffer: 16384 (2^14 = 1024 * 16).
---   This is the maximum size of TLS record.
---   This is also the maximum size of HTTP/2 frame payload
---   (excluding frame header).
-bufferSize :: BufSize
-bufferSize = 16384
+-- | Allocate a buffer of the given size and wrap it in a 'WriteBuffer'
+-- 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
+            }
 
+----------------------------------------------------------------
+
 -- | Allocating a buffer with malloc().
 allocateBuffer :: Int -> IO Buffer
 allocateBuffer = mallocBytes
@@ -42,66 +41,17 @@
 freeBuffer = free
 
 ----------------------------------------------------------------
-
-largeBufferSize :: Int
-largeBufferSize = 16384
-
-minBufferSize :: Int
-minBufferSize = 2048
-
-newBufferPool :: IO BufferPool
-newBufferPool = newIORef BS.empty
-
-mallocBS :: Int -> IO ByteString
-mallocBS size = do
-    ptr <- allocateBuffer size
-    fptr <- newForeignPtr finalizerFree ptr
-    return $! PS fptr 0 size
-{-# INLINE mallocBS #-}
-
-usefulBuffer :: ByteString -> Bool
-usefulBuffer buffer = BS.length buffer >= minBufferSize
-{-# INLINE usefulBuffer #-}
-
-getBuffer :: BufferPool -> IO ByteString
-getBuffer pool = do
-    buffer <- readIORef pool
-    if usefulBuffer buffer then return buffer else mallocBS largeBufferSize
-{-# INLINE getBuffer #-}
-
-putBuffer :: BufferPool -> ByteString -> IO ()
-putBuffer pool buffer = writeIORef pool buffer
-{-# INLINE putBuffer #-}
-
-withForeignBuffer :: ByteString -> ((Buffer, BufSize) -> IO Int) -> IO Int
-withForeignBuffer (PS ps s l) f = withForeignPtr ps $ \p -> f (castPtr p `plusPtr` s, l)
-{-# INLINE withForeignBuffer #-}
-
-withBufferPool :: BufferPool -> ((Buffer, BufSize) -> IO Int) -> IO ByteString
-withBufferPool pool f = do
-    buffer <- getBuffer pool
-    consumed <- withForeignBuffer buffer f
-    putBuffer pool $! unsafeDrop consumed buffer
-    return $! unsafeTake consumed buffer
-{-# INLINE withBufferPool #-}
-
-----------------------------------------------------------------
 --
 -- Utilities
 --
 
-toBuilderBuffer :: Buffer -> BufSize -> IO B.Buffer
-toBuilderBuffer ptr size = do
+toBuilderBuffer :: IORef WriteBuffer -> IO B.Buffer
+toBuilderBuffer writeBufferRef = do
+    writeBuffer <- readIORef writeBufferRef
+    let ptr = bufBuffer writeBuffer
+        size = bufSize writeBuffer
     fptr <- newForeignPtr_ ptr
     return $ B.Buffer fptr ptr ptr (ptr `plusPtr` size)
-
--- | Copying the bytestring to the buffer.
---   This function returns the point where the next copy should start.
-copy :: Buffer -> ByteString -> IO Buffer
-copy !ptr (PS fp o l) = withForeignPtr fp $ \p -> do
-    memcpy ptr (p `plusPtr` o) (fromIntegral l)
-    return $! ptr `plusPtr` l
-{-# INLINE copy #-}
 
 bufferIO :: Buffer -> Int -> (ByteString -> IO ()) -> IO ()
 bufferIO ptr siz io = do
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 Control.Exception
+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
-    unless (x == 0) retry
+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 Control.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)
 
 ----------------------------------------------------------------
 
@@ -67,7 +77,11 @@
 
 openFile :: FilePath -> IO Fd
 openFile path = do
-    fd <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock=False}
+#if MIN_VERSION_unix(2,8,0)
+    fd <- openFd path ReadOnly defaultFileFlags{nonBlock = False}
+#else
+    fd <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock = False}
+#endif
     setFileCloseOnExec fd
     return fd
 
@@ -85,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
@@ -95,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
 
 ----------------------------------------------------------------
 
@@ -134,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,33 +21,53 @@
 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 -> IndexedHeader
-                   -> RspFileInfo
-conditionalRequest finfo hs0 reqidx = case condition of
+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   -> let !hs = (H.hLastModified,date) :
-                                        addContentHeaders hs0 off len size
-                              in WithBody s hs 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
   where
     !mtime = I.fileInfoTime finfo
-    !size  = I.fileInfoSize finfo
-    !date  = I.fileInfoDate finfo
-    !mcondition = ifmodified    reqidx size mtime
-              <|> ifunmodified  reqidx size mtime
-              <|> ifrange       reqidx size mtime
+    !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:
+    -- - If-Match
+    -- - If-Unmodified-Since
+    -- - If-None-Match
+    -- - If-Modified-Since
+    -- - If-Range
+    --
+    -- We don't actually implement the If-(None-)Match logic, but
+    -- 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
     !condition = fromMaybe (unconditional reqidx size) mcondition
 
 ----------------------------------------------------------------
@@ -63,51 +83,68 @@
 
 ----------------------------------------------------------------
 
-ifmodified :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo
-ifmodified reqidx size mtime = do
+ifmodified :: IndexedHeader -> HTTPDate -> H.Method -> Maybe RspFileInfo
+ifmodified reqidx mtime method = do
     date <- ifModifiedSince reqidx
-    return $ if date /= mtime
-             then unconditional reqidx size
-             else WithoutBody H.notModified304
+    -- According to RFC 9110:
+    -- "A recipient MUST ignore If-Modified-Since if the request
+    -- contains an If-None-Match header field; [...]"
+    guard . isNothing $ reqidx ! fromEnum ReqIfNoneMatch
+    -- "A recipient MUST ignore the If-Modified-Since header field
+    -- if [...] the request method is neither GET nor HEAD."
+    guard $ method == H.methodGet || method == H.methodHead
+    guard $ date == mtime || date > mtime
+    Just $ WithoutBody H.notModified304
 
-ifunmodified :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo
-ifunmodified reqidx size mtime = do
+ifunmodified :: IndexedHeader -> HTTPDate -> Maybe RspFileInfo
+ifunmodified reqidx mtime = do
     date <- ifUnmodifiedSince reqidx
-    return $ if date == mtime
-             then unconditional reqidx size
-             else WithoutBody H.preconditionFailed412
+    -- According to RFC 9110:
+    -- "A recipient MUST ignore If-Unmodified-Since if the request
+    -- contains an If-Match header field; [...]"
+    guard . isNothing $ reqidx ! fromEnum ReqIfMatch
+    guard $ date /= mtime && date < mtime
+    Just $ WithoutBody H.preconditionFailed412
 
-ifrange :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo
-ifrange reqidx size mtime = do
+-- TODO: Should technically also strongly match on ETags.
+ifrange :: IndexedHeader -> HTTPDate -> H.Method -> Integer -> Maybe RspFileInfo
+ifrange reqidx mtime method size = do
+    -- According to RFC 9110:
+    -- "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
-    return $ if date == mtime
-             then parseRange rng size
-             else WithBody H.ok200 [] 0 size
+    rng <- reqidx ! fromEnum ReqRange
+    guard $ method == H.methodGet
+    return $
+        if date == mtime
+            then parseRange rng size
+            else WithBody H.ok200 [] 0 size
 
 unconditional :: IndexedHeader -> Integer -> RspFileInfo
-unconditional reqidx size = case reqidx ! fromEnum ReqRange of
-    Nothing  -> WithBody H.ok200 [] 0 size
-    Just rng -> parseRange rng size
+unconditional reqidx =
+    case reqidx ! fromEnum ReqRange of
+        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)
 
 ----------------------------------------------------------------
 
@@ -116,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
 
 -- |
 --
@@ -141,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,15 +1,20 @@
-{-# 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 as E
+import Control.Exception (bracket, onException, throwIO)
 import Control.Reaper
 import Network.HTTP.Date
+#if WINDOWS
 import System.PosixCompat.Files
+#else
+import System.Posix.Files
+#endif
 
 import Network.Wai.Handler.Warp.HashMap (HashMap)
 import qualified Network.Wai.Handler.Warp.HashMap as M
@@ -18,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)
 
 ----------------------------------------------------------------
 
@@ -37,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
-        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
@@ -57,49 +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     -> throwIO (userError "FileInfoCache:getAndRegisterInfo")
+        Just Negative -> throwIO (userError "FileInfoCache:getAndRegisterInfo")
         Just (Positive x) -> return x
-        Nothing           -> positive reaper path
-                               `E.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)
+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 =
-    E.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
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Handler/Warp/HTTP1.hs
@@ -0,0 +1,306 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Network.Wai.Handler.Warp.HTTP1 (
+    http1,
+) where
+
+import qualified Control.Concurrent as Conc (yield)
+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 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)
+import Network.Wai.Handler.Warp.ReadInt
+import Network.Wai.Handler.Warp.Request
+import Network.Wai.Handler.Warp.Response
+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 ii conn transport app origAddr th bs0 = do
+    istatus <- newIORef True
+    src <- mkSource (wrappedRecv conn istatus (settingsSlowlorisSize settings))
+    leftoverSource src bs0
+    addr <- getProxyProtocolAddr src
+    http1server settings ii conn transport app addr th istatus src
+  where
+    wrappedRecv Connection{connRecv = recv} istatus slowlorisSize = do
+        bs <- recv
+        unless (BS.null bs) $ do
+            writeIORef istatus True
+            when (BS.length bs >= slowlorisSize) $ T.tickle th
+        return bs
+
+    getProxyProtocolAddr src =
+        case settingsProxyProtocol settings of
+            ProxyProtocolNone ->
+                return origAddr
+            ProxyProtocolRequired -> do
+                seg <- readSource src
+                parseProxyProtocolHeader src seg
+            ProxyProtocolOptional -> do
+                seg <- readSource src
+                if BS.isPrefixOf "PROXY " seg
+                    then parseProxyProtocolHeader src seg
+                    else do
+                        leftoverSource src seg
+                        return origAddr
+
+    parseProxyProtocolHeader src seg = do
+        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)
+                                )
+                        _ -> Nothing
+                ["PROXY", "TCP6", clientAddr, _, clientPort, _] ->
+                    case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of
+                        [a] ->
+                            Just
+                                ( SockAddrInet6
+                                    (readInt clientPort)
+                                    0
+                                    (toHostAddress6 a)
+                                    0
+                                )
+                        _ -> Nothing
+                ("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
+
+    decodeAscii = map (chr . fromEnum) . BS.unpack
+
+http1server
+    :: Settings
+    -> InternalInfo
+    -> Connection
+    -> Transport
+    -> Application
+    -> SockAddr
+    -> T.Handle
+    -> IORef Bool
+    -> Source
+    -> IO ()
+http1server settings ii conn transport app addr th istatus src =
+    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 ()
+        | 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
+                `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 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
+
+        case keepAlive of
+            ReuseConnection -> loop SubsequentRequest
+            CloseConnection -> return ()
+
+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
+
+    -- In the event that some scarce resource was acquired during
+    -- 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 <- 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.
+        -- However, it may affect performance.
+        writeIORef istatus False
+        keepAlive <- sendResponse settings conn ii th req idxhdr (readSource src) res
+        writeIORef keepAliveRef keepAlive
+        return ResponseReceived
+    case r of
+        Right ResponseReceived -> return ()
+        Left (e :: SomeException)
+            | Just (ExceptionInsideResponseBody e') <- fromException e -> throwIO e'
+            | isAsyncException e -> throwIO e
+            | otherwise -> do
+                keepAlive <- sendErrorResponse settings ii conn th istatus req e
+                settingsOnException settings (Just req) e
+                writeIORef keepAliveRef keepAlive
+
+    keepAlive <- readIORef keepAliveRef
+
+    -- We just send a Response and it takes a time to
+    -- receive a Request again. If we immediately call recv,
+    -- it is likely to fail and cause the IO manager to do some work.
+    -- It is very costly, so we yield to another Haskell
+    -- thread hoping that the next Request will arrive
+    -- when this Haskell thread will be re-scheduled.
+    -- This improves performance at least when
+    -- the number of cores is small.
+    Conc.yield
+
+    if keepAlive
+        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 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 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
+  where
+    shouldSendErrorResponse se
+        | Just ConnectionClosedByPeer <- fromException se = False
+        | otherwise = True
+    errorResponse = settingsOnExceptionResponse settings e
+
+flushEntireBody :: IO ByteString -> IO ()
+flushEntireBody src =
+    loop
+  where
+    loop = do
+        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 src = loop
+  where
+    loop toRead = do
+        bs <- src
+        let toRead' = toRead - BS.length bs
+        case () of
+            ()
+                | BS.null bs -> return True
+                | toRead' >= 0 -> loop toRead'
+                | otherwise -> return False
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,69 +1,158 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
-module Network.Wai.Handler.Warp.HTTP2 (isHTTP2, http2) where
+module Network.Wai.Handler.Warp.HTTP2 (
+    http2,
+    http2server,
+) where
 
-import Control.Concurrent (forkIO, killThread)
 import qualified Control.Exception as E
-import Network.HTTP2
+import qualified Data.ByteString as BS
+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 qualified System.TimeManager as T
 
-import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
-import Network.Wai.Handler.Warp.HTTP2.Manager
-import Network.Wai.Handler.Warp.HTTP2.Receiver
+import Network.Wai.Handler.Warp.HTTP2.File
+import Network.Wai.Handler.Warp.HTTP2.PushPromise
 import Network.Wai.Handler.Warp.HTTP2.Request
-import Network.Wai.Handler.Warp.HTTP2.Sender
-import Network.Wai.Handler.Warp.HTTP2.Types
-import Network.Wai.Handler.Warp.HTTP2.Worker
+import Network.Wai.Handler.Warp.HTTP2.Response
 import Network.Wai.Handler.Warp.Imports
-import qualified Network.Wai.Handler.Warp.Settings as S (Settings)
+import qualified Network.Wai.Handler.Warp.Settings as S
 import Network.Wai.Handler.Warp.Types
 
 ----------------------------------------------------------------
 
-http2 :: Connection -> InternalInfo -> SockAddr -> Transport -> S.Settings -> (BufSize -> IO ByteString) -> Application -> IO ()
-http2 conn ii addr transport settings readN app = do
+http2
+    :: S.Settings
+    -> InternalInfo
+    -> Connection
+    -> Transport
+    -> Application
+    -> SockAddr
+    -> T.Handle
+    -> ByteString
+    -> IO ()
+http2 settings ii conn transport app peersa th bs = do
+    rawRecvN <- makeRecvN bs $ connRecv conn
+    writeBuffer <- readIORef $ connWriteBuffer conn
+    -- This thread becomes the sender in http2 library.
+    -- In the case of event source, one request comes and one
+    -- worker gets busy. But it is likely that the receiver does
+    -- not receive any data at all while the sender is sending
+    -- 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 (S.settingsSlowlorisSize settings) rawRecvN
+        sendBS x = connSendAll conn x >> T.tickle th
+        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
-    ok <- checkPreface
-    when ok $ do
-        ctx <- newContext
-        -- Workers, worker manager and timer manager
-        mgr <- start settings
-        let responder = response settings ctx mgr
-            action = worker ctx settings app responder
-        setAction mgr action
-        -- The number of workers is 3.
-        -- This was carefully chosen based on a lot of benchmarks.
-        -- If it is 1, we cannot avoid head-of-line blocking.
-        -- If it is large, huge memory is consumed and many
-        -- context switches happen.
-        replicateM_ 3 $ spawnAction mgr
-        -- Receiver
-        let mkreq = mkRequest ii settings addr
-        tid <- forkIO $ frameReceiver ctx ii mkreq readN
-        -- Sender
-        -- frameSender is the main thread because it ensures to send
-        -- a goway frame.
-        frameSender ctx conn settings mgr `E.finally` do
-            clearContext ctx
-            stop mgr
-            killThread tid
+    setConnHTTP2 conn True
+    H2.run H2.defaultServerConfig conf $
+        http2server "Warp HTTP/2" settings ii transport peersa app
   where
     checkTLS = case transport of
         TCP -> return () -- direct
-        tls -> unless (tls12orLater tls) $ goaway conn InadequateSecurity "Weak TLS"
+        tls -> unless (tls12orLater tls) $ goaway conn H2.InadequateSecurity "Weak TLS"
     tls12orLater tls = tlsMajorVersion tls == 3 && tlsMinorVersion tls >= 3
-    checkPreface = do
-        preface <- readN connectionPrefaceLength
-        if connectionPreface /= preface then do
-            goaway conn ProtocolError "Preface mismatch"
-            return False
-          else
-            return True
 
+-- | Converting WAI application to the server type of http2 library.
+--
+-- Since 3.3.11
+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 <- 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
+            | 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
+      where
+        !hdr = H2.requestHeaders h2req
+        !bdy = H2.getRequestBodyChunk h2req
+        !bdylen = H2.requestBodySize h2req
+        !th = H2.auxTimeHandle aux
+
+    logResponse = S.settingsLogger settings
+
+    logPushPromise req pp = logger req path siz
+      where
+        !logger = S.settingsServerPushLogger settings
+        !path = H2.promiseRequestPath pp
+        !siz = case H2.responseBodySize $ H2.promiseResponse pp of
+            Nothing -> 0
+            Just s -> fromIntegral s
+
+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 > 0 && BS.length bs >= slowlorisSize || bufsize <= slowlorisSize)
+        $ T.tickle th
+    return bs
+  where
+    handler :: E.SomeException -> IO ByteString
+    handler = throughAsync (return "")
+
 -- connClose must not be called here since Run:fork calls it
-goaway :: Connection -> ErrorCodeId -> ByteString -> IO ()
+goaway :: Connection -> H2.ErrorCodeId -> ByteString -> IO ()
 goaway Connection{..} etype debugmsg = connSendAll bytestream
   where
-    bytestream = goawayFrame 0 etype debugmsg
+    einfo = H2.encodeInfo id 0
+    frame = H2.GoAwayFrame 0 etype debugmsg
+    bytestream = H2.encodeFrame einfo frame
diff --git a/Network/Wai/Handler/Warp/HTTP2/EncodeFrame.hs b/Network/Wai/Handler/Warp/HTTP2/EncodeFrame.hs
deleted file mode 100644
--- a/Network/Wai/Handler/Warp/HTTP2/EncodeFrame.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-module Network.Wai.Handler.Warp.HTTP2.EncodeFrame where
-
-import Network.HTTP2
-
-import Network.Wai.Handler.Warp.Imports
-
-----------------------------------------------------------------
-
-goawayFrame :: StreamId -> ErrorCodeId -> ByteString -> ByteString
-goawayFrame sid etype debugmsg = encodeFrame einfo frame
-  where
-    einfo = encodeInfo id 0
-    frame = GoAwayFrame sid etype debugmsg
-
-resetFrame :: ErrorCodeId -> StreamId -> ByteString
-resetFrame etype sid = encodeFrame einfo frame
-  where
-    einfo = encodeInfo id sid
-    frame = RSTStreamFrame etype
-
-settingsFrame :: (FrameFlags -> FrameFlags) -> SettingsList -> ByteString
-settingsFrame func alist = encodeFrame einfo $ SettingsFrame alist
-  where
-    einfo = encodeInfo func 0
-
-pingFrame :: ByteString -> ByteString
-pingFrame bs = encodeFrame einfo $ PingFrame bs
-  where
-    einfo = encodeInfo setAck 0
-
-windowUpdateFrame :: StreamId -> WindowSize -> ByteString
-windowUpdateFrame sid winsiz = encodeFrame einfo $ WindowUpdateFrame winsiz
-  where
-    einfo = encodeInfo id sid
diff --git a/Network/Wai/Handler/Warp/HTTP2/File.hs b/Network/Wai/Handler/Warp/HTTP2/File.hs
--- a/Network/Wai/Handler/Warp/HTTP2/File.hs
+++ b/Network/Wai/Handler/Warp/HTTP2/File.hs
@@ -1,157 +1,33 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE BangPatterns #-}
 
-module Network.Wai.Handler.Warp.HTTP2.File (
-    RspFileInfo(..)
-  , conditionalRequest
-  , addContentHeadersForFilePart
-  , H.parseByteRanges
-  ) where
-
-import qualified Data.ByteString.Char8 as C8 (pack)
-import Network.HPACK
-import Network.HPACK.Token
-import Network.HTTP.Date
-import qualified Network.HTTP.Types as H
-import Network.Wai
-
-import qualified Network.Wai.Handler.Warp.FileInfoCache as I
-import Network.Wai.Handler.Warp.Imports
-import Network.Wai.Handler.Warp.PackInt
-
--- $setup
--- >>> import Test.QuickCheck
-
-----------------------------------------------------------------
-
-data RspFileInfo = WithoutBody !H.Status
-                 | WithBody !H.Status !TokenHeaderList !Integer !Integer
-                 deriving (Eq,Show)
-
-----------------------------------------------------------------
-
-conditionalRequest :: I.FileInfo
-                   -> TokenHeaderList -- Response
-                   -> ValueTable -- Request
-                   -> RspFileInfo
-conditionalRequest (I.FileInfo _ size mtime date) ths0 reqtbl = case condition of
-    nobody@(WithoutBody _) -> nobody
-    WithBody s _ off len   -> let !hs = (tokenLastModified,date) :
-                                        addContentHeaders ths0 off len size
-                              in WithBody s hs off len
-  where
-    !mcondition = ifmodified    reqtbl size mtime
-              <|> ifunmodified  reqtbl size mtime
-              <|> ifrange       reqtbl size mtime
-    !condition = fromMaybe (unconditional reqtbl size) mcondition
-
-----------------------------------------------------------------
-
-{-# INLINE ifModifiedSince #-}
-ifModifiedSince :: ValueTable -> Maybe HTTPDate
-ifModifiedSince reqtbl = getHeaderValue tokenIfModifiedSince reqtbl >>= parseHTTPDate
-
-{-# INLINE ifUnmodifiedSince #-}
-ifUnmodifiedSince :: ValueTable -> Maybe HTTPDate
-ifUnmodifiedSince reqtbl = getHeaderValue tokenIfUnmodifiedSince reqtbl >>= parseHTTPDate
-
-{-# INLINE ifRange #-}
-ifRange :: ValueTable -> Maybe HTTPDate
-ifRange reqtbl = getHeaderValue tokenIfRange reqtbl >>= parseHTTPDate
-
-----------------------------------------------------------------
-
-{-# INLINE ifmodified #-}
-ifmodified :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
-ifmodified reqtbl size mtime = do
-    date <- ifModifiedSince reqtbl
-    return $ if date /= mtime
-             then unconditional reqtbl size
-             else WithoutBody H.notModified304
-
-{-# INLINE ifunmodified #-}
-ifunmodified :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
-ifunmodified reqtbl size mtime = do
-    date <- ifUnmodifiedSince reqtbl
-    return $ if date == mtime
-             then unconditional reqtbl size
-             else WithoutBody H.preconditionFailed412
-
-{-# INLINE ifrange #-}
-ifrange :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
-ifrange reqtbl size mtime = do
-    date <- ifRange reqtbl
-    rng  <- getHeaderValue tokenRange reqtbl
-    return $ if date == mtime
-             then parseRange rng size
-             else WithBody H.ok200 [] 0 size
-
-{-# INLINE unconditional #-}
-unconditional :: ValueTable -> Integer -> RspFileInfo
-unconditional reqtbl size = case getHeaderValue tokenRange reqtbl of
-    Nothing  -> WithBody H.ok200 [] 0 size
-    Just rng -> parseRange rng size
-
-----------------------------------------------------------------
-
-{-# INLINE parseRange #-}
-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
-
-{-# INLINE checkRange #-}
-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)
+module Network.Wai.Handler.Warp.HTTP2.File where
 
-----------------------------------------------------------------
+import Network.HTTP2.Server
 
-{-# INLINE contentRangeHeader #-}
--- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'
--- for the range specified.
-contentRangeHeader :: Integer -> Integer -> Integer -> TokenHeader
-contentRangeHeader beg end total = (tokenContentRange, range)
-  where
-    range = C8.pack
-      -- building with ShowS
-      $ 'b' : 'y': 't' : 'e' : 's' : ' '
-      : (if beg > end then ('*':) else
-          showInt beg
-          . ('-' :)
-          . showInt end)
-      ( '/'
-      : showInt total "")
+import Network.Wai.Handler.Warp.Types
 
-{-# INLINE addContentHeaders #-}
-addContentHeaders :: TokenHeaderList -> Integer -> Integer -> Integer -> TokenHeaderList
-addContentHeaders ths off len size
-  | len == size = ths'
-  | otherwise   = let !ctrng = contentRangeHeader off (off + len - 1) size
-                  in ctrng:ths'
-  where
-    !lengthBS = packIntegral len
-    !ths' = (tokenContentLength, lengthBS) : (tokenAcceptRanges,"bytes") : ths
+#ifdef WINDOWS
+pReadMaker :: InternalInfo -> PositionReadMaker
+pReadMaker _ = defaultPositionReadMaker
+#else
+import Network.Wai.Handler.Warp.FdCache
+import Network.Wai.Handler.Warp.SendFile (positionRead)
 
-{-# INLINE addContentHeadersForFilePart #-}
--- |
+-- | 'PositionReadMaker' based on file descriptor cache.
 --
--- >>> addContentHeadersForFilePart [] (FilePart 2 10 16)
--- [(Token {ix = 20, shouldBeIndexed = True, isPseudo = False, tokenKey = "Content-Range"},"bytes 2-11/16"),(Token {ix = 18, shouldBeIndexed = False, isPseudo = False, tokenKey = "Content-Length"},"10"),(Token {ix = 8, shouldBeIndexed = True, isPseudo = False, tokenKey = "Accept-Ranges"},"bytes")]
--- >>> addContentHeadersForFilePart [] (FilePart 0 16 16)
--- [(Token {ix = 18, shouldBeIndexed = False, isPseudo = False, tokenKey = "Content-Length"},"16"),(Token {ix = 8, shouldBeIndexed = True, isPseudo = False, tokenKey = "Accept-Ranges"},"bytes")]
-addContentHeadersForFilePart :: TokenHeaderList -> FilePart -> TokenHeaderList
-addContentHeadersForFilePart hs part = addContentHeaders hs off len size
+-- Since 3.3.13
+pReadMaker :: InternalInfo -> PositionReadMaker
+pReadMaker ii path = do
+    (mfd, refresh) <- getFd ii path
+    case mfd of
+      Just fd -> return (pread fd, Refresher refresh)
+      Nothing -> do
+          fd <- openFile path
+          return (pread fd, Closer $ closeFile fd)
   where
-    off = filePartOffset part
-    len = filePartByteCount part
-    size = filePartFileSize part
+    pread :: Fd -> PositionRead
+    pread fd off bytes buf = fromIntegral <$> positionRead fd buf bytes' off'
+      where
+        bytes' = fromIntegral bytes
+        off' = fromIntegral off
+#endif
diff --git a/Network/Wai/Handler/Warp/HTTP2/HPACK.hs b/Network/Wai/Handler/Warp/HTTP2/HPACK.hs
deleted file mode 100644
--- a/Network/Wai/Handler/Warp/HTTP2/HPACK.hs
+++ /dev/null
@@ -1,130 +0,0 @@
-{-# LANGUAGE OverloadedStrings, BangPatterns #-}
-{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
-
-module Network.Wai.Handler.Warp.HTTP2.HPACK (
-    hpackEncodeHeader
-  , hpackEncodeHeaderLoop
-  , hpackDecodeHeader
-  , just
-  , fixHeaders
-  , addHeader -- testing
-  , deleteUnnecessaryHeaders
-  ) where
-
-import qualified Control.Exception as E
-import Network.HPACK hiding (Buffer)
-import Network.HPACK.Token
-import Network.HTTP2
-
-import Network.Wai.Handler.Warp.HTTP2.Types
-import Network.Wai.Handler.Warp.Imports
-import Network.Wai.Handler.Warp.PackInt
-import qualified Network.Wai.Handler.Warp.Settings as S
-import Network.Wai.Handler.Warp.Types
-
--- $setup
--- >>> :set -XOverloadedStrings
-
-----------------------------------------------------------------
-
-{-# INLINE addHeader #-}
-addHeader :: Token -> ByteString -> ValueTable -> TokenHeaderList -> TokenHeaderList
-addHeader t "" _ ths
-  | t == tokenServer  = filter ((/= tokenServer) . fst) ths
-addHeader t v tbl ths = case getHeaderValue t tbl of
-    Nothing -> (t,v) : ths
-    _       -> ths
-
-fixHeaders :: Context
-           -> Rspn
-           -> InternalInfo
-           -> S.Settings
-           -> IO TokenHeaderList
-fixHeaders Context{..} rspn ii settings = do
-    date <- getDate ii
-    let !s = rspnStatus rspn
-        !status = packStatus s
-        !defServer = S.settingsServerName settings
-        (!ths0,tbl) = rspnHeaders rspn
-        !ths1 = addHeader tokenServer defServer tbl ths0
-        !ths2 = addHeader tokenDate date tbl ths1
-        !ths3 = (tokenStatus, status) : ths2
-        !ths4 = deleteUnnecessaryHeaders ths3 tbl
-    return ths4
-
-deleteUnnecessaryHeaders :: TokenHeaderList -> ValueTable -> TokenHeaderList
-deleteUnnecessaryHeaders htl0 tbl0 = loop headersToBeRemoved htl0
-  where
-    loop [] thl = thl
-    loop (t:ts) thl = case getHeaderValue t tbl0 of
-      Nothing -> thl
-      _       -> let !thl' = filter ((/= t) . fst) thl
-                 in loop ts thl'
-
-headersToBeRemoved :: [Token]
-headersToBeRemoved = [ tokenConnection
-                     , tokenTransferEncoding
-                     -- Keep-Alive:
-                     -- Proxy-Connection:
-                     -- Upgrade:
-                     ]
-
-----------------------------------------------------------------
-
-strategy :: EncodeStrategy
-strategy = EncodeStrategy { compressionAlgo = Linear, useHuffman = False }
-
--- Set-Cookie: contains only one cookie value.
--- So, we don't need to split it.
-hpackEncodeHeader :: Context -> Buffer -> BufSize
-                  -> TokenHeaderList
-                  -> IO (TokenHeaderList, Int)
-hpackEncodeHeader Context{..} buf siz ths =
-    encodeTokenHeader buf siz strategy True encodeDynamicTable ths
-
-hpackEncodeHeaderLoop :: Context -> Buffer -> BufSize
-                      -> TokenHeaderList
-                      -> IO (TokenHeaderList, Int)
-hpackEncodeHeaderLoop Context{..} buf siz hs =
-    encodeTokenHeader buf siz strategy False encodeDynamicTable hs
-
-----------------------------------------------------------------
-
-hpackDecodeHeader :: HeaderBlockFragment -> Context -> IO (TokenHeaderList, ValueTable)
-hpackDecodeHeader hdrblk Context{..} = do
-    tbl@(_,vt) <- decodeTokenHeader decodeDynamicTable hdrblk `E.catch` handl
-    unless (checkRequestHeader vt) $
-        E.throwIO $ ConnectionError ProtocolError "the header key is illegal"
-    return tbl
-  where
-    handl IllegalHeaderName =
-        E.throwIO $ ConnectionError ProtocolError "the header key is illegal"
-    handl _ =
-        E.throwIO $ ConnectionError CompressionError "cannot decompress the header"
-
-{-# INLINE checkRequestHeader #-}
-checkRequestHeader :: ValueTable -> Bool
-checkRequestHeader reqvt
-  | just mMethod (== "CONNECT") = isNothing mPath && isNothing mScheme
-  | isJust mStatus              = False
-  | isNothing mMethod           = False
-  | isNothing mScheme           = False
-  | isNothing mPath             = False
-  | mPath       == Just ""      = False
-  | isJust mConnection          = False
-  | just mTE (/= "trailers")    = False
-  | otherwise                   = True
-  where
-    mStatus     = getHeaderValue tokenStatus reqvt
-    mScheme     = getHeaderValue tokenScheme reqvt
-    mPath       = getHeaderValue tokenPath reqvt
-    mMethod     = getHeaderValue tokenMethod reqvt
-    mConnection = getHeaderValue tokenConnection reqvt
-    mTE         = getHeaderValue tokenTE reqvt
-
-{-# INLINE just #-}
-just :: Maybe a -> (a -> Bool) -> Bool
-just Nothing  _    = False
-just (Just x) p
-  | p x            = True
-  | otherwise      = False
diff --git a/Network/Wai/Handler/Warp/HTTP2/Manager.hs b/Network/Wai/Handler/Warp/HTTP2/Manager.hs
deleted file mode 100644
--- a/Network/Wai/Handler/Warp/HTTP2/Manager.hs
+++ /dev/null
@@ -1,95 +0,0 @@
-{-# LANGUAGE CPP, BangPatterns #-}
-
--- | A thread pool manager.
---   The manager has responsibility to spawn and kill
---   worker threads.
-module Network.Wai.Handler.Warp.HTTP2.Manager (
-    Manager
-  , start
-  , setAction
-  , stop
-  , spawnAction
-  , addMyId
-  , deleteMyId
-  ) where
-
-import Control.Concurrent
-import Control.Concurrent.STM
-import Data.Foldable
-import Data.IORef
-import Data.Set (Set)
-import qualified Data.Set as Set
-import qualified System.TimeManager as T
-
-import Network.Wai.Handler.Warp.Imports
-import Network.Wai.Handler.Warp.Settings
-
-----------------------------------------------------------------
-
-type Action = T.Manager -> IO ()
-
-data Command = Stop | Spawn | Add ThreadId | Delete ThreadId
-
-data Manager = Manager (TQueue Command) (IORef Action)
-
--- | Starting a thread pool manager.
---   Its action is initially set to 'return ()' and should be set
---   by 'setAction'. This allows that the action can include
---   the manager itself.
-start :: Settings -> IO Manager
-start set = do
-    q <- newTQueueIO
-    ref <- newIORef (\_ -> return ())
-    timmgr <- T.initialize $ settingsTimeout set * 1000000
-    void $ forkIO $ go q Set.empty ref timmgr
-    return $ Manager q ref
-  where
-    go q !tset0 ref timmgr = do
-        x <- atomically $ readTQueue q
-        case x of
-            Stop          -> kill tset0 >> T.killManager timmgr
-            Spawn         -> next tset0
-            Add    newtid -> let !tset = add newtid tset0
-                             in go q tset ref timmgr
-            Delete oldtid -> let !tset = del oldtid tset0
-                             in go q tset ref timmgr
-      where
-        next tset = do
-            action <- readIORef ref
-            newtid <- forkIO (action timmgr)
-            let !tset' = add newtid tset
-            go q tset' ref timmgr
-
-setAction :: Manager -> Action -> IO ()
-setAction (Manager _ ref) action = writeIORef ref action
-
-stop :: Manager -> IO ()
-stop (Manager q _) = atomically $ writeTQueue q Stop
-
-spawnAction :: Manager -> IO ()
-spawnAction (Manager q _) = atomically $ writeTQueue q Spawn
-
-addMyId :: Manager -> IO ()
-addMyId (Manager q _) = do
-    tid <- myThreadId
-    atomically $ writeTQueue q $ Add tid
-
-deleteMyId :: Manager -> IO ()
-deleteMyId (Manager q _) = do
-    tid <- myThreadId
-    atomically $ writeTQueue q $ Delete tid
-
-----------------------------------------------------------------
-
-add :: ThreadId -> Set ThreadId -> Set ThreadId
-add tid set = set'
-  where
-    !set' = Set.insert tid set
-
-del :: ThreadId -> Set ThreadId -> Set ThreadId
-del tid set = set'
-  where
-    !set' = Set.delete tid set
-
-kill :: Set ThreadId -> IO ()
-kill set = traverse_ killThread set
diff --git a/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs b/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Network.Wai.Handler.Warp.HTTP2.PushPromise where
+
+import qualified Control.Exception as E
+import qualified Network.HTTP.Types as H
+import qualified Network.HTTP2.Server as H2
+
+import Network.Wai
+import Network.Wai.Handler.Warp.FileInfoCache
+import Network.Wai.Handler.Warp.HTTP2.Request (getHTTP2Data)
+import Network.Wai.Handler.Warp.HTTP2.Types
+import Network.Wai.Handler.Warp.Imports
+import Network.Wai.Handler.Warp.Types
+
+fromPushPromises :: InternalInfo -> Request -> IO [H2.PushPromise]
+fromPushPromises ii req = do
+    mh2data <- getHTTP2Data req
+    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 <- E.try $ getFileInfo ii file
+    case efinfo of
+        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/Receiver.hs b/Network/Wai/Handler/Warp/HTTP2/Receiver.hs
deleted file mode 100644
--- a/Network/Wai/Handler/Warp/HTTP2/Receiver.hs
+++ /dev/null
@@ -1,418 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE PatternGuards #-}
-
-module Network.Wai.Handler.Warp.HTTP2.Receiver (frameReceiver) where
-
-import Control.Concurrent
-import Control.Concurrent.STM
-import qualified Control.Exception as E
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as C8
-import Data.IORef
-import Network.HPACK
-import Network.HPACK.Token
-import Network.HTTP2
-import Network.HTTP2.Priority (toPrecedence, delete, prepare)
-
-import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
-import Network.Wai.Handler.Warp.HTTP2.HPACK
-import Network.Wai.Handler.Warp.HTTP2.Request
-import Network.Wai.Handler.Warp.HTTP2.Types
-import Network.Wai.Handler.Warp.Imports hiding (delete, insert, readInt)
-import Network.Wai.Handler.Warp.ReadInt
-import Network.Wai.Handler.Warp.Types
-
-----------------------------------------------------------------
-
-frameReceiver :: Context -> InternalInfo -> MkReq -> (BufSize -> IO ByteString) -> IO ()
-frameReceiver ctx ii mkreq recvN = loop 0 `E.catch` sendGoaway
-  where
-    Context{ http2settings
-           , streamTable
-           , concurrency
-           , continued
-           , clientStreamId
-           , inputQ
-           , controlQ
-           } = ctx
-    sendGoaway e
-      | Just (ConnectionError err msg) <- E.fromException e = do
-          csid <- readIORef clientStreamId
-          let !frame = goawayFrame csid err msg
-          enqueueControl controlQ $ CGoaway frame
-      | otherwise = return ()
-
-    sendReset err sid = do
-        let !frame = resetFrame err sid
-        enqueueControl controlQ $ CFrame frame
-
-    loop :: Int -> IO ()
-    loop !n
-      | n == 6 = do
-          yield
-          loop 0
-      | otherwise = do
-        hd <- recvN frameHeaderLength
-        if BS.null hd then
-            enqueueControl controlQ CFinish
-          else do
-            cont <- processStreamGuardingError $ decodeFrameHeader hd
-            when cont $ loop (n + 1)
-
-    processStreamGuardingError (fid, FrameHeader{streamId})
-      | isResponse streamId &&
-        (fid `notElem` [FramePriority,FrameRSTStream,FrameWindowUpdate]) =
-        E.throwIO $ ConnectionError ProtocolError "stream id should be odd"
-    processStreamGuardingError (FrameUnknown _, FrameHeader{payloadLength}) = do
-        mx <- readIORef continued
-        case mx of
-            Nothing -> do
-                -- ignoring unknown frame
-                consume payloadLength
-                return True
-            Just _  -> E.throwIO $ ConnectionError ProtocolError "unknown frame"
-    processStreamGuardingError (FramePushPromise, _) =
-        E.throwIO $ ConnectionError ProtocolError "push promise is not allowed"
-    processStreamGuardingError typhdr@(ftyp, header@FrameHeader{payloadLength}) = do
-        settings <- readIORef http2settings
-        case checkFrameHeader settings typhdr of
-            Left h2err -> case h2err of
-                StreamError err sid -> do
-                    sendReset err sid
-                    consume payloadLength
-                    return True
-                connErr -> E.throwIO connErr
-            Right _ -> do
-                ex <- E.try $ controlOrStream ftyp header
-                case ex of
-                    Left (StreamError err sid) -> do
-                        sendReset err sid
-                        return True
-                    Left connErr -> E.throw connErr
-                    Right cont -> return cont
-
-    controlOrStream ftyp header@FrameHeader{streamId, payloadLength}
-      | isControl streamId = do
-          pl <- recvN payloadLength
-          control ftyp header pl ctx
-      | otherwise = do
-          checkContinued
-          !mstrm <- getStream
-          pl <- recvN payloadLength
-          case mstrm of
-            Nothing -> do
-                -- for h2spec only
-                when (ftyp == FramePriority) $ do
-                    PriorityFrame newpri <- guardIt $ decodePriorityFrame header pl
-                    checkPriority newpri streamId
-                return True -- just ignore this frame
-            Just strm@Stream{streamPrecedence} -> do
-              state <- readStreamState strm
-              state' <- stream ftyp header pl ctx state strm
-              case state' of
-                  Open (NoBody tbl@(_,reqvt) pri) -> do
-                      resetContinued
-                      let mcl = readInt <$> getHeaderValue tokenContentLength reqvt
-                      when (just mcl (/= (0 :: Int))) $
-                          E.throwIO $ StreamError ProtocolError streamId
-                      writeIORef streamPrecedence $ toPrecedence pri
-                      halfClosedRemote ctx strm
-                      !req <- mkreq tbl (Just 0, return "")
-                      atomically $ writeTQueue inputQ $ Input strm req reqvt ii
-                  Open (HasBody tbl@(_,reqvt) pri) -> do
-                      resetContinued
-                      q <- newTQueueIO
-                      let !mcl = readInt <$> getHeaderValue tokenContentLength reqvt
-                      writeIORef streamPrecedence $ toPrecedence pri
-                      bodyLength <- newIORef 0
-                      setStreamState ctx strm $ Open (Body q mcl bodyLength)
-                      readQ <- newReadBody q
-                      bodySource <- mkSource readQ
-                      !req <- mkreq tbl (mcl, readSource bodySource)
-                      atomically $ writeTQueue inputQ $ Input strm req reqvt ii
-                  s@(Open Continued{}) -> do
-                      setContinued
-                      setStreamState ctx strm s
-                  HalfClosedRemote -> do
-                      resetContinued
-                      halfClosedRemote ctx strm
-                  s -> do -- Idle, Open Body, Closed
-                      resetContinued
-                      setStreamState ctx strm s
-              return True
-       where
-         setContinued = writeIORef continued (Just streamId)
-         resetContinued = writeIORef continued Nothing
-         checkContinued = do
-             mx <- readIORef continued
-             case mx of
-                 Nothing  -> return ()
-                 Just sid
-                   | sid == streamId && ftyp == FrameContinuation -> return ()
-                   | otherwise -> E.throwIO $ ConnectionError ProtocolError "continuation frame must follow"
-         getStream = do
-             mstrm0 <- search streamTable streamId
-             case mstrm0 of
-                 js@(Just strm0) -> do
-                     when (ftyp == FrameHeaders) $ do
-                         st <- readStreamState strm0
-                         when (isHalfClosedRemote st) $ E.throwIO $ ConnectionError StreamClosed "header must not be sent to half or fully closed stream"
-                         -- Priority made an idele stream
-                         when (isIdle st) $ opened ctx strm0
-                     return js
-                 Nothing
-                   | isResponse streamId -> return Nothing
-                   | otherwise           -> do
-                         csid <- readIORef clientStreamId
-                         if streamId <= csid then -- consider the stream closed
-                             if ftyp `elem` [FrameWindowUpdate, FrameRSTStream, FramePriority] then
-                                 return Nothing -- will be ignored
-                               else
-                                 E.throwIO $ ConnectionError ProtocolError "stream identifier must not decrease"
-                           else do -- consider the stream idle
-                             when (ftyp `notElem` [FrameHeaders,FramePriority]) $
-                                 E.throwIO $ ConnectionError ProtocolError $ "this frame is not allowed in an idle stream: " `BS.append` C8.pack (show ftyp)
-                             when (ftyp == FrameHeaders) $ do
-                                 writeIORef clientStreamId streamId
-                                 cnt <- readIORef concurrency
-                                 -- Checking the limitation of concurrency
-                                 when (cnt >= maxConcurrency) $
-                                     E.throwIO $ StreamError RefusedStream streamId
-                             ws <- initialWindowSize <$> readIORef http2settings
-                             newstrm <- newStream streamId (fromIntegral ws)
-                             when (ftyp == FrameHeaders) $ opened ctx newstrm
-                             insert streamTable streamId newstrm
-                             return $ Just newstrm
-
-    consume = void . recvN
-
-maxConcurrency :: Int
-maxConcurrency = recommendedConcurrency
-
-initialFrame :: ByteString
-initialFrame = settingsFrame id [(SettingsMaxConcurrentStreams,maxConcurrency)]
-
-----------------------------------------------------------------
-
-control :: FrameTypeId -> FrameHeader -> ByteString -> Context -> IO Bool
-control FrameSettings header@FrameHeader{flags} bs Context{http2settings, controlQ, firstSettings, streamTable} = do
-    SettingsFrame alist <- guardIt $ decodeSettingsFrame header bs
-    case checkSettingsList alist of
-        Just x  -> E.throwIO x
-        Nothing -> return ()
-    -- HTTP/2 Setting from a browser
-    unless (testAck flags) $ do
-        oldws <- initialWindowSize <$> readIORef http2settings
-        modifyIORef' http2settings $ \old -> updateSettings old alist
-        newws <- initialWindowSize <$> readIORef http2settings
-        let diff = newws - oldws
-        when (diff /= 0) $ updateAllStreamWindow (+ diff) streamTable
-        let !frame = settingsFrame setAck []
-        sent <- readIORef firstSettings
-        let !setframe
-              | sent      = CSettings               frame alist
-              | otherwise = CSettings0 initialFrame frame alist
-        unless sent $ writeIORef firstSettings True
-        enqueueControl controlQ setframe
-    return True
-
-control FramePing FrameHeader{flags} bs Context{controlQ} =
-    if testAck flags then
-        return True -- just ignore
-      else do
-        let !frame = pingFrame bs
-        enqueueControl controlQ $ CFrame frame
-        return True
-
-control FrameGoAway _ _ Context{controlQ} = do
-    enqueueControl controlQ CFinish
-    return False
-
-control FrameWindowUpdate header bs Context{connectionWindow} = do
-    WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs
-    !w <- atomically $ do
-      w0 <- readTVar connectionWindow
-      let !w1 = w0 + n
-      writeTVar connectionWindow w1
-      return w1
-    when (isWindowOverflow w) $ E.throwIO $ ConnectionError FlowControlError "control window should be less than 2^31"
-    return True
-
-control _ _ _ _ =
-    -- must not reach here
-    return False
-
-----------------------------------------------------------------
-
-{-# INLINE guardIt #-}
-guardIt :: Either HTTP2Error a -> IO a
-guardIt x = case x of
-    Left err    -> E.throwIO err
-    Right frame -> return frame
-
-
-{-# INLINE checkPriority #-}
-checkPriority :: Priority -> StreamId -> IO ()
-checkPriority p me
-  | dep == me = E.throwIO $ StreamError ProtocolError me
-  | otherwise = return ()
-  where
-    dep = streamDependency p
-
-stream :: FrameTypeId -> FrameHeader -> ByteString -> Context -> StreamState -> Stream -> IO StreamState
-stream FrameHeaders header@FrameHeader{flags} bs ctx (Open JustOpened) Stream{streamNumber} = do
-    HeadersFrame mp frag <- guardIt $ decodeHeadersFrame header bs
-    pri <- case mp of
-        Nothing -> return defaultPriority
-        Just p  -> do
-            checkPriority p streamNumber
-            return p
-    let !endOfStream = testEndStream flags
-        !endOfHeader = testEndHeader flags
-    if endOfHeader then do
-        tbl <- hpackDecodeHeader frag ctx -- fixme
-        return $ if endOfStream then
-                    Open (NoBody tbl pri)
-                   else
-                    Open (HasBody tbl pri)
-      else do
-        let !siz = BS.length frag
-        return $ Open $ Continued [frag] siz 1 endOfStream pri
-
-stream FrameHeaders header@FrameHeader{flags} bs _ (Open (Body q _ _)) _ = do
-    -- trailer is not supported.
-    -- let's read and ignore it.
-    HeadersFrame _ _ <- guardIt $ decodeHeadersFrame header bs
-    let !endOfStream = testEndStream flags
-    if endOfStream then do
-        atomically $ writeTQueue q ""
-        return HalfClosedRemote
-      else
-        -- we don't support continuation here.
-        E.throwIO $ ConnectionError ProtocolError "continuation in trailer is not supported"
-
--- ignore data-frame except for flow-control when we're done locally
-stream FrameData
-       FrameHeader{flags,payloadLength}
-       _bs
-       Context{controlQ} s@(HalfClosedLocal _)
-       Stream{streamNumber} = do
-    let !endOfStream = testEndStream flags
-    when (payloadLength /= 0) $ do
-        let !frame1 = windowUpdateFrame 0 payloadLength
-            !frame2 = windowUpdateFrame streamNumber payloadLength
-            !frame = frame1 `BS.append` frame2
-        enqueueControl controlQ $ CFrame frame
-    if endOfStream then do
-        return HalfClosedRemote
-      else
-        return s
-
-stream FrameData
-       header@FrameHeader{flags,payloadLength,streamId}
-       bs
-       Context{controlQ} s@(Open (Body q mcl bodyLength))
-       Stream{streamNumber} = do
-    DataFrame body <- guardIt $ decodeDataFrame header bs
-    let !endOfStream = testEndStream flags
-    len0 <- readIORef bodyLength
-    let !len = len0 + payloadLength
-    writeIORef bodyLength len
-    when (payloadLength /= 0) $ do
-        let !frame1 = windowUpdateFrame 0 payloadLength
-            !frame2 = windowUpdateFrame streamNumber payloadLength
-            !frame = frame1 `BS.append` frame2
-        enqueueControl controlQ $ CFrame frame
-    atomically $ writeTQueue q body
-    if endOfStream then do
-        case mcl of
-            Nothing -> return ()
-            Just cl -> when (cl /= len) $ E.throwIO $ StreamError ProtocolError streamId
-        atomically $ writeTQueue q ""
-        return HalfClosedRemote
-      else
-        return s
-
-stream FrameContinuation FrameHeader{flags} frag ctx (Open (Continued rfrags siz n endOfStream pri)) _ = do
-    let !endOfHeader = testEndHeader flags
-        !rfrags' = frag : rfrags
-        !siz' = siz + BS.length frag
-        !n' = n + 1
-    when (siz' > 51200) $ -- fixme: hard coding: 50K
-      E.throwIO $ ConnectionError EnhanceYourCalm "Header is too big"
-    when (n' > 10) $ -- fixme: hard coding
-      E.throwIO $ ConnectionError EnhanceYourCalm "Header is too fragmented"
-    if endOfHeader then do
-        let !hdrblk = BS.concat $ reverse rfrags'
-        tbl <- hpackDecodeHeader hdrblk ctx
-        return $ if endOfStream then
-                    Open (NoBody tbl pri)
-                   else
-                    Open (HasBody tbl pri)
-      else
-        return $ Open $ Continued rfrags' siz' n' endOfStream pri
-
-stream FrameWindowUpdate header@FrameHeader{streamId} bs _ s Stream{streamWindow} = do
-    WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs
-    !w <- atomically $ do
-      w0 <- readTVar streamWindow
-      let !w1 = w0 + n
-      writeTVar streamWindow w1
-      return w1
-    when (isWindowOverflow w) $
-        E.throwIO $ StreamError FlowControlError streamId
-    return s
-
-stream FrameRSTStream header bs ctx _ strm = do
-    RSTStreamFrame e <- guardIt $ decoderstStreamFrame header bs
-    let !cc = Reset e
-    closed ctx strm cc
-    return $ Closed cc -- will be written to streamState again
-
-stream FramePriority header bs Context{outputQ,priorityTreeSize} s Stream{streamNumber,streamPrecedence} = do
-    PriorityFrame newpri <- guardIt $ decodePriorityFrame header bs
-    checkPriority newpri streamNumber
-    oldpre <- readIORef streamPrecedence
-    let !newpre = toPrecedence newpri
-    writeIORef streamPrecedence newpre
-    if isIdle s then do
-        n <- atomicModifyIORef' priorityTreeSize (\x -> (x+1,x+1))
-        -- fixme hard coding
-        when (n >= 20) $ E.throwIO $ ConnectionError EnhanceYourCalm "too many idle priority frames"
-        prepare outputQ streamNumber newpri
-      else do
-        mx <- delete outputQ streamNumber oldpre
-        case mx of
-            Nothing  -> return ()
-            Just out -> enqueueOutput outputQ out
-    return s
-
--- this ordering is important
-stream FrameContinuation _ _ _ _ _ = E.throwIO $ ConnectionError ProtocolError "continue frame cannot come here"
-stream _ _ _ _ (Open Continued{}) _ = E.throwIO $ ConnectionError ProtocolError "an illegal frame follows header/continuation frames"
--- Ignore frames to streams we have just reset, per section 5.1.
-stream _ _ _ _ st@(Closed (ResetByMe _)) _ = return st
-stream FrameData FrameHeader{streamId} _ _ _ _ = E.throwIO $ StreamError StreamClosed streamId
-stream _ FrameHeader{streamId} _ _ _ _ = E.throwIO $ StreamError ProtocolError streamId
-
-----------------------------------------------------------------
-
-{-# INLINE newReadBody #-}
-newReadBody :: TQueue ByteString -> IO (IO ByteString)
-newReadBody q = do
-    ref <- newIORef False
-    return $ readBody q ref
-
-{-# INLINE readBody #-}
-readBody :: TQueue ByteString -> IORef Bool -> IO ByteString
-readBody q ref = do
-    eof <- readIORef ref
-    if eof then
-        return ""
-      else do
-        bs <- atomically $ readTQueue q
-        when (bs == "") $ writeIORef ref True
-        return bs
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
@@ -1,13 +1,12 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 
 module Network.Wai.Handler.Warp.HTTP2.Request (
-    mkRequest
-  , MkReq
-  , getHTTP2Data
-  , setHTTP2Data
-  , modifyHTTP2Data
-  ) where
+    toRequest,
+    getHTTP2Data,
+    setHTTP2Data,
+    modifyHTTP2Data,
+) where
 
 import Control.Arrow (first)
 import qualified Data.ByteString.Char8 as C8
@@ -18,52 +17,74 @@
 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
 
 import Network.Wai.Handler.Warp.HTTP2.Types
 import Network.Wai.Handler.Warp.Imports
-import Network.Wai.Handler.Warp.Request (getFileInfoKey)
-import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath)
+import Network.Wai.Handler.Warp.Request (getFileInfoKey, pauseTimeoutKey)
+#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 Network.Wai.Handler.Warp.Types
 
-type MkReq = (TokenHeaderList,ValueTable) -> (Maybe Int,IO ByteString) -> IO (Request)
+type ToReq =
+    (TokenHeaderList, ValueTable)
+    -> Maybe Int
+    -> IO ByteString
+    -> T.Handle
+    -> Transport
+    -> IO Request
 
-mkRequest :: InternalInfo -> S.Settings -> SockAddr -> MkReq
-mkRequest ii1 settings addr (reqths,reqvt) (bodylen,body) = do
+----------------------------------------------------------------
+
+http30 :: H.HttpVersion
+http30 = H.HttpVersion 3 0
+
+toRequest :: InternalInfo -> S.Settings -> SockAddr -> ToReq
+toRequest ii settings addr ht bodylen body th transport = do
     ref <- newIORef Nothing
-    mkRequest' ii1 settings addr ref (reqths,reqvt) (bodylen,body)
+    toRequest' ii settings addr ref ht bodylen body th transport
 
-mkRequest' :: InternalInfo -> S.Settings -> SockAddr
-           -> IORef (Maybe HTTP2Data)
-           -> MkReq
-mkRequest' ii settings addr ref (reqths,reqvt) (bodylen,body) = 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 = http2ver
-      , rawPathInfo = rawPath
-      , pathInfo = H.decodePathSegments path
-      , rawQueryString = query
-      , queryString = H.parseQuery query
-      , requestHeaders = headers
-      , isSecure = True
-      , 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
@@ -73,14 +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
-    !vaultValue = Vault.insert getFileInfoKey (getFileInfo ii)
-                $ Vault.insert getHTTP2DataKey (readIORef ref)
-                $ Vault.insert setHTTP2DataKey (writeIORef ref)
-                $ Vault.insert modifyHTTP2DataKey (modifyIORef' ref)
-                  Vault.empty
+    -- 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)
+#ifdef MIN_VERSION_crypton_x509
+            . Vault.insert getClientCertificateKey (getTransportClientCertificate transport)
+#endif
+            $ Vault.empty
 
 getHTTP2DataKey :: Vault.Key (IO (Maybe HTTP2Data))
 getHTTP2DataKey = unsafePerformIO Vault.newKey
@@ -92,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
@@ -105,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
@@ -118,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
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Handler/Warp/HTTP2/Response.hs
@@ -0,0 +1,152 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Network.Wai.Handler.Warp.HTTP2.Response (
+    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 (responseBuilder, responseFile, responseStream)
+import Network.Wai.Internal (Response (..))
+
+import Network.Wai.Handler.Warp.File
+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 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"
+    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)
+  where
+    !method = requestMethod req
+    !reqhdr = requestHeaders req
+    !server = S.settingsServerName settings
+    add date rsphdr =
+        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
+
+----------------------------------------------------------------
+
+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
+responseFile st rsphdr method path (Just fp) _ _ =
+    return $ responseFile2XX st rsphdr method fileSpec
+  where
+    !off' = fromIntegral $ filePartOffset fp
+    !bytes' = fromIntegral $ filePartByteCount fp
+    !fileSpec = H2.FileSpec path off' bytes'
+responseFile _ rsphdr method path Nothing ii reqhdr = do
+    efinfo <- E.try $ getFileInfo ii path
+    case efinfo of
+        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
+                WithBody s rsphdr' off bytes -> do
+                    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 st rsphdr method fileSpec
+    | 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 st rsphdr method builder
+    | 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 st rsphdr method strmbdy
+    | method == H.methodHead || noBody st = responseNoBody st rsphdr
+    | otherwise = (H2.responseStreaming st rsphdr strmbdy, st, True)
+
+----------------------------------------------------------------
+
+responseNoBody :: H.Status -> H.ResponseHeaders -> (H2.Response, H.Status, Bool)
+responseNoBody st rsphdr = (H2.responseNoBody st rsphdr, st, False)
+
+----------------------------------------------------------------
+
+response404 :: H.ResponseHeaders -> (H2.Response, H.Status, Bool)
+response404 rsphdr = (h2rsp, st, True)
+  where
+    h2rsp = H2.responseBuilder st rsphdr' body
+    st = H.notFound404
+    !rsphdr' = R.replaceHeader H.hContentType "text/plain; charset=utf-8" rsphdr
+    !body = BB.byteString "File not found"
+
+----------------------------------------------------------------
+
+noBody :: H.Status -> Bool
+noBody = not . R.hasBody
diff --git a/Network/Wai/Handler/Warp/HTTP2/Sender.hs b/Network/Wai/Handler/Warp/HTTP2/Sender.hs
deleted file mode 100644
--- a/Network/Wai/Handler/Warp/HTTP2/Sender.hs
+++ /dev/null
@@ -1,536 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE BangPatterns, CPP #-}
-{-# LANGUAGE NamedFieldPuns #-}
-
-module Network.Wai.Handler.Warp.HTTP2.Sender (frameSender) where
-
-import Control.Concurrent.STM
-import qualified Control.Exception as E
-import qualified Data.ByteString as BS
-import Data.ByteString.Builder (Builder)
-import qualified Data.ByteString.Builder.Extra as B
-import Data.IORef
-import Foreign.Ptr (Ptr, plusPtr)
-import Foreign.Storable (poke)
-import Network.HPACK (setLimitForEncoding, toHeaderTable)
-import Network.HTTP2
-import Network.HTTP2.Priority (isEmptySTM, dequeueSTM, Precedence)
-import Network.Wai
-
-#ifdef WINDOWS
-import qualified System.IO as IO
-#else
-import Network.Wai.Handler.Warp.FdCache
-import Network.Wai.Handler.Warp.SendFile (positionRead)
-import qualified System.TimeManager as T
-#endif
-
-import Network.Wai.Handler.Warp.Buffer
-import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
-import Network.Wai.Handler.Warp.HTTP2.HPACK
-import Network.Wai.Handler.Warp.HTTP2.Manager (Manager)
-import Network.Wai.Handler.Warp.HTTP2.Types
-import Network.Wai.Handler.Warp.Imports hiding (readInt)
-import qualified Network.Wai.Handler.Warp.Settings as S
-import Network.Wai.Handler.Warp.Types
-
-----------------------------------------------------------------
-
-data Leftover = LZero
-              | LOne B.BufferWriter
-              | LTwo ByteString B.BufferWriter
-
-----------------------------------------------------------------
-
-{-# INLINE getStreamWindowSize #-}
-getStreamWindowSize :: Stream -> IO WindowSize
-getStreamWindowSize Stream{streamWindow} = atomically $ readTVar streamWindow
-
-{-# INLINE waitStreamWindowSize #-}
-waitStreamWindowSize :: Stream -> IO ()
-waitStreamWindowSize Stream{streamWindow} = atomically $ do
-    w <- readTVar streamWindow
-    check (w > 0)
-
-{-# INLINE waitStreaming #-}
-waitStreaming :: TBQueue a -> IO ()
-waitStreaming tbq = atomically $ do
-    isEmpty <- isEmptyTBQueue tbq
-    check (not isEmpty)
-
-data Switch = C Control
-            | O (StreamId,Precedence,Output)
-            | Flush
-
-frameSender :: Context -> Connection -> S.Settings -> Manager -> IO ()
-frameSender ctx@Context{outputQ,controlQ,connectionWindow,encodeDynamicTable}
-            conn@Connection{connWriteBuffer,connBufferSize,connSendAll}
-            settings mgr = loop 0 `E.catch` ignore
-  where
-    dequeue off = do
-        isEmpty <- isEmptyTQueue controlQ
-        if isEmpty then do
-            w <- readTVar connectionWindow
-            check (w > 0)
-            emp <- isEmptySTM outputQ
-            if emp then
-                if off /= 0 then return Flush else retry
-               else
-                O <$> dequeueSTM outputQ
-          else
-            C <$> readTQueue controlQ
-
-    loop off = do
-        x <- atomically $ dequeue off
-        case x of
-            C ctl -> do
-                when (off /= 0) $ flushN off
-                off' <- control ctl off
-                when (off' >= 0) $ loop off'
-            O (_,pre,out) -> do
-                let strm = outputStream out
-                writeIORef (streamPrecedence strm) pre
-                off' <- outputOrEnqueueAgain out off
-                case off' of
-                    0                -> loop 0
-                    _ | off' > 15872 -> flushN off' >> loop 0 -- fixme: hard-coding
-                      | otherwise    -> loop off'
-            Flush -> flushN off >> loop 0
-
-    control CFinish         _ = return (-1)
-    control (CGoaway frame) _ = connSendAll frame >> return (-1)
-    control (CFrame frame)  _ = connSendAll frame >> return 0
-    control (CSettings frame alist) _ = do
-        connSendAll frame
-        setLimit alist
-        return 0
-    control (CSettings0 frame1 frame2 alist) off = do -- off == 0, just in case
-        let !buf = connWriteBuffer `plusPtr` off
-            !off' = off + BS.length frame1 + BS.length frame2
-        buf' <- copy buf frame1
-        void $ copy buf' frame2
-        setLimit alist
-        return off'
-
-    {-# INLINE setLimit #-}
-    setLimit alist = case lookup SettingsHeaderTableSize alist of
-        Nothing  -> return ()
-        Just siz -> setLimitForEncoding siz encodeDynamicTable
-
-    output out@(Output strm _ _ tell getH2D (ONext curr)) off0 lim = do
-        -- Data frame payload
-        let !buf = connWriteBuffer `plusPtr` off0
-            !siz = connBufferSize - off0
-        Next datPayloadLen mnext <- curr buf siz lim
-        off <- fillDataHeader strm off0 datPayloadLen mnext tell getH2D
-        maybeEnqueueNext out mnext
-        return off
-
-    output out@(Output strm rspn ii tell getH2D ORspn) off0 lim = do
-        -- Header frame and Continuation frame
-        let !sid = streamNumber strm
-            !endOfStream = case rspn of
-                RspnNobody _ _ -> True
-                _              -> False
-        ths <- fixHeaders ctx rspn ii settings
-        kvlen <- headerContinue sid ths endOfStream off0
-        off <- sendHeadersIfNecessary $ off0 + frameHeaderLength + kvlen
-        case rspn of
-            RspnNobody _ _ -> do
-                halfClosedLocal ctx strm Finished
-                return off
-            RspnFile _ _ path mpart -> do
-                -- Data frame payload
-                let payloadOff = off + frameHeaderLength
-                Next datPayloadLen mnext <-
-                    fillFileBodyGetNext conn ii payloadOff lim path mpart
-                off' <- fillDataHeader strm off datPayloadLen mnext tell getH2D
-                maybeEnqueueNext out mnext
-                return off'
-            RspnBuilder _ _ builder -> do
-                -- Data frame payload
-                let payloadOff = off + frameHeaderLength
-                Next datPayloadLen mnext <-
-                    fillBuilderBodyGetNext conn ii payloadOff lim builder
-                off' <- fillDataHeader strm off datPayloadLen mnext tell getH2D
-                maybeEnqueueNext out mnext
-                return off'
-            RspnStreaming _ _ tbq -> do
-                let payloadOff = off + frameHeaderLength
-                Next datPayloadLen mnext <-
-                    fillStreamBodyGetNext conn payloadOff lim tbq strm
-                off' <- fillDataHeader strm off datPayloadLen mnext tell getH2D
-                maybeEnqueueNext out mnext
-                return off'
-
-    output out@(Output strm _ _ _ _ (OPush ths pid)) off0 lim = do
-        -- Creating a push promise header
-        -- Frame id should be associated stream id from the client.
-        let !sid = streamNumber strm
-        len <- pushPromise pid sid ths off0
-        off <- sendHeadersIfNecessary $ off0 + frameHeaderLength + len
-        output out{ outputType = ORspn }  off lim
-
-    output _ _ _ = undefined -- never reach
-
-    outputOrEnqueueAgain out off = E.handle resetStream $ do
-        state <- readStreamState strm
-        if isHalfClosedLocal state then
-            return off
-          else case out of
-                 Output _ _ _ wait _ OWait -> do
-                     -- Checking if all push are done.
-                     let out' = out {
-                             outputHook = return ()
-                           , outputType = ORspn
-                           }
-                     forkAndEnqueueWhenReady wait outputQ out' mgr
-                     return off
-                 _ -> case mtbq of
-                        Just tbq -> checkStreaming tbq
-                        _        -> checkStreamWindowSize
-      where
-        strm = outputStream out
-        mtbq = outputMaybeTBQueue out
-        checkStreaming tbq = do
-            isEmpty <- atomically $ isEmptyTBQueue tbq
-            if isEmpty then do
-                forkAndEnqueueWhenReady (waitStreaming tbq) outputQ out mgr
-                return off
-              else
-                checkStreamWindowSize
-        checkStreamWindowSize = do
-            sws <- getStreamWindowSize strm
-            if sws == 0 then do
-                forkAndEnqueueWhenReady (waitStreamWindowSize strm) outputQ out mgr
-                return off
-              else do
-                cws <- atomically $ readTVar connectionWindow -- not 0
-                let !lim = min cws sws
-                output out off lim
-        resetStream e = do
-            closed ctx strm (ResetByMe e)
-            let !rst = resetFrame InternalError $ streamNumber strm
-            enqueueControl controlQ $ CFrame rst
-            return off
-
-    {-# INLINE flushN #-}
-    -- Flush the connection buffer to the socket, where the first 'n' bytes of
-    -- the buffer are filled.
-    flushN :: Int -> IO ()
-    flushN n = bufferIO connWriteBuffer n connSendAll
-
-    headerContinue sid ths endOfStream off = do
-        let !offkv = off + frameHeaderLength
-        let !bufkv = connWriteBuffer `plusPtr` offkv
-            !limkv = connBufferSize - offkv
-        (hs,kvlen) <- hpackEncodeHeader ctx bufkv limkv ths
-        let flag0 = case hs of
-                [] -> setEndHeader defaultFlags
-                _  -> defaultFlags
-            flag = if endOfStream then setEndStream flag0 else flag0
-        let buf = connWriteBuffer `plusPtr` off
-        fillFrameHeader FrameHeaders kvlen sid flag buf
-        continue sid kvlen hs
-
-    !bufHeaderPayload = connWriteBuffer `plusPtr` frameHeaderLength
-    !headerPayloadLim = connBufferSize - frameHeaderLength
-
-    continue _   kvlen [] = return kvlen
-    continue sid kvlen ths = do
-        flushN $ kvlen + frameHeaderLength
-        -- Now off is 0
-        (ths', kvlen') <- hpackEncodeHeaderLoop ctx bufHeaderPayload headerPayloadLim ths
-        when (ths == ths') $ E.throwIO $ ConnectionError CompressionError "cannot compress the header"
-        let flag = case ths' of
-                [] -> setEndHeader defaultFlags
-                _  -> defaultFlags
-        fillFrameHeader FrameContinuation kvlen' sid flag connWriteBuffer
-        continue sid kvlen' ths'
-
-    {-# INLINE maybeEnqueueNext #-}
-    -- Re-enqueue the stream in the output queue.
-    maybeEnqueueNext :: Output -> Maybe DynaNext -> IO ()
-    maybeEnqueueNext _   Nothing     = return ()
-    maybeEnqueueNext out (Just next) = enqueueOutput outputQ out'
-      where
-        !out' = out { outputType = ONext next }
-
-    {-# INLINE sendHeadersIfNecessary #-}
-    -- Send headers if there is not room for a 1-byte data frame, and return
-    -- the offset of the next frame's first header byte.
-    sendHeadersIfNecessary off
-      -- True if the connection buffer has room for a 1-byte data frame.
-      | off + frameHeaderLength < connBufferSize = return off
-      | otherwise = do
-          flushN off
-          return 0
-
-    fillDataHeader strm@Stream{streamWindow,streamNumber}
-                   off datPayloadLen mnext tell getH2D = do
-        -- Data frame header
-        mh2d <- getH2D
-        let (!trailers,!noTrailers) = case http2dataTrailers <$> mh2d of
-              Nothing -> ([], True)
-              Just ts -> (ts, null ts)
-            !buf = connWriteBuffer `plusPtr` off
-            !off' = off + frameHeaderLength + datPayloadLen
-            !noMoreBody = isNothing mnext
-            flag | noMoreBody && noTrailers = setEndStream defaultFlags
-                 | otherwise                = defaultFlags
-        fillFrameHeader FrameData datPayloadLen streamNumber flag buf
-        off'' <- handleEndOfBody noMoreBody off' noTrailers trailers
-        atomically $ modifyTVar' connectionWindow (subtract datPayloadLen)
-        atomically $ modifyTVar' streamWindow (subtract datPayloadLen)
-        return off''
-      where
-        handleTrailers True off0 _        = return off0
-        handleTrailers _    off0 trailers = do
-            (ths,_) <- toHeaderTable trailers
-            kvlen <- headerContinue streamNumber ths True off0
-            sendHeadersIfNecessary $ off0 + frameHeaderLength + kvlen
-        handleEndOfBody True off0 noTrailers trailers = do
-            off1 <- handleTrailers noTrailers off0 trailers
-            void tell
-            halfClosedLocal ctx strm Finished
-            return off1
-        handleEndOfBody False off0 _ _ = return off0
-
-
-    pushPromise pid sid ths off = do
-        let !offsid = off + frameHeaderLength
-            !bufsid = connWriteBuffer `plusPtr` offsid
-        poke32 bufsid $ fromIntegral sid
-        let !offkv  = offsid + 4
-            !bufkv  = connWriteBuffer `plusPtr` offkv
-            !limkv  = connBufferSize - offkv
-        (_,kvlen) <- hpackEncodeHeader ctx bufkv limkv ths
-        let !flag = setEndHeader defaultFlags -- No EndStream flag
-            !buf = connWriteBuffer `plusPtr` off
-            !len = kvlen + 4
-        fillFrameHeader FramePushPromise len pid flag buf
-        return len
-
-    {-# INLINE fillFrameHeader #-}
-    fillFrameHeader ftyp len sid flag buf = encodeFrameHeaderBuf ftyp hinfo buf
-      where
-        hinfo = FrameHeader len flag sid
-
-    {-# INLINE ignore #-}
-    ignore :: E.SomeException -> IO ()
-    ignore _ = return ()
-
-----------------------------------------------------------------
-
-{-
-ResponseFile Status ResponseHeaders FilePath (Maybe FilePart)
-ResponseBuilder Status ResponseHeaders Builder
-ResponseStream Status ResponseHeaders StreamingBody
-ResponseRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) Response
--}
-
-fillBuilderBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> Builder -> IO Next
-fillBuilderBodyGetNext Connection{connWriteBuffer,connBufferSize}
-                        _ off lim bb = do
-    let datBuf = connWriteBuffer `plusPtr` off
-        room = min (connBufferSize - off) lim
-    (len, signal) <- B.runBuilder bb datBuf room
-    return $ nextForBuilder len signal
-
-fillFileBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> FilePath -> Maybe FilePart -> IO Next
-#ifdef WINDOWS
-fillFileBodyGetNext Connection{connWriteBuffer,connBufferSize}
-                        _ off lim path mpart = do
-    let datBuf = connWriteBuffer `plusPtr` off
-        room = min (connBufferSize - off) lim
-    (start, bytes) <- fileStartEnd path mpart
-    -- fixme: how to close Handle? GC does it at this moment.
-    hdl <- IO.openBinaryFile path IO.ReadMode
-    IO.hSeek hdl IO.AbsoluteSeek start
-    len <- IO.hGetBufSome hdl datBuf (mini room bytes)
-    let bytes' = bytes - fromIntegral len
-    -- fixme: connWriteBuffer connBufferSize
-    return $ nextForFile len hdl bytes' (return ())
-#else
-fillFileBodyGetNext Connection{connWriteBuffer,connBufferSize}
-                        ii off lim path mpart = do
-    (mfd, refresh') <- getFd ii path
-    (fd, refresh) <- case mfd of
-        Nothing -> do
-            fd' <- openFile path
-            th <- T.register (timeoutManager ii) (closeFile fd')
-            return (fd', T.tickle th)
-        Just fd  -> return (fd, refresh')
-    let datBuf = connWriteBuffer `plusPtr` off
-        room = min (connBufferSize - off) lim
-    (start, bytes) <- fileStartEnd path mpart
-    len <- positionRead fd datBuf (mini room bytes) start
-    refresh
-    let len' = fromIntegral len
-    return $ nextForFile len fd (start + len') (bytes - len') refresh
-#endif
-
-fileStartEnd :: FilePath -> Maybe FilePart -> IO (Integer, Integer)
-fileStartEnd _ (Just part) =
-    return (filePartOffset part, filePartByteCount part)
-fileStartEnd _ _ = error "fileStartEnd"
-
-----------------------------------------------------------------
-
-fillStreamBodyGetNext :: Connection -> Int -> WindowSize -> TBQueue Sequence -> Stream -> IO Next
-fillStreamBodyGetNext Connection{connWriteBuffer,connBufferSize}
-                      off lim sq strm = do
-    let datBuf = connWriteBuffer `plusPtr` off
-        room = min (connBufferSize - off) lim
-    (leftover, cont, len) <- runStreamBuilder datBuf room sq
-    return $ nextForStream sq strm leftover cont len
-
-----------------------------------------------------------------
-
-fillBufBuilder :: Leftover -> DynaNext
-fillBufBuilder leftover buf0 siz0 lim = do
-    let payloadBuf = buf0 `plusPtr` frameHeaderLength
-        room = min (siz0 - frameHeaderLength) lim
-    case leftover of
-        LZero -> error "fillBufBuilder: LZero"
-        LOne writer -> do
-            (len, signal) <- writer payloadBuf room
-            getNext len signal
-        LTwo bs writer
-          | BS.length bs <= room -> do
-              buf1 <- copy payloadBuf bs
-              let len1 = BS.length bs
-              (len2, signal) <- writer buf1 (room - len1)
-              getNext (len1 + len2) signal
-          | otherwise -> do
-              let (bs1,bs2) = BS.splitAt room bs
-              void $ copy payloadBuf bs1
-              getNext room (B.Chunk bs2 writer)
-  where
-    getNext l s = return $ nextForBuilder l s
-
-nextForBuilder :: BytesFilled -> B.Next -> Next
-nextForBuilder len B.Done
-    = Next len Nothing
-nextForBuilder len (B.More _ writer)
-    = Next len $ Just (fillBufBuilder (LOne writer))
-nextForBuilder len (B.Chunk bs writer)
-    = Next len $ Just (fillBufBuilder (LTwo bs writer))
-
-----------------------------------------------------------------
-
-runStreamBuilder :: Buffer -> BufSize -> TBQueue Sequence
-                 -> IO (Leftover, Bool, BytesFilled)
-runStreamBuilder buf0 room0 sq = loop buf0 room0 0
-  where
-    loop !buf !room !total = do
-        mbuilder <- atomically $ tryReadTBQueue sq
-        case mbuilder of
-            Nothing      -> return (LZero, True, total)
-            Just (SBuilder builder) -> do
-                (len, signal) <- B.runBuilder builder buf room
-                let !total' = total + len
-                case signal of
-                    B.Done -> loop (buf `plusPtr` len) (room - len) total'
-                    B.More  _ writer  -> return (LOne writer, True, total')
-                    B.Chunk bs writer -> return (LTwo bs writer, True, total')
-            Just SFlush  -> return (LZero, True, total)
-            Just SFinish -> return (LZero, False, total)
-
-fillBufStream :: Leftover -> TBQueue Sequence -> Stream -> DynaNext
-fillBufStream leftover0 sq strm buf0 siz0 lim0 = do
-    let payloadBuf = buf0 `plusPtr` frameHeaderLength
-        room0 = min (siz0 - frameHeaderLength) lim0
-    case leftover0 of
-        LZero -> do
-            (leftover, cont, len) <- runStreamBuilder payloadBuf room0 sq
-            getNext leftover cont len
-        LOne writer -> write writer payloadBuf room0 0
-        LTwo bs writer
-          | BS.length bs <= room0 -> do
-              buf1 <- copy payloadBuf bs
-              let len = BS.length bs
-              write writer buf1 (room0 - len) len
-          | otherwise -> do
-              let (bs1,bs2) = BS.splitAt room0 bs
-              void $ copy payloadBuf bs1
-              getNext (LTwo bs2 writer) True room0
-  where
-    getNext l b r = return $ nextForStream sq strm l b r
-    write writer1 buf room sofar = do
-        (len, signal) <- writer1 buf room
-        case signal of
-            B.Done -> do
-                (leftover, cont, extra) <- runStreamBuilder (buf `plusPtr` len) (room - len) sq
-                let !total = sofar + len + extra
-                getNext leftover cont total
-            B.More  _ writer -> do
-                let !total = sofar + len
-                getNext (LOne writer) True total
-            B.Chunk bs writer -> do
-                let !total = sofar + len
-                getNext (LTwo bs writer) True total
-
-nextForStream :: TBQueue Sequence -> Stream
-              -> Leftover -> Bool -> BytesFilled
-              -> Next
-nextForStream _ _ _ False len = Next len Nothing
-nextForStream sq strm leftOrZero True len =
-    Next len $ Just (fillBufStream leftOrZero sq strm)
-
-----------------------------------------------------------------
-
-#ifdef WINDOWS
-fillBufFile :: IO.Handle -> Integer -> IO () -> DynaNext
-fillBufFile h bytes refresh buf siz lim = do
-    let payloadBuf = buf `plusPtr` frameHeaderLength
-        room = min (siz - frameHeaderLength) lim
-    len <- IO.hGetBufSome h payloadBuf room
-    refresh
-    let bytes' = bytes - fromIntegral len
-    return $ nextForFile len h bytes' refresh
-
-nextForFile :: BytesFilled -> IO.Handle -> Integer -> IO () -> Next
-nextForFile 0   _ _     _       = Next 0   Nothing
-nextForFile len _ 0     _       = Next len Nothing
-nextForFile len h bytes refresh =
-    Next len $ Just (fillBufFile h bytes refresh)
-#else
-fillBufFile :: Fd -> Integer -> Integer -> IO () -> DynaNext
-fillBufFile fd start bytes refresh buf siz lim = do
-    let payloadBuf = buf `plusPtr` frameHeaderLength
-        room = min (siz - frameHeaderLength) lim
-    len <- positionRead fd payloadBuf (mini room bytes) start
-    let len' = fromIntegral len
-    refresh
-    return $ nextForFile len fd (start + len') (bytes - len') refresh
-
-nextForFile :: BytesFilled -> Fd -> Integer -> Integer -> IO () -> Next
-nextForFile 0   _  _     _     _       = Next 0   Nothing
-nextForFile len _  _     0     _       = Next len Nothing
-nextForFile len fd start bytes refresh =
-    Next len $ Just (fillBufFile fd start bytes refresh)
-#endif
-
-{-# INLINE mini #-}
-mini :: Int -> Integer -> Int
-mini i n
-  | fromIntegral i < n = i
-  | otherwise          = fromIntegral n
-
-
-----------------------------------------------------------------
-
-poke32 :: Ptr Word8 -> Word32 -> IO ()
-poke32 ptr i = do
-    poke ptr w0
-    poke8 ptr 1 w1
-    poke8 ptr 2 w2
-    poke8 ptr 3 w3
-  where
-    w0 = fromIntegral ((i `shiftR` 24) .&. 0xff)
-    w1 = fromIntegral ((i `shiftR` 16) .&. 0xff)
-    w2 = fromIntegral ((i `shiftR`  8) .&. 0xff)
-    w3 = fromIntegral  (i              .&. 0xff)
-    poke8 :: Ptr Word8 -> Int -> Word8 -> IO ()
-    poke8 ptr0 n w = poke (ptr0 `plusPtr` n) w
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
@@ -1,371 +1,78 @@
-{-# LANGUAGE OverloadedStrings, CPP #-}
-{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.HTTP2.Types where
 
-import Control.Concurrent (forkIO)
-import Control.Concurrent.STM
-import Control.Exception (SomeException, bracket)
 import qualified Data.ByteString as BS
-import Data.ByteString.Builder (Builder)
-import Data.IORef
-import Data.IntMap.Strict (IntMap, IntMap)
-import qualified Data.IntMap.Strict as M
-import Network.HPACK hiding (Buffer)
 import qualified Network.HTTP.Types as H
-import Network.HTTP2
-import Network.HTTP2.Priority
-import Network.Wai (Request, FilePart)
+import Network.HTTP2.Frame
+import qualified Network.HTTP2.Server as H2
 
-import Network.Wai.Handler.Warp.HTTP2.Manager
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.Types
 
 ----------------------------------------------------------------
 
-http2ver :: H.HttpVersion
-http2ver = H.HttpVersion 2 0
-
 isHTTP2 :: Transport -> Bool
 isHTTP2 TCP = False
 isHTTP2 tls = useHTTP2
   where
     useHTTP2 = case tlsNegotiatedProtocol tls of
-        Nothing    -> False
+        Nothing -> False
         Just proto -> "h2" `BS.isPrefixOf` proto
 
 ----------------------------------------------------------------
 
-data Input = Input Stream Request ValueTable InternalInfo
-
-----------------------------------------------------------------
-
-type DynaNext = Buffer -> BufSize -> WindowSize -> IO Next
-
-type BytesFilled = Int
-
-data Next = Next !BytesFilled (Maybe DynaNext)
-
-data Rspn = RspnNobody    H.Status (TokenHeaderList, ValueTable)
-          | RspnStreaming H.Status (TokenHeaderList, ValueTable) (TBQueue Sequence)
-          | RspnBuilder   H.Status (TokenHeaderList, ValueTable) Builder
-          | RspnFile      H.Status (TokenHeaderList, ValueTable) FilePath (Maybe FilePart)
-
-rspnStatus :: Rspn -> H.Status
-rspnStatus (RspnNobody    s _)      = s
-rspnStatus (RspnStreaming s _ _)    = s
-rspnStatus (RspnBuilder   s _ _)    = s
-rspnStatus (RspnFile      s _ _ _ ) = s
-
-rspnHeaders :: Rspn -> (TokenHeaderList, ValueTable)
-rspnHeaders (RspnNobody    _ t)      = t
-rspnHeaders (RspnStreaming _ t _)    = t
-rspnHeaders (RspnBuilder   _ t _)    = t
-rspnHeaders (RspnFile      _ t _ _ ) = t
-
-data Output = Output {
-    outputStream :: !Stream
-  , outputRspn   :: !Rspn
-  , outputII     :: !InternalInfo
-  , outputHook   :: IO () -- OPush: wait for done, O*: telling done
-  , outputH2Data :: IO (Maybe HTTP2Data)
-  , outputType   :: !OutputType
-  }
-
-data OutputType = ORspn
-                | OWait
-                | OPush !TokenHeaderList !StreamId -- associated stream id from client
-                | ONext !DynaNext
-
-outputMaybeTBQueue :: Output -> Maybe (TBQueue Sequence)
-outputMaybeTBQueue (Output _ (RspnStreaming _ _ tbq) _ _ _ _) = Just tbq
-outputMaybeTBQueue _                                          = Nothing
-
-data Control = CFinish
-             | CGoaway    !ByteString
-             | CFrame     !ByteString
-             | CSettings  !ByteString !SettingsList
-             | CSettings0 !ByteString !ByteString !SettingsList
-
-----------------------------------------------------------------
-
-data Sequence = SFinish
-              | SFlush
-              | SBuilder Builder
-
-----------------------------------------------------------------
-
--- | The context for HTTP/2 connection.
-data Context = Context {
-  -- HTTP/2 settings received from a browser
-    http2settings      :: !(IORef Settings)
-  , firstSettings      :: !(IORef Bool)
-  , streamTable        :: !StreamTable
-  , concurrency        :: !(IORef Int)
-  , priorityTreeSize   :: !(IORef Int)
-  -- | RFC 7540 says "Other frames (from any stream) MUST NOT
-  --   occur between the HEADERS frame and any CONTINUATION
-  --   frames that might follow". This field is used to implement
-  --   this requirement.
-  , continued          :: !(IORef (Maybe StreamId))
-  , clientStreamId     :: !(IORef StreamId)
-  , serverStreamId     :: !(IORef StreamId)
-  , inputQ             :: !(TQueue Input)
-  , outputQ            :: !(PriorityTree Output)
-  , controlQ           :: !(TQueue Control)
-  , encodeDynamicTable :: !DynamicTable
-  , decodeDynamicTable :: !DynamicTable
-  -- the connection window for data from a server to a browser.
-  , connectionWindow   :: !(TVar WindowSize)
-  }
-
-----------------------------------------------------------------
-
-newContext :: IO Context
-newContext = Context <$> newIORef defaultSettings
-                     <*> newIORef False
-                     <*> newStreamTable
-                     <*> newIORef 0
-                     <*> newIORef 0
-                     <*> newIORef Nothing
-                     <*> newIORef 0
-                     <*> newIORef 0
-                     <*> newTQueueIO
-                     <*> newPriorityTree
-                     <*> newTQueueIO
-                     <*> newDynamicTableForEncoding defaultDynamicTableSize
-                     <*> newDynamicTableForDecoding defaultDynamicTableSize 4096
-                     <*> newTVarIO defaultInitialWindowSize
-
-clearContext :: Context -> IO ()
-clearContext _ctx = return ()
-
-----------------------------------------------------------------
-
-data OpenState =
-    JustOpened
-  | Continued [HeaderBlockFragment]
-              !Int  -- Total size
-              !Int  -- The number of continuation frames
-              !Bool -- End of stream
-              !Priority
-  | NoBody (TokenHeaderList,ValueTable) !Priority
-  | HasBody (TokenHeaderList,ValueTable) !Priority
-  | Body !(TQueue ByteString)
-         !(Maybe Int) -- received Content-Length
-                      -- compared the body length for error checking
-         !(IORef Int) -- actual body length
-
-data ClosedCode = Finished
-                | Killed
-                | Reset !ErrorCodeId
-                | ResetByMe SomeException
-                deriving Show
-
-data StreamState =
-    Idle
-  | Open !OpenState
-  | HalfClosedRemote
-  | HalfClosedLocal !ClosedCode
-  | Closed !ClosedCode
-  | Reserved
-
-isIdle :: StreamState -> Bool
-isIdle Idle = True
-isIdle _    = False
-
-isOpen :: StreamState -> Bool
-isOpen Open{} = True
-isOpen _      = False
-
-isHalfClosedRemote :: StreamState -> Bool
-isHalfClosedRemote HalfClosedRemote = True
-isHalfClosedRemote (Closed _)       = True
-isHalfClosedRemote _                = False
-
-isHalfClosedLocal :: StreamState -> Bool
-isHalfClosedLocal (HalfClosedLocal _) = True
-isHalfClosedLocal (Closed _)       = True
-isHalfClosedLocal _                = False
-
-isClosed :: StreamState -> Bool
-isClosed Closed{} = True
-isClosed _        = False
-
-instance Show StreamState where
-    show Idle        = "Idle"
-    show Open{}      = "Open"
-    show HalfClosedRemote  = "HalfClosedRemote"
-    show (HalfClosedLocal e)  = "HalfClosedLocal: " ++ show e
-    show (Closed e)  = "Closed: " ++ show e
-    show Reserved    = "Reserved"
-
-----------------------------------------------------------------
-
-data Stream = Stream {
-    streamNumber     :: !StreamId
-  , streamState      :: !(IORef StreamState)
-  , streamWindow     :: !(TVar WindowSize)
-  , streamPrecedence :: !(IORef Precedence)
-  }
-
-instance Show Stream where
-  show s = show (streamNumber s)
-
-newStream :: StreamId -> WindowSize -> IO Stream
-newStream sid win = Stream sid <$> newIORef Idle
-                               <*> newTVarIO win
-                               <*> newIORef defaultPrecedence
-
-newPushStream :: Context -> WindowSize -> Precedence -> IO Stream
-newPushStream Context{serverStreamId} win pre = do
-    sid <- atomicModifyIORef' serverStreamId inc2
-    Stream sid <$> newIORef Reserved
-               <*> newTVarIO win
-               <*> newIORef pre
-  where
-    inc2 x = let !x' = x + 2 in (x', x')
-
-----------------------------------------------------------------
-
-{-# INLINE readStreamState #-}
-readStreamState :: Stream -> IO StreamState
-readStreamState Stream{streamState} =
-    readIORef streamState
-
-{-# INLINE setStreamState #-}
-setStreamState :: Context -> Stream -> StreamState -> IO ()
-setStreamState _ Stream{streamState} val = writeIORef streamState val
-
-opened :: Context -> Stream -> IO ()
-opened ctx@Context{concurrency} strm = do
-    atomicModifyIORef' concurrency (\x -> (x+1,()))
-    setStreamState ctx strm (Open JustOpened)
-
-halfClosedRemote :: Context -> Stream -> IO ()
-halfClosedRemote ctx stream@Stream{streamState} = do
-    !closingCode <- atomicModifyIORef streamState closeHalf
-    case closingCode of
-        Nothing -> return ()
-        Just cc -> closed ctx stream cc
-  where
-    closeHalf :: StreamState -> (StreamState, Maybe ClosedCode)
-    closeHalf x@(Closed _)         = (x, Nothing)
-    closeHalf (HalfClosedLocal cc) = (Closed cc, Just cc)
-    closeHalf _                    = (HalfClosedRemote, Nothing)
-
-halfClosedLocal :: Context -> Stream -> ClosedCode -> IO ()
-halfClosedLocal ctx stream@Stream{streamState} cc = do
-    shouldFinalize <- atomicModifyIORef streamState closeHalf
-    when shouldFinalize $
-        closed ctx stream cc
-  where
-    closeHalf :: StreamState -> (StreamState, Bool)
-    closeHalf x@(Closed _)     = (x, False)
-    closeHalf HalfClosedRemote = (Closed cc, True)
-    closeHalf _                = (HalfClosedLocal cc, False)
-
-closed :: Context -> Stream -> ClosedCode -> IO ()
-closed ctx@Context{concurrency,streamTable} strm@Stream{streamNumber} cc = do
-    remove streamTable streamNumber
-    -- TODO: prevent double-counting
-    atomicModifyIORef' concurrency (\x -> (x-1,()))
-    setStreamState ctx strm (Closed cc) -- anyway
-
-----------------------------------------------------------------
-
-newtype StreamTable = StreamTable (IORef (IntMap Stream))
-
-newStreamTable :: IO StreamTable
-newStreamTable = StreamTable <$> newIORef M.empty
-
-insert :: StreamTable -> M.Key -> Stream -> IO ()
-insert (StreamTable ref) k v = atomicModifyIORef' ref $ \m ->
-    let !m' = M.insert k v m
-    in (m', ())
-
-remove :: StreamTable -> M.Key -> IO ()
-remove (StreamTable ref) k = atomicModifyIORef' ref $ \m ->
-    let !m' = M.delete k m
-    in (m', ())
-
-search :: StreamTable -> M.Key -> IO (Maybe Stream)
-search (StreamTable ref) k = M.lookup k <$> readIORef ref
-
-updateAllStreamWindow :: (WindowSize -> WindowSize) -> StreamTable -> IO ()
-updateAllStreamWindow adst (StreamTable ref) = do
-    strms <- M.elems <$> readIORef ref
-    forM_ strms $ \strm -> atomically $ modifyTVar (streamWindow strm) adst
-
-{-# INLINE forkAndEnqueueWhenReady #-}
-forkAndEnqueueWhenReady :: IO () -> PriorityTree Output -> Output -> Manager -> IO ()
-forkAndEnqueueWhenReady wait outQ out mgr = bracket setup teardown $ \_ ->
-    void . forkIO $ do
-        wait
-        enqueueOutput outQ out
-  where
-    setup = addMyId mgr
-    teardown _ = deleteMyId mgr
-
-{-# INLINE enqueueOutput #-}
-enqueueOutput :: PriorityTree Output -> Output -> IO ()
-enqueueOutput outQ out = do
-    let Stream{..} = outputStream out
-    pre <- readIORef streamPrecedence
-    enqueue outQ streamNumber pre out
-
-{-# INLINE enqueueControl #-}
-enqueueControl :: TQueue Control -> Control -> IO ()
-enqueueControl ctlQ ctl = atomically $ writeTQueue ctlQ ctl
-
-----------------------------------------------------------------
-
 -- | 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]
-    --   Since: 3.2.8
-    , http2dataTrailers :: H.ResponseHeaders
-    } deriving (Eq,Show)
+    , http2dataTrailers :: H2.TrailersMaker
+    -- ^ Accessor for 'H2.TrailersMaker' in 'HTTP2Data'.
+    --
+    --   Since: 3.2.8 but the type changed in 3.3.0
+    }
 
 -- | Default HTTP/2 specific data.
 --
 --   Since: 3.2.7
 defaultHTTP2Data :: HTTP2Data
-defaultHTTP2Data = HTTP2Data [] []
+defaultHTTP2Data = HTTP2Data [] H2.defaultTrailersMaker
 
 -- | HTTP/2 push promise or sever push.
+--   This allows files only for backward-compatibility
+--   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/HTTP2/Worker.hs b/Network/Wai/Handler/Warp/HTTP2/Worker.hs
deleted file mode 100644
--- a/Network/Wai/Handler/Warp/HTTP2/Worker.hs
+++ /dev/null
@@ -1,331 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE BangPatterns #-}
-
-module Network.Wai.Handler.Warp.HTTP2.Worker (
-    Responder
-  , response
-  , worker
-  ) where
-
-import Control.Concurrent.STM
-import Control.Exception (SomeException(..), AsyncException(..))
-import qualified Control.Exception as E
-import Data.ByteString.Builder (byteString)
-import Data.IORef
-import qualified Data.Vault.Lazy as Vault
-import Network.HPACK
-import Network.HPACK.Token
-import qualified Network.HTTP.Types as H
-import Network.HTTP2
-import Network.HTTP2.Priority
-import Network.Wai
-import Network.Wai.Internal (Response(..), ResponseReceived(..), ResponseReceived(..), getRequestBodyChunk)
-import qualified System.TimeManager as T
-
-import Network.Wai.Handler.Warp.FileInfoCache
-import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
-import Network.Wai.Handler.Warp.HTTP2.File
-import Network.Wai.Handler.Warp.HTTP2.Manager
-import Network.Wai.Handler.Warp.HTTP2.Request
-import Network.Wai.Handler.Warp.HTTP2.Types
-import Network.Wai.Handler.Warp.Imports hiding (insert)
-import Network.Wai.Handler.Warp.Request (pauseTimeoutKey)
-import qualified Network.Wai.Handler.Warp.Response as R
-import qualified Network.Wai.Handler.Warp.Settings as S
-import Network.Wai.Handler.Warp.Types
-
-----------------------------------------------------------------
-
--- | The wai definition is 'type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived'.
---   This type implements the second argument (Response -> IO ResponseReceived)
---   with extra arguments.
-type Responder = InternalInfo
-              -> T.Handle
-              -> ValueTable -- for Request
-              -> ThreadContinue
-              -> Stream
-              -> Request
-              -> Response
-              -> IO ResponseReceived
-
-pushStream :: Context -> S.Settings
-           -> StreamId -> ValueTable -> Request -> InternalInfo
-           -> Maybe HTTP2Data
-           -> IO (OutputType, IO ())
-pushStream _ _ _ _ _ _ Nothing = return (ORspn, return ())
-pushStream ctx@Context{http2settings,outputQ,streamTable}
-           settings pid reqvt req ii (Just h2d)
-  | len == 0 = return (ORspn, return ())
-  | otherwise = do
-        pushable <- enablePush <$> readIORef http2settings
-        if pushable then do
-            tvar <- newTVarIO 0
-            lim <- push tvar pps0 0
-            if lim == 0 then
-              return (ORspn, return ())
-             else
-              return (OWait, waiter lim tvar)
-          else
-            return (ORspn, return ())
-  where
-    !pps0 = http2dataPushPromise h2d
-    !len = length pps0
-    !pushLogger = S.settingsServerPushLogger settings
-    increment tvar = atomically $ modifyTVar' tvar (+1)
-    waiter lim tvar = atomically $ do
-        n <- readTVar tvar
-        check (n >= lim)
-    !h2data = getHTTP2Data req
-    push _ [] !n = return (n :: Int)
-    push tvar (pp:pps) !n = do
-        let !file = promisedFile pp
-        efinfo <- E.try $ getFileInfo ii file
-        case efinfo of
-          Left (_ex :: E.IOException) -> push tvar pps n
-          Right (FileInfo _ size _ date) -> do
-              ws <- initialWindowSize <$> readIORef http2settings
-              let !w = promisedWeight pp
-                  !pri = defaultPriority { weight = w }
-                  !pre = toPrecedence pri
-              strm <- newPushStream ctx ws pre
-              let !sid = streamNumber strm
-              insert streamTable sid strm
-              (ths0, vt) <- toHeaderTable (promisedResponseHeaders pp)
-              let !scheme = fromJust $ getHeaderValue tokenScheme reqvt
-                  -- fixme: this value can be Nothing
-                  !auth   = fromJust (getHeaderValue tokenHost reqvt
-                                  <|> getHeaderValue tokenAuthority reqvt)
-                  !path = promisedPath pp
-                  !promisedRequest = [(tokenMethod, H.methodGet)
-                                     ,(tokenScheme, scheme)
-                                     ,(tokenAuthority, auth)
-                                     ,(tokenPath, path)]
-                  !part = FilePart 0 size size
-                  !rsp = RspnFile H.ok200 (ths,vt) file (Just part)
-                  !ths = (tokenLastModified,date) :
-                         addContentHeadersForFilePart ths0 part
-              pushLogger req path size
-              let !ot = OPush promisedRequest pid
-                  !out = Output strm rsp ii (increment tvar) h2data ot
-              enqueueOutput outputQ out
-              push tvar pps (n + 1)
-
-
--- | This function is passed to workers.
---   They also pass 'Response's from 'Application's to this function.
---   This function enqueues commands for the HTTP/2 sender.
-response :: S.Settings -> Context -> Manager -> Responder
-response settings ctx@Context{outputQ} mgr ii th reqvt tconf strm req rsp = E.handle (E.throwIO . ExceptionInsideResponseBody) $ case rsp of
-  ResponseStream s0 hs0 strmbdy
-    | noBody s0          -> responseNoBody s0 hs0
-    | isHead             -> responseNoBody s0 hs0
-    | otherwise          -> getHTTP2Data req
-                        >>= pushStream ctx settings sid reqvt req ii
-                        >>= responseStreaming s0 hs0 strmbdy
-  ResponseBuilder s0 hs0 b
-    | noBody s0          -> responseNoBody s0 hs0
-    | isHead             -> responseNoBody s0 hs0
-    | otherwise          -> getHTTP2Data req
-                        >>= pushStream ctx settings sid reqvt req ii
-                        >>= responseBuilderBody s0 hs0 b
-  ResponseFile s0 hs0 p mp
-    | noBody s0          -> responseNoBody s0 hs0
-    | otherwise          -> getHTTP2Data req
-                        >>= pushStream ctx settings sid reqvt req ii
-                        >>= responseFileXXX s0 hs0 p mp
-  ResponseRaw _ _        -> error "HTTP/2 does not support ResponseRaw"
-  where
-    noBody = not . R.hasBody
-    !isHead = requestMethod req == H.methodHead
-    !logger = S.settingsLogger settings
-    sid = streamNumber strm
-    !h2data = getHTTP2Data req
-
-    -- Ideally, log messages should be written when responses are
-    -- actually sent. But there is no way to keep good memory usage
-    -- (resist to Request leak) and throughput. By compromise,
-    -- log message are written here even the window size of streams
-    -- is 0.
-
-    responseNoBody s hs0 = toHeaderTable hs0 >>= responseNoBody' s
-
-    responseNoBody' s tbl = do
-        logger req s Nothing
-        setThreadContinue tconf True
-        let !rspn = RspnNobody s tbl
-            !out = Output strm rspn ii (return ()) h2data ORspn
-        enqueueOutput outputQ out
-        return ResponseReceived
-
-    responseBuilderBody s hs0 bdy (rspnOrWait,tell) = do
-        logger req s Nothing
-        setThreadContinue tconf True
-        tbl <- toHeaderTable hs0
-        let !rspn = RspnBuilder s tbl bdy
-            !out = Output strm rspn ii tell h2data rspnOrWait
-        enqueueOutput outputQ out
-        return ResponseReceived
-
-    responseFileXXX _ hs0 path Nothing aux = do
-        efinfo <- E.try $ getFileInfo ii path
-        case efinfo of
-            Left (_ex :: E.IOException) -> response404 hs0
-            Right finfo -> do
-                (rspths0,vt) <- toHeaderTable hs0
-                case conditionalRequest finfo rspths0 reqvt of
-                    WithoutBody s             -> responseNoBody s hs0
-                    WithBody s rspths beg len -> responseFile2XX s (rspths,vt) path (Just (FilePart beg len (fileInfoSize finfo))) aux
-
-    responseFileXXX s0 hs0 path mpart aux = do
-        tbl <- toHeaderTable hs0
-        responseFile2XX s0 tbl path mpart aux
-
-    responseFile2XX s tbl path mpart (rspnOrWait,tell)
-      | isHead    = do
-          logger req s Nothing
-          responseNoBody' s tbl
-      | otherwise = do
-          logger req s (filePartByteCount <$> mpart)
-          setThreadContinue tconf True
-          let !rspn = RspnFile s tbl path mpart
-              !out = Output strm rspn ii tell h2data rspnOrWait
-          enqueueOutput outputQ out
-          return ResponseReceived
-
-    response404 hs0 = responseBuilderBody s hs body (ORspn, return ())
-      where
-        s = H.notFound404
-        hs = R.replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
-        body = byteString "File not found"
-
-    responseStreaming s0 hs0 strmbdy (rspnOrWait,tell) = do
-        logger req s0 Nothing
-        -- We must not exit this WAI application.
-        -- If the application exits, streaming would be also closed.
-        -- So, this work occupies this thread.
-        --
-        -- We need to increase the number of workers.
-        spawnAction mgr
-        -- After this work, this thread stops to decease
-        -- the number of workers.
-        setThreadContinue tconf False
-        -- Since 'StreamingBody' is loop, we cannot control it.
-        -- So, let's serialize 'Builder' with a designated queue.
-        tbq <- newTBQueueIO 10 -- fixme: hard coding: 10
-        tbl <- toHeaderTable hs0
-        let !rspn = RspnStreaming s0 tbl tbq
-            !out = Output strm rspn ii tell h2data rspnOrWait
-        enqueueOutput outputQ out
-        let push b = do
-              T.pause th
-              atomically $ writeTBQueue tbq (SBuilder b)
-              T.resume th
-            flush  = atomically $ writeTBQueue tbq SFlush
-        _ <- strmbdy push flush
-        atomically $ writeTBQueue tbq SFinish
-        deleteMyId mgr
-        return ResponseReceived
-
-worker :: Context -> S.Settings -> Application -> Responder -> T.Manager -> IO ()
-worker ctx@Context{inputQ,controlQ} set app responder tm = do
-    sinfo <- newStreamInfo
-    tcont <- newThreadContinue
-    let timeoutAction = return () -- cannot close the shared connection
-    E.bracket (T.registerKillThread tm timeoutAction) T.cancel $ go sinfo tcont
-  where
-    go sinfo tcont th = do
-        setThreadContinue tcont True
-        ex <- E.try $ do
-            T.pause th
-            inp@(Input strm req reqvt ii) <- atomically $ readTQueue inputQ
-            setStreamInfo sinfo inp
-            T.resume th
-            T.tickle th
-            let !body = getRequestBodyChunk req
-                !body' = do
-                    T.pause th
-                    bs <- body
-                    T.resume th
-                    return bs
-                !vaultValue = Vault.insert pauseTimeoutKey (T.pause th) $ vault req
-                !req' = req { vault = vaultValue, requestBody = body' }
-            mr <- E.try $ app req' $ responder ii th reqvt tcont strm req'
-            case mr of
-                Right ok -> return ok
-                Left e@(SomeException _)
-                  | Just (ExceptionInsideResponseBody e') <- E.fromException e -> E.throwIO e'
-                  | otherwise -> responder ii th reqvt tcont strm req' (S.settingsOnExceptionResponse set e)
-        cont1 <- case ex of
-            Right ResponseReceived -> return True
-            Left  e@(SomeException _)
-              -- killed by the local worker manager
-              | Just ThreadKilled    <- E.fromException e -> return False
-              -- killed by the local timeout manager
-              | Just T.TimeoutThread <- E.fromException e -> do
-                  cleanup sinfo Nothing
-                  return True
-              | otherwise -> do
-                  cleanup sinfo $ Just e
-                  return True
-        cont2 <- getThreadContinue tcont
-        clearStreamInfo sinfo
-        when (cont1 && cont2) $ go sinfo tcont th
-    cleanup sinfo me = do
-        minp <- getStreamInfo sinfo
-        case minp of
-            Nothing               -> return ()
-            Just (Input strm req _reqvt _ii) -> do
-                closed ctx strm Killed
-                let !frame = resetFrame InternalError (streamNumber strm)
-                enqueueControl controlQ $ CFrame frame
-                case me of
-                    Nothing -> return ()
-                    Just e  -> S.settingsOnException set (Just req) e
-
-----------------------------------------------------------------
-
--- | It would nice if responders could return values to workers.
---   Unfortunately, 'ResponseReceived' is already defined in WAI 2.0.
---   It is not wise to change this type.
---   So, a reference is shared by a responder and its worker.
---   The reference refers a value of this type as a return value.
---   If 'True', the worker continue to serve requests.
---   Otherwise, the worker get finished.
-newtype ThreadContinue = ThreadContinue (IORef Bool)
-
-{-# INLINE newThreadContinue #-}
-newThreadContinue :: IO ThreadContinue
-newThreadContinue = ThreadContinue <$> newIORef True
-
-{-# INLINE setThreadContinue #-}
-setThreadContinue :: ThreadContinue -> Bool -> IO ()
-setThreadContinue (ThreadContinue ref) x = writeIORef ref x
-
-{-# INLINE getThreadContinue #-}
-getThreadContinue :: ThreadContinue -> IO Bool
-getThreadContinue (ThreadContinue ref) = readIORef ref
-
-----------------------------------------------------------------
-
--- | The type to store enough information for 'settingsOnException'.
-newtype StreamInfo = StreamInfo (IORef (Maybe Input))
-
-{-# INLINE newStreamInfo #-}
-newStreamInfo :: IO StreamInfo
-newStreamInfo = StreamInfo <$> newIORef Nothing
-
-{-# INLINE clearStreamInfo #-}
-clearStreamInfo :: StreamInfo -> IO ()
-clearStreamInfo (StreamInfo ref) = writeIORef ref Nothing
-
-{-# INLINE setStreamInfo #-}
-setStreamInfo :: StreamInfo -> Input -> IO ()
-setStreamInfo (StreamInfo ref) inp = writeIORef ref $ Just inp
-
-{-# INLINE getStreamInfo #-}
-getStreamInfo :: StreamInfo -> IO (Maybe Input)
-getStreamInfo (StreamInfo ref) = readIORef ref
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
@@ -1,5 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
-
 module Network.Wai.Handler.Warp.HashMap where
 
 import Data.Hashable (hash)
@@ -30,13 +28,9 @@
 ----------------------------------------------------------------
 
 insert :: FilePath -> v -> HashMap v -> HashMap v
-insert path v (HashMap hm) = HashMap $ I.insertWith f h m hm
-  where
-    !h = hash path
-    !m = M.singleton path v
-    f = M.union -- fimxe
+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 h hm >>= M.lookup path
-  where
-    !h = hash path
+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,56 +21,77 @@
 indexRequestHeader :: RequestHeaders -> IndexedHeader
 indexRequestHeader hdr = traverseHeader hdr requestMaxIndex requestKeyIndex
 
-data RequestHeaderIndex = ReqContentLength
-                        | ReqTransferEncoding
-                        | ReqExpect
-                        | ReqConnection
-                        | ReqRange
-                        | ReqHost
-                        | ReqIfModifiedSince
-                        | ReqIfUnmodifiedSince
-                        | ReqIfRange
-                        | ReqReferer
-                        | ReqUserAgent
-                        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 \"Content-Length\", \"Transfer-Encoding\",
---   \"Expect\", \"Connection\", \"Range\", \"Host\",
---   \"If-Modified-Since\", \"If-Unmodified-Since\" and \"If-Range\".
+--   From 0 to this corresponds to:
+--
+-- - \"Content-Length\"
+-- - \"Transfer-Encoding\"
+-- - \"Expect\"
+-- - \"Connection\"
+-- - \"Range\"
+-- - \"Host\"
+-- - \"If-Modified-Since\"
+-- - \"If-Unmodified-Since\"
+-- - \"If-Range\"
+-- - \"Referer\"
+-- - \"User-Agent\"
+-- - \"If-Match\"
+-- - \"If-None-Match\"
 requestMaxIndex :: Int
 requestMaxIndex = fromEnum (maxBound :: RequestHeaderIndex)
 
 requestKeyIndex :: HeaderName -> Int
 requestKeyIndex hn = case BS.length bs of
-   4  -> if bs == "host" then fromEnum ReqHost else -1
-   5  -> if bs == "range" then fromEnum ReqRange else -1
-   6  -> if bs == "expect" then fromEnum ReqExpect else -1
-   7  -> if bs == "referer" then fromEnum ReqReferer else -1
-   8  -> if bs == "if-range" then fromEnum ReqIfRange else -1
-   10 -> if bs == "user-agent" then fromEnum ReqUserAgent else
-         if bs == "connection" then fromEnum ReqConnection else -1
-   14 -> if bs == "content-length" then fromEnum ReqContentLength else -1
-   17 -> if bs == "transfer-encoding" then fromEnum ReqTransferEncoding else
-         if bs == "if-modified-since" then fromEnum ReqIfModifiedSince
-         else -1
-   19 -> if bs == "if-unmodified-since" then fromEnum ReqIfUnmodifiedSince else -1
-   _  -> -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
-                         deriving (Enum,Bounded)
+data ResponseHeaderIndex
+    = ResContentLength
+    | ResServer
+    | ResDate
+    | ResLastModified
+    deriving (Enum, Bounded)
 
 -- | The size for 'IndexedHeader' for HTTP Response.
 responseMaxIndex :: Int
@@ -77,10 +99,11 @@
 
 responseKeyIndex :: HeaderName -> Int
 responseKeyIndex hn = case BS.length bs of
-    4  -> if bs == "date" then fromEnum ResDate else -1
-    6  -> if bs == "server" then fromEnum ResServer else -1
-    14 -> if bs == "content-length" then fromEnum ResContentLength else -1
-    _  -> -1
+    4 | bs == "date" -> fromEnum ResDate
+    6 | bs == "server" -> fromEnum ResServer
+    13 | bs == "last-modified" -> fromEnum ResLastModified
+    14 | bs == "content-length" -> fromEnum ResContentLength
+    _ -> -1
   where
     bs = foldedCase hn
 
@@ -88,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
@@ -1,30 +1,50 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-
 module Network.Wai.Handler.Warp.IO where
 
+import Control.Exception (mask_)
 import Data.ByteString.Builder (Builder)
-import Data.ByteString.Builder.Extra (runBuilder, Next(Done, More, Chunk))
-
+import Data.ByteString.Builder.Extra (Next (Chunk, Done, More), runBuilder)
+import Data.IORef (IORef, readIORef, writeIORef)
 import Network.Wai.Handler.Warp.Buffer
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.Types
 
-toBufIOWith :: Buffer -> BufSize -> (ByteString -> IO ()) -> Builder -> IO ()
-toBufIOWith buf !size io builder = loop firstWriter
+toBufIOWith
+    :: Int -> IORef WriteBuffer -> (ByteString -> IO ()) -> Builder -> IO Integer
+toBufIOWith maxRspBufSize writeBufferRef io builder = do
+    writeBuffer <- readIORef writeBufferRef
+    loop writeBuffer firstWriter 0
   where
     firstWriter = runBuilder builder
-    runIO len = bufferIO buf len io
-    loop writer = do
+    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 -> runIO len
-             More minSize next
-               | size < minSize -> error "toBufIOWith: BufferFull: minSize"
-               | otherwise      -> do
-                   runIO len
-                   loop next
-             Chunk bs next -> do
-                 runIO len
-                 io bs
-                 loop next
+            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,27 +1,39 @@
 module Network.Wai.Handler.Warp.Imports (
-    ByteString(..)
-  , NonEmpty(..)
-  , module Control.Applicative
-  , module Control.Monad
-  , module Data.Bits
-  , module Data.List
-  , 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
-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
-  , makePlainReceiveN
+    Recv,
+    makeGracefulRecv,
+    RecvBuf,
+
     -- ** Buffer
-  , Buffer
-  , BufSize
-  , bufferSize
-  , 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,45 @@
     --   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
-  ) where
+    setSocketCloseOnExec,
+    windowsThreadBlockHack,
 
+    -- * Misc
+    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
+import Network.Wai.Handler.Warp.HTTP2
+import Network.Wai.Handler.Warp.HTTP2.File
 import Network.Wai.Handler.Warp.Header
-import Network.Wai.Handler.Warp.Recv
 import Network.Wai.Handler.Warp.Request
 import Network.Wai.Handler.Warp.Response
 import Network.Wai.Handler.Warp.Run
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,17 +1,16 @@
-{-# LANGUAGE BangPatterns #-}
-
 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)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as I
@@ -20,22 +19,22 @@
 
 ----------------------------------------------------------------
 
--- | 'MultiMap' is used for cache of file descriptors.
---   Since multiple threads would open file descriptors for
---   the same file simultaneously, multiple entries must
---   be contained for the file.
---   Since hash values of file pathes are used as outer keys,
---   collison would happen for multiple file pathes.
---   Becase only positive entries are contained,
---   a bad guy cannot be cause the hash collision intentinally.
+-- | 'MultiMap' is used as a cache of file descriptors.
+--   Since multiple threads could open file descriptors for
+--   the same file simultaneously, there could be multiple entries
+--   for one file.
+--   Since hash values of file paths are used as outer keys,
+--   collison would happen for multiple file paths.
+--   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)])
 
 ----------------------------------------------------------------
 
 -- | O(1)
 empty :: MultiMap v
-empty = MultiMap $ I.empty
+empty = MultiMap I.empty
 
 -- | O(1)
 isEmpty :: MultiMap v -> Bool
@@ -45,67 +44,48 @@
 
 -- | O(1)
 singleton :: FilePath -> v -> MultiMap v
-singleton path v = MultiMap mm
-  where
-    !h = hash path
-    !mm = I.singleton h [(path,v)]
+singleton path v = MultiMap $ I.singleton (hash path) [(path, v)]
 
 ----------------------------------------------------------------
 
--- | O(N)
+-- | O(M) where M is the number of entries per file
 lookup :: FilePath -> MultiMap v -> Maybe v
-lookup path (MultiMap mm) = case I.lookup h mm of
+lookup path (MultiMap mm) = case I.lookup (hash path) mm of
     Nothing -> Nothing
-    Just s  -> Prelude.lookup path s
-  where
-    !h = hash path
+    Just s -> Prelude.lookup path s
 
 ----------------------------------------------------------------
 
 -- | O(log n)
 insert :: FilePath -> v -> MultiMap v -> MultiMap v
-insert path v (MultiMap mm) = MultiMap mm'
-  where
-    !h = hash path
-    !mm' = I.insertWith (<>) h [(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 = MultiMap <$> mm'
+pruneWith
+    :: MultiMap v
+    -> ((FilePath, v) -> IO Bool)
+    -> IO (MultiMap v)
+pruneWith (MultiMap mm) action =
+    I.foldrWithKey go (pure . MultiMap) mm I.empty
   where
-    !mm' = I.fromAscList <$> go (I.toDescList mm) []
-    go []          !acc = return acc
-    go ((h,s):kss) !acc = do
-        rs <- prune action s
+    go h s cont acc = do
+        rs <- filterM action s
         case rs of
-            [] -> go kss acc
-            _  -> go kss ((h,rs) : acc)
+            [] -> cont acc
+            _ -> cont $! I.insert h rs acc
 
 ----------------------------------------------------------------
 
 -- O(n + m) where N is the size of the second argument
 merge :: MultiMap v -> MultiMap v -> MultiMap v
-merge (MultiMap m1) (MultiMap m2) = MultiMap mm
-  where
-    !mm = I.unionWith (<>) m1 m2
-
-----------------------------------------------------------------
-
-prune :: ((FilePath,v) -> IO Bool) -> [(FilePath,v)] -> IO [(FilePath,v)]
-prune action xs0 = go xs0
-  where
-    go []     = return []
-    go (x:xs) = do
-        keep <- action x
-        rs <- go xs
-        return $ if keep then x:rs else rs
+merge (MultiMap m1) (MultiMap m2) = MultiMap $ I.unionWith (<>) m1 m2
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,26 +1,22 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- Copyright     : Erik de Castro Lopo <erikd@mega-nerd.com>
 -- License       : BSD3
 
 module Network.Wai.Handler.Warp.ReadInt (
-    readInt
-  , readInt64
-  ) where
-
--- This function lives in its own file because the MagicHash pragma interacts
--- poorly with the CPP pragma.
+    readInt,
+    readInt64,
+) where
 
 import qualified Data.ByteString as S
-import GHC.Prim
-import GHC.Types
-import GHC.Word
+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
 
@@ -34,34 +30,6 @@
 
 {-# NOINLINE readInt64 #-}
 readInt64 :: ByteString -> Int64
-readInt64 bs = S.foldl' (\ !i !c -> i * 10 + fromIntegral (mhDigitToInt c)) 0
-             $ S.takeWhile isDigit bs
-
-data Table = Table !Addr#
-
-{-# NOINLINE mhDigitToInt #-}
-mhDigitToInt :: Word8 -> Int
-mhDigitToInt (W8# i) = I# (word2Int# (indexWord8OffAddr# addr (word2Int# i)))
-  where
-    !(Table addr) = table
-    table :: Table
-    table = Table
-        "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
-        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
-
-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/Recv.hs b/Network/Wai/Handler/Warp/Recv.hs
deleted file mode 100644
--- a/Network/Wai/Handler/Warp/Recv.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-
-module Network.Wai.Handler.Warp.Recv (
-    receive
-  , receiveBuf
-  , makeReceiveN
-  , makePlainReceiveN
-  , spell
-  ) where
-
-import qualified Control.Exception as E
-import qualified Data.ByteString as BS
-import Data.IORef
-import Foreign.C.Error (eAGAIN, getErrno, throwErrno)
-import Foreign.C.Types
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Ptr (Ptr, castPtr, plusPtr)
-import GHC.Conc (threadWaitRead)
-import Network.Socket (Socket, fdSocket)
-import System.Posix.Types (Fd(..))
-
-import Network.Wai.Handler.Warp.Buffer
-import Network.Wai.Handler.Warp.Imports
-import Network.Wai.Handler.Warp.Types
-
-#ifdef mingw32_HOST_OS
-import GHC.IO.FD (FD(..), readRawBufferPtr)
-import Network.Wai.Handler.Warp.Windows
-#endif
-
-----------------------------------------------------------------
-
-makeReceiveN :: ByteString -> Recv -> RecvBuf -> IO (BufSize -> IO ByteString)
-makeReceiveN bs0 recv recvBuf = do
-    ref <- newIORef bs0
-    return $ receiveN ref recv recvBuf
-
--- | This function returns a receiving function
---   based on two receiving functions.
---   The returned function efficiently manages received data
---   which is initialized by the first argument.
---   The returned function may allocate a byte string with malloc().
-makePlainReceiveN :: Socket -> ByteString -> IO (BufSize -> IO ByteString)
-makePlainReceiveN s bs0 = do
-    ref <- newIORef bs0
-    pool <- newBufferPool
-    return $ receiveN ref (receive s pool) (receiveBuf s)
-
-receiveN :: IORef ByteString -> Recv -> RecvBuf -> BufSize -> IO ByteString
-receiveN ref recv recvBuf size = E.handle handler $ do
-    cached <- readIORef ref
-    (bs, leftover) <- spell cached size recv recvBuf
-    writeIORef ref leftover
-    return bs
- where
-   handler :: E.SomeException -> IO ByteString
-   handler _ = return ""
-
-----------------------------------------------------------------
-
-spell :: ByteString -> BufSize -> IO ByteString -> RecvBuf -> IO (ByteString, ByteString)
-spell init0 siz0 recv recvBuf
-  | siz0 <= len0 = return $ BS.splitAt siz0 init0
-  -- fixme: hard coding 4096
-  | siz0 <= 4096 = loop [init0] (siz0 - len0)
-  | otherwise    = do
-      bs@(PS fptr _ _) <- mallocBS siz0
-      withForeignPtr fptr $ \ptr -> do
-          ptr' <- copy ptr init0
-          full <- recvBuf ptr' (siz0 - len0)
-          if full then
-              return (bs, "")
-            else
-              return ("", "") -- fixme
-  where
-    len0 = BS.length init0
-    loop bss siz = do
-        bs <- recv
-        let len = BS.length bs
-        if len == 0 then
-            return ("", "")
-          else if len >= siz then do
-            let (consume, leftover) = BS.splitAt siz bs
-                ret = BS.concat $ reverse (consume : bss)
-            return (ret, leftover)
-          else do
-            let bss' = bs : bss
-                siz' = siz - len
-            loop bss' siz'
-
-receive :: Socket -> BufferPool -> Recv
-receive sock pool = withBufferPool pool $ \ (ptr, size) -> do
-#if MIN_VERSION_network(3,0,0)
-    fd <- fdSocket sock
-#else
-    let fd = fdSocket sock
-#endif
-    let size' = fromIntegral size
-    fromIntegral <$> receiveloop fd ptr size'
-
-receiveBuf :: Socket -> RecvBuf
-receiveBuf sock buf0 siz0 = do
-#if MIN_VERSION_network(3,0,0)
-    fd <- fdSocket sock
-#else
-    let fd = fdSocket sock
-#endif
-    loop fd buf0 siz0
-  where
-    loop _  _   0   = return True
-    loop fd buf siz = do
-        n <- fromIntegral <$> receiveloop fd buf (fromIntegral siz)
-        -- fixme: what should we do in the case of n == 0
-        if n == 0 then
-            return False
-          else
-            loop fd (buf `plusPtr` n) (siz - n)
-
-receiveloop :: CInt -> Ptr Word8 -> CSize -> IO CInt
-receiveloop sock ptr size = do
-#ifdef mingw32_HOST_OS
-    bytes <- windowsThreadBlockHack $ fromIntegral <$> readRawBufferPtr "recv" (FD sock 1) (castPtr ptr) 0 size
-#else
-    bytes <- c_recv sock (castPtr ptr) size 0
-#endif
-    if bytes == -1 then do
-        errno <- getErrno
-        if errno == eAGAIN then do
-            threadWaitRead (Fd sock)
-            receiveloop sock ptr size
-          else
-            throwErrno "receiveloop"
-       else
-        return bytes
-
--- fixme: the type of the return value
-foreign import ccall unsafe "recv"
-    c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
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,185 +1,209 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
 module Network.Wai.Handler.Warp.Request (
-    recvRequest
-  , headerLines
-  , pauseTimeoutKey
-  , getFileInfoKey
-  , NoKeepAliveRequest (..)
-  ) where
+    FirstRequest(..),
+    recvRequest,
+    headerLines,
+    pauseTimeoutKey,
+    getFileInfoKey,
+#ifdef MIN_VERSION_crypton_x509
+    getClientCertificateKey,
+#endif
+    NoKeepAliveRequest (..),
+) where
 
 import qualified Control.Concurrent as Conc (yield)
-import Control.Exception (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
 import Network.Wai.Handler.Warp.Header
-import Network.Wai.Handler.Warp.Imports hiding (readInt, lines)
+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)
+import Network.Wai.Handler.Warp.Settings (
+    Settings,
+    settingsMaxTotalHeaderLength,
+    settingsNoParsePath,
+ )
 
 ----------------------------------------------------------------
 
--- FIXME come up with good values here
-maxTotalHeaderLength :: Int
-maxTotalHeaderLength = 50 * 1024
-
-----------------------------------------------------------------
+-- | 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.
-            -> 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 = do
-    hdrlines <- headerLines firstRequest src
-    (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
+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
     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)
-                     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          = False
-          , 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 :: Bool -> Source -> IO [ByteString]
-headerLines firstRequest src = do
+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
-        else push src (THStatus 0 id id) bs
 
+            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
@@ -207,13 +231,15 @@
 
 ----------------------------------------------------------------
 
-type BSEndo = ByteString -> ByteString
+type BSEndo = S.ByteString -> S.ByteString
 type BSEndoList = [ByteString] -> [ByteString]
 
-data THStatus = THStatus
-    {-# UNPACK #-} !Int -- running total 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
 
 ----------------------------------------------------------------
 
@@ -222,75 +248,85 @@
 close = throwIO IncompleteHeaders
 -}
 
-push :: Source -> THStatus -> ByteString -> IO [ByteString]
-push src (THStatus len lines prepend) bs'
+-- | Assumes the 'ByteString' is never 'S.null'
+push :: Int -> Source -> THStatus -> ByteString -> IO [ByteString]
+push maxTotalHeaderLength src (THStatus totalLen chunkLen reqLines prepend) bs
+    -- Newline found at index 'ix'
+    | Just ix <- S.elemIndex _lf bs = do
         -- Too many bytes
-        | len > 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
-    bs = prepend bs'
     bsLen = S.length bs
-    mnl = do
-        nl <- S.elemIndex 10 bs
-        -- check if there are two more bytes in the bs
-        -- if so, see if the second of those is a horizontal space
-        if bsLen > nl + 1 then
-            let c = S.index bs (nl + 1)
-                b = case nl of
-                      0 -> True
-                      1 -> S.index bs 0 == 13
-                      _ -> False
-            in Just (nl, not b && (c == 32 || c == 9))
-            else
-            Just (nl, False)
-
-    {-# INLINE push' #-}
-    push' :: Maybe (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 src status bst
-      where
-        len' = len + bsLen
-        prepend' = S.append bs
-        status = THStatus len' lines prepend'
-    -- Found a newline, but next line continues as a multiline header
-    push' (Just (end, True)) = push src status rest
-      where
-        rest = S.drop (end + 1) bs
-        prepend' = S.append (SU.unsafeTake (checkCR bs end) bs)
-        len' = len + end
-        status = THStatus len' lines prepend'
-    -- Found a newline at position end.
-    push' (Just (end, False))
-      -- leftover
-      | S.null line = do
-            when (start < bsLen) $ leftoverSource src (SU.unsafeDrop start bs)
-            return (lines [])
-      -- more headers
-      | otherwise   = let len' = len + start
-                          lines' = lines . (line:)
-                          status = THStatus len' lines' id
-                      in if start < bsLen then
-                             -- more bytes in this chunk, push again
-                             let bs'' = SU.unsafeDrop start bs
-                              in push src status bs''
-                           else do
-                             -- no more bytes in this chunk, ask for more
-                             bst <- readSource' src
-                             when (S.null bs) $ throwIO IncompleteHeaders
-                             push 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
-  where
-    !p = pos - 1
 
 pauseTimeoutKey :: Vault.Key (IO ())
 pauseTimeoutKey = unsafePerformIO Vault.newKey
@@ -299,3 +335,9 @@
 getFileInfoKey :: Vault.Key (FilePath -> IO FileInfo)
 getFileInfoKey = unsafePerformIO Vault.newKey
 {-# NOINLINE getFileInfoKey #-}
+
+#ifdef MIN_VERSION_crypton_x509
+getClientCertificateKey :: Vault.Key (Maybe CertificateChain)
+getClientCertificateKey = unsafePerformIO Vault.newKey
+{-# NOINLINE getClientCertificateKey #-}
+#endif
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 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,35 +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
-  ) 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 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.Streaming.ByteString.Builder (newByteStringBuilderRecv, reuseBufferStrategy)
-import Data.Version (showVersion)
-import Data.Word8 (_cr, _lf)
+import Data.List (deleteBy)
+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)
@@ -93,68 +100,84 @@
 --
 --     Simple applications should specify 'Nothing' to
 --     'Maybe' 'FilePart'. The size of the specified file is obtained
---     by disk access or from the file infor cache.
+--     by disk access or from the file info cache.
 --     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 <- 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 ver s hs rsp
-        case ms of
-            Nothing         -> return ()
-            Just realStatus -> logger req realStatus mlen
-        T.tickle th
-        return ret
-      else do
-        _ <- sendRsp conn ii ver s hs 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
+    maxRspBufSize = settingsMaxBuilderResponseBufferSize settings
     ver = httpVersion req
     s = responseStatus response
     hs0 = sanitizeHeaders $ responseHeaders response
     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)
-    isHead = requestMethod req == H.methodHead
+    (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 th
-        ResponseRaw raw _           -> RspRaw raw src (T.tickle th)
+            | 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
 
 ----------------------------------------------------------------
 
@@ -162,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
@@ -172,36 +195,41 @@
 {-# 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 T.Handle
-         | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) (IO ())
+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
-        -> H.HttpVersion
-        -> H.Status
-        -> H.ResponseHeaders
-        -> 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
+sendRsp conn _ _ ver s hs _ _ _ RspNoBody = do
     -- Not adding Content-Length.
     -- User agents treats it as Content-Length: 0.
     composeHeader ver s hs >>= connSendAll conn
@@ -209,23 +237,32 @@
 
 ----------------------------------------------------------------
 
-sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do
+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
-        buffer = connWriteBuffer conn
-        size = connBufferSize conn
-    toBufIOWith buffer size (connSendAll conn) hdrBdy
-    return (Just s, Nothing) -- fixme: can we tell the actual sent bytes?
+            | needsChunked =
+                header
+                    <> chunkedTransferEncoding body
+                    <> chunkedTransferTerminator
+            | otherwise = header <> body
+        writeBufferRef = connWriteBuffer conn
+    len <-
+        toBufIOWith
+            maxRspBufSize
+            writeBufferRef
+            (\bs -> connSendAll conn bs >> T.tickle th)
+            hdrBdy
+    return (Just s, Just len)
 
 ----------------------------------------------------------------
 
-sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do
+sendRsp conn _ th ver s hs _ _ _ (RspStream streamingBody needsChunked) = do
     header <- composeHeaderBuilder ver s hs needsChunked
-    (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy
-                    $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)
+    (recv, finish) <-
+        newByteStringBuilderRecv $
+            reuseBufferStrategy $
+                toBuilderBuffer $
+                    connWriteBuffer conn
     let send builder = do
             popper <- recv builder
             let loop = do
@@ -246,22 +283,35 @@
 
 ----------------------------------------------------------------
 
-sendRsp conn _ _ _ _ (RspRaw withApp src tickle) = do
+sendRsp conn _ th _ _ _ _ _ _ (RspRaw withApp src) = do
     withApp recv send
     return (Nothing, Nothing)
   where
     recv = do
         bs <- src
-        unless (S.null bs) tickle
+        unless (S.null bs) $ T.tickle th
         return bs
-    send bs = connSendAll conn bs >> tickle
+    send bs = connSendAll conn bs >> T.tickle th
 
 ----------------------------------------------------------------
 
 -- Sophisticated WAI applications.
 -- We respect s0. s0 MUST be a proper value.
-sendRsp conn ii ver s0 hs0 (RspFile path (Just part) _ isHead hook) =
-    sendRspFile2XX conn ii ver s0 hs 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
@@ -271,50 +321,86 @@
 
 -- Simple WAI applications.
 -- Status is ignored
-sendRsp conn ii ver _ hs0 (RspFile path Nothing idxhdr isHead hook) = do
+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 :: E.IOException) ->
 #ifdef WARP_DEBUG
-          print _ex >>
+            print _ex >>
 #endif
-          sendRspFile404 conn ii ver hs0
-        Right finfo -> case conditionalRequest finfo hs0 idxhdr of
-          WithoutBody s         -> sendRsp conn ii ver s hs0 RspNoBody
-          WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs path beg len isHead hook
+            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
+                    hook
 
 ----------------------------------------------------------------
 
-sendRspFile2XX :: Connection
-               -> InternalInfo
-               -> H.HttpVersion
-               -> H.Status
-               -> H.ResponseHeaders
-               -> FilePath
-               -> Integer
-               -> Integer
-               -> Bool
-               -> IO ()
-               -> IO (Maybe H.Status, Maybe Integer)
-sendRspFile2XX conn ii ver s hs path beg len isHead hook
-  | isHead = sendRsp conn ii ver s hs 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
-               -> H.HttpVersion
-               -> H.ResponseHeaders
-               -> IO (Maybe H.Status, Maybe Integer)
-sendRspFile404 conn ii ver hs0 = sendRsp conn ii ver s hs (RspBuilder body True)
+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)
   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"
 
 ----------------------------------------------------------------
@@ -322,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
@@ -363,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)
@@ -373,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
 
@@ -384,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
@@ -393,31 +486,35 @@
 
 ----------------------------------------------------------------
 
--- | 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
+
 ----------------------------------------------------------------
 
 -- |
 --
 -- >>> 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,16 +1,18 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.ResponseHeader (composeHeader) where
 
 import qualified Data.ByteString as S
 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
+import Network.Socket.BufferPool (copy)
 
-import Network.Wai.Handler.Warp.Buffer (copy)
 import Network.Wai.Handler.Warp.Imports
 
 ----------------------------------------------------------------
@@ -22,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
@@ -35,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,77 +1,174 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
 module Network.Wai.Handler.Warp.Run where
 
-import "iproute" Data.IP (toHostAddress, toHostAddress6)
 import Control.Arrow (first)
-import qualified Control.Concurrent as Conc (yield)
-import Control.Exception as E
+import Control.Concurrent.STM (
+    TVar,
+    atomically,
+    check,
+    modifyTVar',
+    newTVarIO,
+    readTVar,
+ )
+import qualified Control.Exception as E
 import qualified Data.ByteString as S
-import Data.Char (chr)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef')
+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(..))
-import Network.Socket (Socket, close, accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6), setSocketOption, SocketOption(..))
+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
+import Network.Socket.BufferPool
 import qualified Network.Socket.ByteString as Sock
 import Network.Wai
-import Network.Wai.Internal (ResponseReceived (ResponseReceived))
 import System.Environment (lookupEnv)
-import System.Timeout (timeout)
+import System.IO.Error (ioeGetErrorType)
 import qualified System.TimeManager as T
+import System.Timeout (timeout)
 
-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
 import qualified Network.Wai.Handler.Warp.FileInfoCache as I
-import Network.Wai.Handler.Warp.HTTP2 (http2, isHTTP2)
-import Network.Wai.Handler.Warp.Header
+import Network.Wai.Handler.Warp.HTTP1 (http1)
+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.ReadInt
-import Network.Wai.Handler.Warp.Recv
-import Network.Wai.Handler.Warp.Request
-import Network.Wai.Handler.Warp.Response
-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
+-- | 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
+socketConnection set s = do
+    (ss, _) <- makeServerState set
+    bufferPool <- newBufferPool 2048 16384
+    writeBuffer <- createWriteBuffer 16384
+    writeBufferRef <- newIORef writeBuffer
+    isH2 <- newIORef False -- HTTP/1.x
+    mysa <- getSocketName s
+    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 `E.catch` throughAsync (return ())
 #else
-import Network.Socket (fdSocket)
+            , connClose = close s
 #endif
+            , connRecv = receive' bufferPool ss appsInProgress
+            , connRecvBuf = \_ _ -> return True -- obsoleted
+            , connWriteBuffer = writeBufferRef
+            , connHTTP2 = isH2
+            , connMySockAddr = mysa
+            , connAppsInProgress = appsInProgress
+            }
+  where
+    receive' bufferPool ss appsInProgress =
+        E.handle handler $ makeGracefulRecv s bufferPool ss appsInProgress
+      where
+        handler :: E.IOException -> IO ByteString
+        handler e
+            | ioeGetErrorType e == InvalidArgument = return ""
+            | otherwise = E.throwIO e
 
--- | Creating 'Connection' for plain HTTP based on a given socket.
-socketConnection :: Socket -> IO Connection
-socketConnection s = do
-    bufferPool <- newBufferPool
-    writeBuf <- allocateBuffer bufferSize
-    let sendall = Sock.sendAll s
-    return Connection {
-        connSendMany = Sock.sendMany s
-      , connSendAll = sendall
-      , connSendFile = sendFile s writeBuf bufferSize sendall
-      , connClose = close s
-      , connFree = freeBuffer writeBuf
-      , connRecv = receive s bufferPool
-      , connRecvBuf = receiveBuf s
-      , connWriteBuffer = writeBuf
-      , connBufferSize = bufferSize
-      }
+    sendfile writeBufferRef fid offset len hook headers = do
+        writeBuffer <- readIORef writeBufferRef
+        sendFile
+            s
+            (bufBuffer writeBuffer)
+            (bufSize writeBuffer)
+            sendall
+            fid
+            offset
+            len
+            hook
+            headers
 
+    sendall = sendAll' s
+
+    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.
@@ -83,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 $
-    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
@@ -114,20 +212,17 @@
 -- Note that the 'settingsPort' will still be passed to 'Application's via the
 -- 'serverPort' record.
 runSettingsSocket :: Settings -> Socket -> Application -> IO ()
-runSettingsSocket set 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
-#if WINDOWS
-        (s, sa) <- windowsThreadBlockHack $ accept socket
-#else
-        (s, sa) <- accept socket
-#endif
+    getConn set = do
+        (s, sa) <- accept' socket
         setSocketCloseOnExec s
         -- NoDelay causes an error for AF_UNIX.
-        setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return ()
-        conn <- socketConnection s
+        setSocketOption s NoDelay 1 `E.catch` throughAsync (return ())
+        conn <- socketConnection set s
         return (conn, sa)
 
     closeListenSocket = close socket
@@ -141,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) <$>)
 
 ----------------------------------------------------------------
 
@@ -164,29 +261,37 @@
 -- 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 $ acceptConnection set getConnMaker app counter
-  where
-    withII action =
-        withTimeoutManager $ \tm ->
-        D.withDateCache $ \dc ->
-        F.withFdCache fdCacheDurationInSeconds $ \fdc ->
-        I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do
-            let ii = InternalInfo tm dc fdc fic
-            action ii
+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
 
-    !fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
-    !fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000
-    !timeoutInSeconds = settingsTimeout set * 1000000
+-- | Running an action with internal info.
+--
+-- Since 3.3.11
+withII :: Settings -> (InternalInfo -> IO a) -> IO a
+withII set action =
+    withTimeoutManager $ \tm ->
+        D.withDateCache $ \dc ->
+            F.withFdCache fdCacheDurationInMicroseconds $ \fdc ->
+                I.withFileInfoCache fdFileInfoDurationInMicroseconds $ \fic -> do
+                    let ii = InternalInfo tm dc fdc fic
+                    action ii
+  where
+    !fdCacheDurationInMicroseconds = settingsFdCacheDuration set * 1000000
+    !fdFileInfoDurationInMicroseconds = settingsFileInfoCacheDuration set * 1000000
+    !timeoutInMicroseconds = settingsTimeout set * 1000000
     withTimeoutManager f = case settingsManager set of
         Just tm -> f tm
-        Nothing -> 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
@@ -201,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 listing socket.
-    void $ mask_ acceptLoop
+    -- acceptLoop can be broken by closing the listening socket.
+    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.
@@ -221,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,
@@ -232,40 +342,73 @@
         -- 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 <- try 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.
-    handle (settingsOnException set Nothing) .
-    -- Allocate a new IORef indicating whether the connection has been
-    -- closed, to avoid double-freeing a connection
-    withClosedRef $ \ref ->
+    --
+    -- Intentionally using Control.Exception.handle, since we want to
+    -- catch all exceptions and avoid them from propagating, even
+    -- async exceptions. See:
+    -- https://github.com/yesodweb/wai/issues/850
+    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
@@ -276,263 +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.
-        bracket mkConn (cleanUp ref) (serve unmask ref)
+        E.bracket mkConn cleanUp (serve unmask)
   where
-    withClosedRef inner = newIORef False >>= inner
-
-    closeConn ref conn = do
-        isClosed <- atomicModifyIORef' ref $ \x -> (True, x)
-        unless isClosed $ connClose conn
-
-    cleanUp ref (conn, _) = closeConn ref conn `finally` connFree conn
+    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. We additionally close
-    -- the connection immediately in case the child thread catches the
-    -- async exception or performs some long-running cleanup action.
-    serve unmask ref (conn, transport) = bracket register cancel $ \th -> do
+    -- cancel that handler as soon as we exit.
+    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
-           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)
-                                        (closeConn ref 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)
-    istatus <- newIORef False
-    if settingsHTTP2Enabled settings && h2 then do
-        rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
-        let recvN = wrappedRecvN th istatus (settingsSlowlorisSize settings) rawRecvN
-        -- fixme: origAddr
-        http2 conn ii origAddr transport settings recvN app
-      else do
-        src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))
-        writeIORef istatus True
-        leftoverSource src bs
-        addr <- getProxyProtocolAddr src
-        http1 True addr istatus src `E.catch` \e ->
-          case fromException e of
-            -- See comment below referencing
-            -- https://github.com/yesodweb/wai/issues/618
-            Just NoKeepAliveRequest -> return ()
-            Nothing -> do
-              _ <- sendErrorResponse (dummyreq addr) istatus e
-              throwIO e
-
-  where
-    getProxyProtocolAddr src =
-        case settingsProxyProtocol settings of
-            ProxyProtocolNone ->
-                return origAddr
-            ProxyProtocolRequired -> do
-                seg <- readSource src
-                parseProxyProtocolHeader src seg
-            ProxyProtocolOptional -> do
-                seg <- readSource src
-                if S.isPrefixOf "PROXY " seg
-                    then parseProxyProtocolHeader src seg
-                    else do leftoverSource src seg
-                            return origAddr
-
-    parseProxyProtocolHeader src seg = do
-        let (header,seg') = S.break (== 0x0d) seg -- 0x0d == CR
-            maybeAddr = case S.split 0x20 header of -- 0x20 == space
-                ["PROXY","TCP4",clientAddr,_,clientPort,_] ->
-                    case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of
-                        [a] -> Just (SockAddrInet (readInt clientPort)
-                                                       (toHostAddress a))
-                        _ -> Nothing
-                ["PROXY","TCP6",clientAddr,_,clientPort,_] ->
-                    case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of
-                        [a] -> Just (SockAddrInet6 (readInt clientPort)
-                                                        0
-                                                        (toHostAddress6 a)
-                                                        0)
-                        _ -> Nothing
-                ("PROXY":"UNKNOWN":_) ->
-                    Just origAddr
-                _ ->
-                    Nothing
-        case maybeAddr of
-            Nothing -> throwIO (BadProxyHeader (decodeAscii header))
-            Just a -> do leftoverSource src (S.drop 2 seg') -- drop CRLF
-                         return a
-
-    decodeAscii = map (chr . fromEnum) . S.unpack
-
-    shouldSendErrorResponse se
-        | Just ConnectionClosedByPeer <- fromException se = False
-        | otherwise                                       = True
-
-    sendErrorResponse req istatus e = do
-        status <- readIORef istatus
-        if shouldSendErrorResponse e && status
-            then do
-                sendResponse settings conn ii th req defaultIndexRequestHeader (return S.empty) (errorResponse e)
-            else return False
-
-    dummyreq addr = defaultRequest { remoteHost = addr }
-
-    errorResponse e = settingsOnExceptionResponse settings e
-
-    http1 firstRequest addr istatus src = do
-        (req', mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src
-        let req = req' { isSecure = isTransportSecure transport }
-        keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush
-            `E.catch` \e -> do
-                settingsOnException settings (Just req) e
-                -- Don't throw the error again to prevent calling settingsOnException twice.
-                return False
-
-        -- 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
-        -- 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 $ http1 False addr istatus src
-
-    processRequest istatus src req mremainingRef idxhdr nextBodyFlush = do
-        -- Let the application run for as long as it wants
-        T.pause th
-
-        -- In the event that some scarce resource was acquired during
-        -- 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 <- E.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.
-            -- However, it may affect performance.
-            writeIORef istatus False
-            keepAlive <- sendResponse settings conn ii th req idxhdr (readSource src) res
-            writeIORef keepAliveRef keepAlive
-            return ResponseReceived
-        case r of
-            Right ResponseReceived -> return ()
-            Left e@(SomeException _)
-              | Just (ExceptionInsideResponseBody e') <- fromException e -> throwIO e'
-              | otherwise -> do
-                    keepAlive <- sendErrorResponse req istatus e
-                    settingsOnException settings (Just req) e
-                    writeIORef keepAliveRef keepAlive
-
-        keepAlive <- readIORef keepAliveRef
-
-        -- We just send a Response and it takes a time to
-        -- receive a Request again. If we immediately call recv,
-        -- it is likely to fail and cause the IO manager to do some work.
-        -- It is very costly, so we yield to another Haskell
-        -- thread hoping that the next Request will arrive
-        -- when this Haskell thread will be re-scheduled.
-        -- This improves performance at least when
-        -- the number of cores is small.
-        Conc.yield
-
-        if keepAlive
-          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
-
-flushEntireBody :: IO ByteString -> IO ()
-flushEntireBody src =
-    loop
-  where
-    loop = do
-        bs <- src
-        unless (S.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 src =
-    loop
+    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
-    loop toRead = do
-        bs <- src
-        let toRead' = toRead - S.length bs
-        case () of
-            ()
-                | S.null bs -> return True
-                | toRead' >= 0 -> loop toRead'
-                | otherwise -> return False
-
-wrappedRecv :: Connection -> T.Handle -> IORef Bool -> Int -> IO ByteString
-wrappedRecv Connection { connRecv = recv } th istatus slowlorisSize = do
-    bs <- recv
-    unless (S.null bs) $ do
-        writeIORef istatus True
-        when (S.length bs >= slowlorisSize) $ T.tickle th
-    return bs
-
-wrappedRecvN :: T.Handle -> IORef Bool -> Int -> (BufSize -> IO ByteString) -> (BufSize -> IO ByteString)
-wrappedRecvN th istatus slowlorisSize readN bufsize = do
-    bs <- readN bufsize
-    unless (S.null bs) $ do
-        writeIORef istatus True
-    -- 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 (S.length bs >= slowlorisSize || bufsize <= slowlorisSize) $ T.tickle th
-    return bs
+    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)
 --
@@ -553,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,23 +1,25 @@
-{-# 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)
+import Network.Socket.BufferPool
 
 #ifdef WINDOWS
 import Foreign.ForeignPtr (newForeignPtr_)
 import Foreign.Ptr (plusPtr)
 import qualified System.IO as IO
 #else
-import Control.Exception
+import qualified Control.Exception as E
 import Foreign.C.Error (throwErrno)
 import Foreign.C.Types
 import Foreign.Ptr (Ptr, castPtr, plusPtr)
@@ -41,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
@@ -52,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.
@@ -100,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 =
-  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,31 +1,49 @@
-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ViewPatterns #-}
-{-# LANGUAGE PatternGuards, RankNTypes #-}
-{-# LANGUAGE ImpredicativeTypes, CPP #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Network.Wai.Handler.Warp.Settings where
 
-import Control.Concurrent (forkIOWithUnmask)
-import Control.Exception
-import Data.ByteString.Builder (byteString)
+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.ByteString.Lazy (fromStrict)
 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(..))
+import GHC.Exts (fork#)
+import GHC.IO (IO (IO), unsafeUnmask)
+import GHC.IO.Exception (IOErrorType (..))
 import qualified Network.HTTP.Types as H
-import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )
-import Network.Socket (SockAddr)
+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'
@@ -33,120 +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: void . forkIOWithUnmask
-      --
-      -- 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
     , 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
     , 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.X.X.
+    -- ^ 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.X.X.
+    -- ^ 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
+    , 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
+    , settingsMaxTotalHeaderLength :: Int
+    -- ^ 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
+    , 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
+    , 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 = void . forkIOWithUnmask
-    , 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
-    }
+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.
@@ -154,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
@@ -167,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.
@@ -178,21 +382,27 @@
 -- Since 3.2.27
 defaultOnExceptionResponse :: SomeException -> Response
 defaultOnExceptionResponse e
-  | Just (_ :: InvalidRequest) <-
-    fromException e = responseLBS H.badRequest400
-                                [(H.hContentType, "text/plain; charset=utf-8")]
-                                 "Bad Request"
-  | Just (ConnectionError (UnknownErrorCode 413) t) <-
-    fromException e = responseLBS H.status413
-                                [(H.hContentType, "text/plain; charset=utf-8")]
-                                 (fromStrict t)
-  | Just (ConnectionError (UnknownErrorCode 431) t) <-
-    fromException e = responseLBS H.status431
-                                [(H.hContentType, "text/plain; charset=utf-8")]
-                                 (fromStrict t)
-  | 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.
@@ -200,6 +410,48 @@
 -- Since: 2.0.3.2
 exceptionResponseForDebug :: SomeException -> Response
 exceptionResponseForDebug e =
-    responseBuilder H.internalServerError500
-                    [(H.hContentType, "text/plain; charset=utf-8")]
-                    $ byteString . C8.pack $ "Exception: " ++ 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.
+--
+-- Since Warp will always install its own exception handler in forked threads, this provides
+-- a minor optimization.
+--
+-- For inspiration of this function, see @rawForkIO@ in the @async@ package.
+--
+-- @since 3.3.17
+defaultFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
+defaultFork io =
+    IO $ \s0 ->
+#if __GLASGOW_HASKELL__ >= 904
+        case io unsafeUnmask of
+            IO io' ->
+                case fork# io' s0 of
+                    (# s1, _tid #) -> (# s1, () #)
+#else
+        case fork# (io unsafeUnmask) s0 of
+            (# s1, _tid #) -> (# s1, () #)
+#endif
+
+-- | Standard "accept" call for a listening socket.
+--
+-- @since 3.3.24
+defaultAccept :: Socket -> IO (Socket, SockAddr)
+defaultAccept =
+#if WINDOWS
+    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,14 +1,17 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.Types where
 
-import Control.Exception
+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 Foreign.Ptr (Ptr)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+#ifdef MIN_VERSION_crypton_x509
+import Data.X509
+#endif
+import Network.Socket (SockAddr)
+import Network.Socket.BufferPool
 import System.Posix.Types (Fd)
 import qualified System.TimeManager as T
 
@@ -30,14 +33,19 @@
 ----------------------------------------------------------------
 
 -- | Error types for bad 'Request'.
-data InvalidRequest = NotEnoughLines [String]
-                    | BadFirstLine String
-                    | NonHttp
-                    | IncompleteHeaders
-                    | ConnectionClosedByPeer
-                    | OverLargeHeader
-                    | BadProxyHeader String
-                    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
@@ -45,10 +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 Exception InvalidRequest
+instance E.Exception InvalidRequest
 
 ----------------------------------------------------------------
 
@@ -58,11 +69,10 @@
 --
 -- Used to determine whether keeping the HTTP1.1 connection / HTTP2 stream alive is safe
 -- or irrecoverable.
-
-newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody SomeException
-    deriving (Show, Typeable)
+newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody E.SomeException
+    deriving (Show)
 
-instance Exception ExceptionInsideResponseBody
+instance E.Exception ExceptionInsideResponseBody
 
 ----------------------------------------------------------------
 
@@ -71,67 +81,76 @@
 --   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
 --
 -- Since: 3.1.0
 type SendFile = FileId -> Integer -> Integer -> IO () -> [ByteString] -> IO ()
 
--- | Type for read buffer pool
-type BufferPool = IORef ByteString
-
--- | Type for buffer
-type Buffer = Ptr Word8
-
--- | Type for buffer size
-type BufSize = Int
-
--- | Type for the action to receive input data
-type Recv = IO ByteString
+-- | A write buffer of a specified size
+-- containing bytes and a way to free the buffer.
+data WriteBuffer = WriteBuffer
+    { bufBuffer :: Buffer
+    , bufSize :: !BufSize
+    -- ^ 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 for the action to receive input data with a buffer.
---   The result boolean indicates whether or not the buffer is fully filled.
 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 ()
-    -- | Free any buffers allocated. Warp guarantees it will only be
-    -- called once, and no other functions will be called after it.
-    , connFree        :: IO ()
-    -- | The connection receiving function. This returns "" for EOF.
-    , connRecv        :: Recv
-    -- | The connection receiving function. This tries to fill the buffer.
-    --   This returns when the buffer is filled or reaches EOF.
-    , connRecvBuf     :: RecvBuf
-    -- | The write buffer.
-    , connWriteBuffer :: Buffer
-    -- | The size of the write buffer.
-    , connBufferSize  :: BufSize
+    , 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.
+    , 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 = readIORef . connHTTP2
+
+setConnHTTP2 :: Connection -> Bool -> IO ()
+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
+    }
 
 ----------------------------------------------------------------
 
@@ -157,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
@@ -165,14 +184,39 @@
 ----------------------------------------------------------------
 
 -- | 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
-                 }  -- ^ Encrypted channel: TLS or SSL
+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
+#endif
+        }
+    | QUIC
+        { quicNegotiatedProtocol :: Maybe ByteString
+        , quicChiperID :: Word16
+#ifdef MIN_VERSION_crypton_x509
+        , quicClientCertificate :: Maybe CertificateChain
+#endif
+        }
 
 isTransportSecure :: Transport -> Bool
 isTransportSecure TCP = False
-isTransportSecure _   = True
+isTransportSecure _ = True
+
+isTransportQUIC :: Transport -> Bool
+isTransportQUIC QUIC{} = True
+isTransportQUIC _ = False
+
+#ifdef MIN_VERSION_crypton_x509
+getTransportClientCertificate :: Transport -> Maybe CertificateChain
+getTransportClientCertificate TCP              = Nothing
+getTransportClientCertificate (TLS _ _ _ _ cc) = cc
+getTransportClientCertificate (QUIC _ _ cc)    = cc
+#endif
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,25 +1,28 @@
 {-# LANGUAGE CPP #-}
-module Network.Wai.Handler.Warp.Windows
-  ( windowsThreadBlockHack
-  ) where
 
+module Network.Wai.Handler.Warp.Windows (
+    windowsThreadBlockHack,
+) where
+
 #if WINDOWS
-import Control.Exception
 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
 --
 -- @since 3.2.17
 windowsThreadBlockHack :: IO a -> IO a
 windowsThreadBlockHack act = do
-    var <- newEmptyMVar :: IO (MVar (Either SomeException a))
-    void . forkIO $ try act >>= putMVar var
+    var <- newEmptyMVar :: IO (MVar (Either Control.Exception.SomeException a))
+    -- Catch and rethrow even async exceptions, so don't bother with UnliftIO
+    threadId <- forkIO $ Control.Exception.try act >>= putMVar var
+    labelThread threadId "Windows Thread Block Hack (warp)"
     res <- takeMVar var
     case res of
-      Left  e -> throwIO e
+      Left  e -> Control.Exception.throwIO e
       Right r -> return r
 #else
 windowsThreadBlockHack :: IO a -> IO a
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           Control.Concurrent.Async
-import           Control.Exception
-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 () -> throwIO $ ErrorCall "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 `catch` \ e -> do
-          when
-            (defaultShouldDisplayException e)
-            (throwTo callingThread e)
-          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 = 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 (throwIO, throw)
+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 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 == "" = throw 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 == "" = throw badmsg
-      | otherwise     = S.break (== 47) httpVer -- '/'
-    !hv | http /= "HTTP" = throw 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/BufferPoolSpec.hs b/test/BufferPoolSpec.hs
deleted file mode 100644
--- a/test/BufferPoolSpec.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-module BufferPoolSpec where
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Internal as B (ByteString(PS))
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Marshal.Utils (copyBytes)
-import Foreign.Ptr (plusPtr)
-
-import Test.Hspec (Spec, hspec, shouldBe, describe, it)
-
-import Network.Wai.Handler.Warp.Buffer
-    ( bufferSize
-    , newBufferPool
-    , withBufferPool
-    )
-import Network.Wai.Handler.Warp.Types (Buffer, BufSize)
-
-main :: IO ()
-main = hspec spec
-
--- Two ByteStrings each big enough to fill a 'bufferSize' buffer (16K).
-wantData, otherData :: B.ByteString
-wantData = B.replicate bufferSize 0xac
-otherData = B.replicate bufferSize 0x77
-
-spec :: Spec
-spec = describe "withBufferPool" $ do
-    it "does not clobber buffers" $ do
-        pool <- newBufferPool
-        -- 'pool' contains B.empty; prime it to contain a real buffer.
-        _ <- withBufferPool pool $ const $ return 0
-        -- 'pool' contains a 16K buffer; fill it with \xac and keep the result.
-        got <- withBufferPool pool $ blitBuffer wantData
-        got `shouldBe` wantData
-        -- 'pool' should now be empty and reallocate, rather than clobber the
-        -- previous buffer.
-        _ <- withBufferPool pool $ blitBuffer otherData
-        got `shouldBe` wantData
-
--- Fill the Buffer with the contents of the ByteString and return the number of
--- bytes written.  To be used with 'withBufferPool'.
-blitBuffer :: B.ByteString -> (Buffer, BufSize) -> IO Int
-blitBuffer (B.PS fp off len) (dst, len') = withForeignPtr fp $ \ptr -> do
-    let src = ptr `plusPtr` off
-        n = min len len'
-    copyBytes dst src n
-    return 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,25 +15,25 @@
 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"
+        ref <- newIORef "5\r\n12345\r\n3\r\n678\r\n0\r\n\r\nBLAH"
         src <- mkSource $ do
             x <- readIORef ref
             writeIORef ref S.empty
@@ -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 Control.Exception
-import qualified Data.Streaming.Network as N
-import Control.Concurrent.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
@@ -2,44 +2,131 @@
 
 module FileSpec (main, spec) where
 
+import Data.ByteString
+import Data.String (fromString)
 import Network.HTTP.Types
 import Network.Wai.Handler.Warp.File
 import Network.Wai.Handler.Warp.FileInfoCache
 import Network.Wai.Handler.Warp.Header
+import System.IO.Unsafe (unsafePerformIO)
 
 import Test.Hspec
 
 main :: IO ()
 main = hspec spec
 
-testFileRange :: String
-              -> RequestHeaders -> FilePath
-              -> RspFileInfo
-              -> Spec
-testFileRange desc reqhs file ans = it desc $ do
-    finfo <- getInfo file
-    let WithBody s hs off len = ans
-        hs' = ("Last-Modified",fileInfoDate finfo) : hs
-        ans' = WithBody s hs' off len
-    conditionalRequest finfo [] (indexRequestHeader reqhs) `shouldBe` ans'
+changeHeaders
+    :: (ResponseHeaders -> ResponseHeaders) -> RspFileInfo -> RspFileInfo
+changeHeaders f rfi =
+    case rfi of
+        WithBody s hs off len -> WithBody s (f hs) off len
+        other -> other
 
+getHeaders :: RspFileInfo -> ResponseHeaders
+getHeaders rfi =
+    case rfi of
+        WithBody _ hs _ _ -> hs
+        _ -> []
+
+testFileRange
+    :: String
+    -> RequestHeaders
+    -> RspFileInfo
+    -> Spec
+testFileRange desc reqhs ans = it desc $ do
+    finfo <- getInfo "attic/hex"
+    let f = (:) ("Last-Modified", fileInfoDate finfo)
+        hs = getHeaders ans
+        ans' = changeHeaders f ans
+    conditionalRequest
+        finfo
+        []
+        methodGet
+        (indexResponseHeader hs)
+        (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
+
+make206Body :: Integer -> Integer -> RspFileInfo
+make206Body 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"
+        )
+
 spec :: Spec
 spec = do
     describe "conditionalRequest" $ do
         testFileRange
             "gets a file size from file system"
-            [] "attic/hex"
-            $ WithBody ok200 [("Content-Length","16"),("Accept-Ranges","bytes")] 0 16
+            []
+            regularBody
         testFileRange
             "gets a file size from file system and handles Range and returns Partical Content"
-            [("Range","bytes=2-14")] "attic/hex"
-            $ WithBody status206 [("Content-Range","bytes 2-14/16"),("Content-Length","13"),("Accept-Ranges","bytes")] 2 13
+            [("Range", "bytes=2-14")]
+            $ make206Body 2 13
         testFileRange
             "truncates end point of range to file size"
-            [("Range","bytes=10-20")] "attic/hex"
-            $ WithBody status206 [("Content-Range","bytes 10-15/16"),("Content-Length","6"),("Accept-Ranges","bytes")] 10 6
+            [("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")] "attic/hex"
-            $ WithBody status200 [("Content-Length","16"),("Accept-Ranges","bytes")] 0 16
-
+            [("Range:", "bytes=0-15")]
+            regularBody
+        testFileRange
+            "returns a 412 if the file has been changed in the meantime"
+            [("If-Unmodified-Since", farPast)]
+            $ WithoutBody status412
+        testFileRange
+            "gets a file if the file has not been changed in the meantime"
+            [("If-Unmodified-Since", farFuture)]
+            regularBody
+        testFileRange
+            "ignores the If-Unmodified-Since header if an If-Match header is also present"
+            [("If-Match", "SomeETag"), ("If-Unmodified-Since", farPast)]
+            regularBody
+        testFileRange
+            "still gives only a range, even after conditionals"
+            [ ("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"
+            [("If-Modified-Since", farPast)]
+            regularBody
+        testFileRange
+            "returns a 304 if the file has not been changed in the meantime"
+            [("If-Modified-Since", farFuture)]
+            $ WithoutBody status304
+        testFileRange
+            "ignores the If-Modified-Since header if an If-None-Match header is also present"
+            [("If-None-Match", "SomeETag"), ("If-Modified-Since", farFuture)]
+            regularBody
+        testFileRange
+            "still gives only a range, even after conditionals"
+            [ ("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")
+            ]
+            $ 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")]
+            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,93 +1,117 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE StandaloneDeriving #-}
+{-# 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 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
 
+defaultMaxTotalHeaderLength :: Int
+defaultMaxTotalHeaderLength = settingsMaxTotalHeaderLength defaultSettings
+
 spec :: Spec
 spec = do
-  describe "headerLines" $ do
-    it "takes until blank" $
-        blankSafe >>= (`shouldBe` ("", ["foo", "bar", "baz"]))
-    it "ignored leading whitespace in bodies" $
-        whiteSafe >>= (`shouldBe` (" 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 nomarl case" $ do
-          src <- mkSourceFunc ["Status: 200\r\nContent-Type: text/plain\r\n\r\n"] >>= mkSource
-          x <- headerLines 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 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 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 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 True src
-          x `shouldBe` []
-          y <- headerLines 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"]
 
+        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"]
@@ -107,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 True src'
+    res <- headerLines defaultMaxTotalHeaderLength FirstRequest src'
     return (res, src')
 
 consumeLen :: Int -> Source -> IO S8.ByteString
@@ -126,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
@@ -139,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,12 +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.HTTP2.HPACK
-import Network.HPACK
-import Network.HPACK.Token
+import Network.Wai.Handler.Warp.Response
+import Network.Wai.Handler.Warp.ResponseHeader
 import Test.Hspec
 
 main :: IO ()
@@ -24,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
@@ -34,48 +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` []
-    describe "addHeader" $ do
-        it "adds Server if not exist" $ do
-            let v = "MyServer"
-                hdrs = []
-                hdrs1 = [("Server",v)]
-            (thl, vt) <- toHeaderTable hdrs
-            (thl1, _) <- toHeaderTable hdrs1
-            addHeader tokenServer v vt thl `shouldBe` thl1
-        it "does not add Server if exists" $ do
-            let v = "MyServer2"
-                hdrs = [("Server","MyServer")]
-            (thl, vt) <- toHeaderTable hdrs
-            addHeader tokenServer v vt thl `shouldBe` thl
-        it "does not add Server if empty" $ do
-            let v = ""
-                hdrs = []
-            (thl, vt) <- toHeaderTable hdrs
-            addHeader tokenServer v vt thl `shouldBe` thl
-        it "deletes Server" $ do
-            let v = ""
-                hdrs = [("Server","MyServer")]
-                hdrs1 = []
-            (thl, vt) <- toHeaderTable hdrs
-            (thl1, _) <- toHeaderTable hdrs1
-            addHeader tokenServer v vt thl `shouldBe` thl1
-        it "keeps Server" $ do
-            let v = ""
-                hdrs = [("Server","MyServer"),("Content-Type","Text/HTML")]
-            (thl, vt) <- toHeaderTable hdrs
-            addHeader tokenContentType v vt thl `shouldBe` thl
 
 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,25 +10,27 @@
 import Network.Wai hiding (responseHeaders)
 import Network.Wai.Handler.Warp
 import Network.Wai.Handler.Warp.Response
-import RunSpec (withApp, msClose, msWrite, msRead, connectTo)
+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 range out crange = it title $ withApp defaultSettings app $ \port -> do
-    handle <- connectTo port
-    msWrite handle "GET / HTTP/1.0\r\n"
-    msWrite handle "Range: bytes="
-    msWrite handle range
-    msWrite handle "\r\n\r\n"
+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="
+    msWrite ms range
+    msWrite ms "\r\n\r\n"
     threadDelay 10000
-    bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead handle 1024
-    msClose handle
+    bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024
     last bss `shouldBe` out
     let hs = mapMaybe toHeader bss
     lookup "Content-Range" hs `shouldBe` fmap ("bytes " ++) crange
@@ -38,20 +40,23 @@
     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 size offset count out = it title $ withApp defaultSettings app $ \port -> do
-    handle <- connectTo port
-    msWrite handle "GET / HTTP/1.0\r\n\r\n"
+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
-    bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead handle 1024
-    msClose handle
+    bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024
     out `shouldBe` last bss
     let hs = mapMaybe toHeader bss
     lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
@@ -61,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
@@ -87,7 +93,7 @@
         it "discards empty lines" $ do
             sanitizeHeaderValue "foo\r\n\r\nbar" `shouldBe` "foo\r\n bar"
 
-        context "when sanitizing single occurences of \n" $ do
+        context "when sanitizing single occurrences of \n" $ do
             it "replaces \n with \r\n" $ do
                 sanitizeHeaderValue "foo\n bar" `shouldBe` "foo\r\n bar"
 
diff --git a/test/RunSpec.hs b/test/RunSpec.hs
--- a/test/RunSpec.hs
+++ b/test/RunSpec.hs
@@ -1,13 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module RunSpec (main, spec, withApp, connectTo, MySocket, msWrite, msRead, msClose) where
+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 Control.Exception (IOException, bracket, onException, try)
 import qualified Control.Exception as E
-import Control.Exception.Lifted (bracket, try, IOException, onException)
 import Control.Monad (forM_, replicateM_, unless)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.ByteString (ByteString)
@@ -21,8 +21,7 @@
 import Network.Socket
 import Network.Socket.ByteString (sendAll)
 import Network.Wai hiding (responseHeaders)
-import Network.Wai.Internal (getRequestBodyChunk)
-import Network.Wai.Handler.Warp
+import Network.Wai.Handler.Warp hiding (Counter)
 import System.IO.Unsafe (unsafePerformIO)
 import System.Timeout (timeout)
 import Test.Hspec
@@ -36,49 +35,59 @@
 type CounterApplication = Counter -> Application
 
 data MySocket = MySocket
-  { msSocket :: !Socket
-  , _msBuffer :: !(I.IORef ByteString)
-  }
+    { msSocket :: !Socket
+    , msBuffer :: !(I.IORef ByteString)
+    }
 
 msWrite :: MySocket -> ByteString -> IO ()
-msWrite ms bs = sendAll (msSocket ms) bs
+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
 
 connectTo :: Int -> IO MySocket
-connectTo port = MySocket
-  <$> (fst <$> getSocketTCP "127.0.0.1" port)
-  <*> I.newIORef mempty
+connectTo port = do
+    s <- fst <$> getSocketTCP "127.0.0.1" port
+    ref <- I.newIORef mempty
+    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
@@ -88,18 +97,18 @@
     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)
-            | not $ requestMethod req `elem` ["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"
 
 ignoreBody :: CounterApplication
 ignoreBody icount req f = do
-    if (requestMethod req `elem` ["GET", "POST"])
+    if requestMethod req `elem` ["GET", "POST"]
         then incr icount
         else err icount ("Invalid request method" :: String, requestMethod req)
     f $ responseLBS status200 [] "Ignored the body"
@@ -129,29 +138,34 @@
 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) $ \port -> do
-        ms <- connectTo port
+    withApp defaultSettings (app ref) $ withMySocket $ \ms -> do
         forM_ chunks $ \chunk -> msWrite ms chunk
         _ <- timeout 100000 $ replicateM_ expected $ msRead ms 4096
         res <- I.readIORef ref
@@ -162,17 +176,17 @@
 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
-    withApp (setOnException onExc defaultSettings) dummyApp $ \port -> do
-        handle <- connectTo port
-        msWrite handle input
-        msClose handle
-        threadDelay 1000
+    withApp (setOnException onExc defaultSettings) dummyApp $ withMySocket $ \ms -> do
+        msWrite ms input
+        msClose ms -- explicitly
+        threadDelay 5000
         res <- I.readIORef ref
         show res `shouldBe` show (Just expected)
 
@@ -193,84 +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 $ concat
-            [ singleChunkedPostHello
-            , [singleGet]
-            ]
-        it "chunked body, ignore" $ runTest 2 ignoreBody $ concat
-            [ 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" $ runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n"
+        -- 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 $ \port -> do
-                handle <- connectTo port
-                let input = S.concat
-                        [ "GET / HTTP/1.1\r\nfoo:    bar\r\n baz\r\n\tbin\r\n\r\n"
-                        ]
-                msWrite handle input
-                msClose handle
-                threadDelay 1000
+            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 $ \port -> do
-                handle <- connectTo port
-                let input = S.concat
-                        [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
-                        ]
-                msWrite handle input
-                msClose handle
-                threadDelay 1000
+            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
@@ -278,102 +316,105 @@
             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 $ \port -> do
-                handle <- connectTo port
-                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 handle input
-                msClose handle
+            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"
+                            ]
+                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 $ \port -> do
-                handle <- connectTo port
-                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 handle) input
-                msClose handle
+            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"]
+                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 $ \port -> do
-                handle <- connectTo port
-                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 handle) $ map S.singleton $ S.unpack input
-                msClose handle
+            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"
+                            ]
+                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 $ \port -> do
+            withApp (setTimeout 1 defaultSettings) app $ withMySocket $ \ms -> do
                 let bs1 = S.replicate 2048 88
                     bs2 = "This is short"
                     bs = S.append bs1 bs2
-                handle <- connectTo port
-                msWrite handle "POST / HTTP/1.1\r\n"
-                msWrite handle "content-length: "
-                msWrite handle $ S8.pack $ show $ S.length bs
-                msWrite handle "\r\n\r\n"
+                msWrite ms "POST / HTTP/1.1\r\n"
+                msWrite ms "content-length: "
+                msWrite ms $ S8.pack $ show $ S.length bs
+                msWrite ms "\r\n\r\n"
                 threadDelay 100000
-                msWrite handle bs1
+                msWrite ms bs1
                 threadDelay 100000
-                msWrite handle bs2
-                msClose handle
+                msWrite ms bs2
                 threadDelay 5000000
                 front <- I.readIORef ifront
                 S.concat (front []) `shouldBe` bs
@@ -389,20 +430,24 @@
                                     loop
                         loop
                 doubleBS = S.concatMap $ \w -> S.pack [w, w]
-            withApp defaultSettings app $ \port -> do
-                ms <- connectTo port
+            withApp defaultSettings app $ withMySocket $ \ms -> do
                 msWrite ms "POST / HTTP/1.1\r\n\r\n12345"
-                timeout 100000 (msRead ms 10) >>= (`shouldBe` Just "1122334455")
+                timeout 100000 (msRead ms 10) `shouldReturn` Just "1122334455"
                 msWrite ms "67890"
-                timeout 100000 (msRead ms 10) >>= (`shouldBe` Just "6677889900")
+                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"]
@@ -411,22 +456,21 @@
     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
-        withApp defaultSettings app $ \port -> do
-            (sock, _addr) <- getSocketTCP "127.0.0.1" port
-            sendAll sock "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"
+                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
-            sendAll sock "5\r\nhello\r\n0\r\n\r\n"
+            msWrite ms "5\r\nhello\r\n0\r\n\r\n"
             atomically $ do
-              count <- readTVar countVar
-              check $ count >= 1
-            bs <- safeRecv sock 4096
+                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"
 
     it "streaming response with length" $ do
@@ -454,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]
@@ -469,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
@@ -20,40 +20,44 @@
 
 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,44 +2,45 @@
 
 module WithApplicationSpec where
 
-import           Control.Exception
-import           Network.HTTP.Types
-import           Network.Wai
-import           System.Environment
-import           System.Process
-import           Test.Hspec
+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 "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 -> throwIO $ ErrorCall "foo"
-      withApplication mkApp $ \ port -> do
-        output <- readProcess "curl" ["-s", "localhost:" ++ show port] ""
-        output `shouldContain` "Something went wron"
+    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"
 
-  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")
+        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"
 
-{- The future netwrok library will not export MkSocket.
-  describe "withFreePort" $ do
-    it "closes the socket before exiting" $ do
-      MkSocket _ _ _ _ statusMVar <- withFreePort $ \ (_, sock) -> do
-        return sock
-      readMVar statusMVar `shouldReturn` Closed
--}
+    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,274 +1,356 @@
-Name:                warp
-Version:             3.2.28
-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
 
-Library
-  Build-Depends:     base                      >= 4.8        && < 5
-                   , array
-                   , async
-                   , 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.11
-                   , http2                     >= 1.6      && < 1.7
-                   , iproute                   >= 1.3.1
-                   , simple-sendfile           >= 0.2.7    && < 0.3
-                   , stm                       >= 2.3
-                   , streaming-commons         >= 0.1.10
-                   , text
-                   , time-manager
-                   , unix-compat               >= 0.2
-                   , vault                     >= 0.3
-                   , wai                       >= 3.2      && < 3.3
-                   , word8
-  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.HTTP2
-                     Network.Wai.Handler.Warp.HTTP2.EncodeFrame
-                     Network.Wai.Handler.Warp.HTTP2.File
-                     Network.Wai.Handler.Warp.HTTP2.HPACK
-                     Network.Wai.Handler.Warp.HTTP2.Manager
-                     Network.Wai.Handler.Warp.HTTP2.Receiver
-                     Network.Wai.Handler.Warp.HTTP2.Request
-                     Network.Wai.Handler.Warp.HTTP2.Sender
-                     Network.Wai.Handler.Warp.HTTP2.Types
-                     Network.Wai.Handler.Warp.HTTP2.Worker
-                     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.Recv
-                     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 allow-sendfilefd
+    description: Allow use of sendfileFd (not available on GNU/kFreeBSD)
 
-  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
-  else
-      Build-Depends: unix
-      Other-modules: Network.Wai.Handler.Warp.MultiMap
-  if impl(ghc >= 8)
-      Default-Extensions:  Strict StrictData
-  Default-Language:     Haskell2010
+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
 
-Test-Suite doctest
-  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 warp-debug
+    description: print debug output. not suitable for production
+    default:     False
 
-Test-Suite spec
-    Main-Is:         Spec.hs
-    Other-modules:   BufferPoolSpec
-                     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.HTTP2
-                     Network.Wai.Handler.Warp.HTTP2.EncodeFrame
-                     Network.Wai.Handler.Warp.HTTP2.File
-                     Network.Wai.Handler.Warp.HTTP2.HPACK
-                     Network.Wai.Handler.Warp.HTTP2.Manager
-                     Network.Wai.Handler.Warp.HTTP2.Receiver
-                     Network.Wai.Handler.Warp.HTTP2.Request
-                     Network.Wai.Handler.Warp.HTTP2.Sender
-                     Network.Wai.Handler.Warp.HTTP2.Types
-                     Network.Wai.Handler.Warp.HTTP2.Worker
-                     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.Recv
-                     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
+flag x509
+    description:
+        Adds a dependency on the x509 library to enable getting TLS client certificates.
 
-    Hs-Source-Dirs:  test, .
-    Type:            exitcode-stdio-1.0
+library
+    exposed-modules:
+        Network.Wai.Handler.Warp
+        Network.Wai.Handler.Warp.Internal
 
-    Ghc-Options:     -Wall -threaded
-    Build-Depends:   base >= 4.8 && < 5
-                   , HUnit
-                   , QuickCheck
-                   , array
-                   , async
-                   , 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.8.5
-                   , http2                     >= 1.6      && < 1.7
-                   , iproute                   >= 1.3.1
-                   , lifted-base               >= 0.1
-                   , network
-                   , process
-                   , simple-sendfile           >= 0.2.4    && < 0.3
-                   , stm                       >= 2.3
-                   , streaming-commons         >= 0.1.10
-                   , text
-                   , time
-                   , time-manager
-                   , transformers              >= 0.2.2
-                   , unix-compat               >= 0.2
-                   , vault
-                   , wai                       >= 3.2      && < 3.3
-                   , word8
-    -- Build-Tool-Depends: hspec-discover:hspec-discover
-  if impl(ghc < 8)
-      Build-Depends: semigroups
+    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
 
-  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
-  if impl(ghc >= 8)
-      Default-Extensions:  Strict StrictData
-  Default-Language:     Haskell2010
+    if flag(include-warp-version)
+        other-modules: Paths_warp
 
-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
-                  , time-manager
-                  , unix-compat
-  if impl(ghc < 8)
-      Build-Depends: semigroups
+    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
 
-  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
-  if impl(ghc >= 8)
-      Default-Extensions:  Strict StrictData
-  Default-Language:     Haskell2010
+    if flag(x509)
+        build-depends: crypton-x509
 
-Source-Repository head
-  Type:     git
-  Location: git://github.com/yesodweb/wai.git
+    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
+
+    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