diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,9 +1,169 @@
 # ChangeLog for warp
 
+## 3.4.21
+
+Requires network 3.2.12.
+
+* `setUnsafeClose` closes connections with network's `unsafeClose` and
+  `unsafeGracefulClose`.  Off by default, since a `responseRaw`
+  application may leave threads on the socket.
+* The listening socket is closed with `unsafeClose` once the accept loop
+  has ended.
+* Sends use network's `sendAllWith` on every platform, so the timeout
+  reaches a send on Windows too.
+* An HTTP/2 connection which ends normally is no longer reported to
+  `settingsOnException` as http2's `ConnectionIsClosed`; the default
+  printed it for every such connection.
+
+## 3.4.20
+
+* Building with GHC 9.0 again.
+  [#1161](https://github.com/yesodweb/wai/issues/1161)
+
+## 3.4.19
+
+* Security: `Host` is validated.  A HTTP/1.1 request without one, and any
+  request with more than one, is refused: a router reading the first and an
+  application reading `requestHeaderHost` could disagree about which host a
+  request was for.
+  [#1152](https://github.com/yesodweb/wai/issues/1152)
+* Security: a `Range` which does not begin inside the file is answered 416,
+  rather than dropping the connection with no answer at all.
+  [#1153](https://github.com/yesodweb/wai/issues/1153)
+* Security: `packIntegral` counts its digits by division.  The `Double`
+  logarithm it used was one short from 10^15 up, and the last digit was
+  written before the buffer.
+  [#1154](https://github.com/yesodweb/wai/issues/1154)
+* Security: the HTTP/2 connection a GOAWAY for weak TLS ends is no longer
+  served afterwards, and that GOAWAY now follows the SETTINGS frame which
+  RFC 9113 has a server send first.
+  [#1155](https://github.com/yesodweb/wai/issues/1155)
+* Security: the HTTP/2 `response` continuation is not called a second time
+  when an application throws after its response has gone out.
+  [#1156](https://github.com/yesodweb/wai/issues/1156)
+* `InvalidRequest` gains `BadHost`.
+  [#1152](https://github.com/yesodweb/wai/issues/1152)
+* Validate field names with a lookup table.
+  [#1157](https://github.com/yesodweb/wai/issues/1157)
+
+## 3.4.18
+
+`Internal` gains `Listener (..)`, `noListener`, `makeListener`,
+`AcceptStopped (..)` and `runSettingsConnectionMakerSecureWith`.  Requires
+network 3.2.10, recv 0.1.3 and time-manager 0.5.
+
+* Event poll for accept loop.
+  [#1123](https://github.com/yesodweb/wai/pull/1123)
+* Give up on the accept and the receive rather than interrupt them.
+  [#1143](https://github.com/yesodweb/wai/pull/1143)
+* recv: a receive the caller can give up on.
+  [#1142](https://github.com/yesodweb/wai/pull/1142)
+* warp: let the thread manager own the connections.
+  [#1128](https://github.com/yesodweb/wai/pull/1128)
+
+## 3.4.17
+
+* Security: `Transfer-Encoding` is read as the comma separated list RFC 9112
+  defines, and a framing warp and a proxy could read differently is refused.
+  [#1147](https://github.com/yesodweb/wai/issues/1147)
+* Security: a `Content-Length` must be digits which fit in an `Int` and
+  repeated ones must agree.
+  [#1148](https://github.com/yesodweb/wai/issues/1148)
+* Security: a header field name must be a non-empty token, which also refuses
+  obs-fold continuation lines.
+  [#1149](https://github.com/yesodweb/wai/issues/1149)
+* Security: a bare CR or a NUL in a header field line is refused.
+  [#1151](https://github.com/yesodweb/wai/issues/1151)
+* Security: the chunked body parser keeps to RFC 9112: chunk sizes, the CRLF
+  after a chunk, size lines split over several reads, and the trailer section.
+  [#1150](https://github.com/yesodweb/wai/issues/1150)
+* warp: a chunked request body cut off mid-chunk reaches the application as
+  complete.
+  [#1129](https://github.com/yesodweb/wai/issues/1129)
+* `InvalidRequest` gains `UnsupportedTransferEncoding`, `AmbiguousBodyLength`,
+  `BadFieldName`, `BadHeaderLine` and `BadChunkedBody`, one for each of the
+  five above.
+* Allow time-manager 0.5.
+
+## 3.4.16
+
+* Graceful shutdown no longer stops while a connection it accepted is
+  unserved. The connection counter it waits on is now raised when the accept
+  loop accepts a connection rather than when the thread serving it is
+  scheduled, closing a window in which an accepted connection was invisible
+  to the shutdown.
+  [#1104](https://github.com/yesodweb/wai/pull/1104).
+* Slight performance increase by not blocking on receiving a request if the
+  socket already has bytes waiting. (using `receiveNoWait` from `recv-0.1.2`)
+  [#1107](https://github.com/yesodweb/wai/pull/1107).
+* Reviewed when to introduce memory barriers when handling `IORef`s.
+  Documented most usage and introduced memory barriers in situations that might
+  possibly be used in more than one thread.
+  [#1112](https://github.com/yesodweb/wai/pull/1112).
+* Add `setOnConnectionException` and `getOnConnectionException` to expose the
+  peer for exceptions escaping connection workers, including TLS setup failures
+  before a request exists. The existing exception observer remains the default.
+  [#1114](https://github.com/yesodweb/wai/pull/1114)
+  (fixes [#1113](https://github.com/yesodweb/wai/issues/1113))
+
+## 3.4.15
+
+* Support `103 Early Hints` over HTTP/2: the HTTP/2 handler installs
+  `requestSendEarlyHints`, so a WAI application can emit informational responses
+  ahead of the final response.
+  [#1085](https://github.com/yesodweb/wai/pull/1085).
+* Rework keep alive logic for HTTP/1.X so connections won't be automatically
+  closed on HEAD requests anymore. Should conform more to spec in general.
+  Should also reliably close connection when user created `Response` headers
+  contain a `Connection: close` entry (HTTP/1.1).
+  [#1086](https://github.com/yesodweb/wai/pull/1086)
+* Replace multiline header value support with sanitizing newlines and NUL bytes
+  with spaces. (as per RFC 9110 section 5.5)
+  [#1086](https://github.com/yesodweb/wai/pull/1086)
+* Size for responses in `Maybe Integer` argument of `settingsLogger` now
+  consistently and always gives amount of bytes of the sent raw __message body__.
+  It will only be `Nothing` when using `responseRaw` (mostly used for websockets)
+  [#1086](https://github.com/yesodweb/wai/pull/1086)
+    * `responseFile`: no change, gives size of file (part)
+    * `responseBuilder/responseLBS`:
+        * included the status and header lines, now fixed
+        * large `ByteString` chunks would not get counted, now fixed
+    * `responseStream`: now counts bytes of body sent
+    * `responseRaw`: will always be `Nothing`
+* Rework internal indexed headers to records for performance and to remove
+  dependencies on `array`.
+  [#1092](https://github.com/yesodweb/wai/pull/1092) [#1093](https://github.com/yesodweb/wai/pull/1093)
+
+## 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)
+  [#958](https://github.com/yesodweb/wai/pull/958)
 
 ## 3.4.11
 
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
@@ -52,6 +52,7 @@
     setPort,
     setHost,
     setOnException,
+    setOnConnectionException,
     setOnExceptionResponse,
     setOnOpen,
     setOnClose,
@@ -79,6 +80,7 @@
     setMaxTotalHeaderLength,
     setAltSvc,
     setMaxBuilderResponseBufferSize,
+    setUnsafeClose,
 
     -- ** Getters
     getPort,
@@ -86,12 +88,33 @@
     getOnOpen,
     getOnClose,
     getOnException,
+    getOnConnectionException,
     getGracefulShutdownTimeout,
     getGracefulCloseTimeout1,
     getGracefulCloseTimeout2,
     getOpenConnectionCounter,
+    getServerState,
+    getUnsafeClose,
 
+    -- ** 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,
@@ -173,24 +196,39 @@
 
 -- | Port to listen on. Default value: 3000
 --
--- Since 2.1.0
+-- @since 2.1.0
 setPort :: Port -> Settings -> Settings
 setPort x y = y{settingsPort = x}
 
 -- | Interface to bind to. Default value: HostIPv4
 --
--- Since 2.1.0
+-- @since 2.1.0
 setHost :: HostPreference -> Settings -> Settings
 setHost x y = y{settingsHost = x}
 
 -- | What to do with exceptions thrown by either the application or server.
 -- Default: 'defaultOnException'
 --
--- Since 2.1.0
+-- @since 2.1.0
 setOnException
     :: (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
 setOnException x y = y{settingsOnException = x}
 
+-- | Handle exceptions escaping a connection worker, with the address supplied
+-- by its connection source. This includes connection creation (such as a TLS
+-- handshake) and cleanup failures, even when no 'Request' exists. For socket
+-- listeners this is the accepted TCP peer, before any PROXY protocol rewriting.
+--
+-- When installed, this handler receives these exceptions instead of the
+-- handler configured with 'setOnException'. Request-specific exceptions and
+-- accept-loop failures still use that handler. By default, worker exceptions
+-- go to that handler too, with 'Nothing' as its @Maybe Request@ argument
+-- because no request context is available at this boundary.
+--
+-- @since 3.4.16
+setOnConnectionException :: (SockAddr -> SomeException -> IO ()) -> Settings -> Settings
+setOnConnectionException report settings = settings{settingsOnConnectionException = Just report}
+
 -- | A function to create a `Response` when an exception occurs.
 -- Default: 'defaultOnExceptionResponse'
 --
@@ -204,7 +242,7 @@
 -- > response500 :: Request -> SomeException -> Response
 -- > response500 req someEx = responseLBS status500 -- ...
 --
--- Since 2.1.0
+-- @since 2.1.0
 setOnExceptionResponse :: (SomeException -> Response) -> Settings -> Settings
 setOnExceptionResponse x y = y{settingsOnExceptionResponse = x}
 
@@ -212,13 +250,13 @@
 -- connection is closed immediately. Otherwise, the connection is going on.
 -- Default: always returns 'True'.
 --
--- Since 2.1.0
+-- @since 2.1.0
 setOnOpen :: (SockAddr -> IO Bool) -> Settings -> Settings
 setOnOpen x y = y{settingsOnOpen = x}
 
 -- | What to do when a connection is closed. Default: do nothing.
 --
--- Since 2.1.0
+-- @since 2.1.0
 setOnClose :: (SockAddr -> IO ()) -> Settings -> Settings
 setOnClose x y = y{settingsOnClose = x}
 
@@ -230,14 +268,14 @@
 --
 -- Default value: 30
 --
--- Since 2.1.0
+-- @since 2.1.0
 setTimeout :: Int -> Settings -> Settings
 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
+-- @since 2.1.0
 setManager :: Manager -> Settings -> Settings
 setManager x y = y{settingsManager = Just x}
 
@@ -253,7 +291,7 @@
 --
 -- Default value: 0, was previously 10
 --
--- Since 3.0.13
+-- @since 3.0.13
 setFdCacheDuration :: Int -> Settings -> Settings
 setFdCacheDuration x y = y{settingsFdCacheDuration = x}
 
@@ -277,7 +315,7 @@
 --
 -- Default: do nothing.
 --
--- Since 2.1.0
+-- @since 2.1.0
 setBeforeMainLoop :: IO () -> Settings -> Settings
 setBeforeMainLoop x y = y{settingsBeforeMainLoop = x}
 
@@ -287,19 +325,19 @@
 --
 -- Default: False
 --
--- Since 2.1.0
+-- @since 2.1.0
 setNoParsePath :: Bool -> Settings -> Settings
 setNoParsePath x y = y{settingsNoParsePath = x}
 
 -- | Get the listening port.
 --
--- Since 2.1.1
+-- @since 2.1.1
 getPort :: Settings -> Port
 getPort = settingsPort
 
 -- | Get the interface to bind to.
 --
--- Since 2.1.1
+-- @since 2.1.1
 getHost :: Settings -> HostPreference
 getHost = settingsHost
 
@@ -315,9 +353,18 @@
 getOnException :: Settings -> Maybe Request -> SomeException -> IO ()
 getOnException = settingsOnException
 
+-- | Get the handler installed with 'setOnConnectionException'.
+-- If none was installed, the returned function ignores the peer address and
+-- calls the handler configured with 'setOnException', passing 'Nothing' as
+-- its @Maybe Request@ argument and forwarding the exception.
+--
+-- @since 3.4.16
+getOnConnectionException :: Settings -> SockAddr -> SomeException -> IO ()
+getOnConnectionException = onConnectionException
+
 -- | Get the graceful shutdown timeout
 --
--- Since 3.2.8
+-- @since 3.2.8
 getGracefulShutdownTimeout :: Settings -> Maybe Int
 getGracefulShutdownTimeout = settingsGracefulShutdownTimeout
 
@@ -351,7 +398,7 @@
 --
 -- Default: does not install any code.
 --
--- Since 3.0.1
+-- @since 3.0.1
 setInstallShutdownHandler :: (IO () -> IO ()) -> Settings -> Settings
 setInstallShutdownHandler x y = y{settingsInstallShutdownHandler = x}
 
@@ -360,7 +407,7 @@
 --   If an empty string is set, the \"Server:\" header is not sent.
 --   This is true even if an application set one.
 --
--- Since 3.0.2
+-- @since 3.0.2
 setServerName :: ByteString -> Settings -> Settings
 setServerName x y = y{settingsServerName = x}
 
@@ -375,7 +422,7 @@
 --
 -- Default: 8192 bytes.
 --
--- Since 3.0.3
+-- @since 3.0.3
 setMaximumBodyFlush :: Maybe Int -> Settings -> Settings
 setMaximumBodyFlush x y
     | Just x' <- x, x' < 0 = error "setMaximumBodyFlush: must be positive"
@@ -388,7 +435,7 @@
 --
 -- Default: void . forkIOWithUnmask
 --
--- Since 3.0.4
+-- @since 3.0.4
 setFork
     :: (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> Settings -> Settings
 setFork fork' s = s{settingsFork = fork'}
@@ -400,13 +447,13 @@
 --
 -- Default: 'defaultAccept'
 --
--- Since 3.3.24
+-- @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
+-- @since 3.0.5
 setProxyProtocolNone :: Settings -> Settings
 setProxyProtocolNone y = y{settingsProxyProtocol = ProxyProtocolNone}
 
@@ -422,7 +469,7 @@
 -- Only the human-readable header format (version 1) is supported. The binary
 -- header format (version 2) is /not/ supported.
 --
--- Since 3.0.5
+-- @since 3.0.5
 setProxyProtocolRequired :: Settings -> Settings
 setProxyProtocolRequired y = y{settingsProxyProtocol = ProxyProtocolRequired}
 
@@ -438,25 +485,25 @@
 -- HTTP without the PROXY header, but proxied
 -- connections /do/ include the PROXY header.
 --
--- Since 3.0.5
+-- @since 3.0.5
 setProxyProtocolOptional :: Settings -> Settings
 setProxyProtocolOptional y = y{settingsProxyProtocol = ProxyProtocolOptional}
 
 -- | Size in bytes read to prevent Slowloris attacks. Default value: 2048
 --
--- Since 3.1.2
+-- @since 3.1.2
 setSlowlorisSize :: Int -> Settings -> Settings
 setSlowlorisSize x y = y{settingsSlowlorisSize = x}
 
 -- | Disable HTTP2.
 --
--- Since 3.1.7
+-- @since 3.1.7
 setHTTP2Disabled :: Settings -> Settings
 setHTTP2Disabled y = y{settingsHTTP2Enabled = False}
 
 -- | Setting a log function.
 --
--- Since 3.X.X
+-- @since 3.X.X
 setLogger
     :: (Request -> H.Status -> Maybe Integer -> IO ())
     -- ^ request, status, maybe file-size
@@ -482,7 +529,7 @@
 -- 'setInstallShutdownHandler' for an example of how this could be done in
 -- response to a UNIX signal.
 --
--- Since 3.2.8
+-- @since 3.2.8
 setGracefulShutdownTimeout
     :: Maybe Int
     -> Settings
@@ -491,7 +538,7 @@
 
 -- | Set the maximum header size that Warp will tolerate when using HTTP/1.x.
 --
--- Since 3.3.8
+-- @since 3.3.8
 setMaxTotalHeaderLength :: Int -> Settings -> Settings
 setMaxTotalHeaderLength maxTotalHeaderLength settings =
     settings
@@ -500,22 +547,30 @@
 
 -- | Setting the header value of Alternative Services (AltSvc:).
 --
--- Since 3.3.11
+-- @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
+-- @since 3.3.22
 setMaxBuilderResponseBufferSize :: Int -> Settings -> Settings
 setMaxBuilderResponseBufferSize maxRspBufSize settings = settings{settingsMaxBuilderResponseBufferSize = maxRspBufSize}
 
+-- | Close connections with network's 'unsafeClose' and
+--   'unsafeGracefulClose'.  See 'settingsUnsafeClose' for when it is safe.
+--   Default: 'False'.
+--
+-- @since 3.4.21
+setUnsafeClose :: Bool -> Settings -> Settings
+setUnsafeClose x y = y{settingsUnsafeClose = x}
+
 -- | Explicitly pause the slowloris timeout.
 --
 -- This is useful for cases where you partially consume a request body. For
 -- more information, see <https://github.com/yesodweb/wai/issues/351>
 --
--- Since 3.0.10
+-- @since 3.0.10
 pauseTimeout :: Request -> IO ()
 pauseTimeout = fromMaybe (return ()) . Vault.lookup pauseTimeoutKey . vault
 
@@ -534,7 +589,7 @@
 --   If this function is used an a Request generated by a WAI
 --   backend besides Warp, it also throws an 'IO' exception.
 --
--- Since 3.1.10
+-- @since 3.1.10
 getFileInfo :: Request -> FilePath -> IO FileInfo
 getFileInfo =
     fromMaybe (\_ -> throwIO (userError "getFileInfo"))
@@ -545,14 +600,14 @@
 --   FIN for HTTP/1.x. 0 means uses immediate close.
 --   Default: 0.
 --
--- Since 3.3.5
+-- @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
+-- @since 3.3.5
 getGracefulCloseTimeout1 :: Settings -> Int
 getGracefulCloseTimeout1 = settingsGracefulCloseTimeout1
 
@@ -560,14 +615,14 @@
 --   FIN for HTTP/2. 0 means uses immediate close.
 --   Default: 2000.
 --
--- Since 3.3.5
+-- @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
+-- @since 3.3.5
 getGracefulCloseTimeout2 :: Settings -> Int
 getGracefulCloseTimeout2 = settingsGracefulCloseTimeout2
 
@@ -576,14 +631,33 @@
 --
 -- See 'makeSettingsAndCounter' to create settings with a counter.
 --
--- Since 3.4.11
+-- /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
+
+-- | Whether connections are closed with network's 'unsafeClose' and
+--   'unsafeGracefulClose'.
+--
+-- @since 3.4.21
+getUnsafeClose :: Settings -> Bool
+getUnsafeClose = settingsUnsafeClose
+
 #ifdef MIN_VERSION_crypton_x509
 -- | Getting information of client certificate.
 --
--- Since 3.3.5
+-- @since 3.3.5
 clientCertificate :: Request -> Maybe CertificateChain
 clientCertificate = join . Vault.lookup getClientCertificateKey . vault
 #endif
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
@@ -5,7 +5,7 @@
 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 Data.Word8 (_0, _9, _A, _F, _a, _cr, _f, _lf, _semicolon)
 
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.Types
@@ -41,6 +41,10 @@
                 -- How many bytes will still remain to be sent downstream
                 count' = count - toSend
 
+            -- [WRITE_IOREF_NOTE]
+            -- This doesn't need to be "atomic", since it is only used in
+            -- 'recvRequest', which creates the 'Source' and doesn't fork it,
+            -- so the 'IORef' is not shared outside of 'recvRequest'.
             I.writeIORef ref count'
 
             if count' > 0
@@ -74,20 +78,40 @@
     ref <- I.newIORef NeedLen
     return $! CSource src ref
 
+-- | A chunk-size line is a few bytes of hex, and chunk extensions are
+--   all but unused; a trailer section is a handful of fields. Neither is
+--   a reason to hold on to everything a client cares to send.
+maxChunkLineLength :: Int
+maxChunkLineLength = 1024
+
+maxTrailerLength :: Int
+maxTrailerLength = 8192
+
 readCSource :: CSource -> IO ByteString
 readCSource (CSource src ref) = do
     mlen <- I.readIORef ref
     go mlen
   where
-    withLen 0 bs = do
-        leftoverSource src bs
-        dropCRLF
-        yield' S.empty DoneChunking
+    go NeedLen = getLen
+    go NeedLenNewline = dropCRLF >> getLen
+    go (HaveLen len) = readSource src >>= withLen len
+    go DoneChunking = return S.empty
+
+    getLen = do
+        len <- chunkSize =<< requireLine
+        if len == 0
+            then do
+                -- Everything up to the empty line which ends the trailer
+                -- section belongs to this request. Warp used to drop one
+                -- CRLF and leave the trailers in the source, where they
+                -- were read as the next request on the connection.
+                dropTrailers 0
+                yield' S.empty DoneChunking
+            else readSource src >>= withLen len
+
     withLen len bs
-        | S.null bs = do
-            -- FIXME should this throw an exception if len > 0?
-            I.writeIORef ref DoneChunking
-            return S.empty
+        -- The chunk promised more than the client went on to send.
+        | S.null bs = throwIO ConnectionClosedByPeer
         | otherwise =
             case S.length bs `compare` fromIntegral len of
                 EQ -> yield' bs NeedLenNewline
@@ -98,67 +122,78 @@
                     yield' x NeedLenNewline
 
     yield' bs mlen = do
-        I.writeIORef ref mlen
+        I.writeIORef ref mlen -- [WRITE_IOREF_NOTE]
         return bs
 
-    dropCRLF = do
-        bs <- readSource src
-        case S.uncons bs of
-            Nothing -> return ()
-            Just (w8, bs')
-                | w8 == _cr -> dropLF bs'
-                | w8 == _lf -> leftoverSource src bs'
-                | otherwise -> leftoverSource src bs
+    -- A chunk size is 1*HEXDIG, with nothing after it but chunk
+    -- extensions. Warp used to fold whatever hex digits it could find
+    -- and take 0 for the rest, so a line which is no chunk size at all
+    -- -- a request line, say -- ended the body and left the rest of it
+    -- to be read as the next request.
+    chunkSize line
+        | S.null digits = throwIO BadChunkedBody
+        | not (S.null ext), S.head ext /= _semicolon = throwIO BadChunkedBody
+        | otherwise =
+            maybe (throwIO BadChunkedBody) (return . fromIntegral) $
+                S.foldl' accumulate (Just (0 :: Int)) digits
+      where
+        (digits, ext) = S.span isHexDigit line
+        accumulate Nothing _ = Nothing
+        -- A chunk warp cannot measure is a chunk warp cannot read.
+        accumulate (Just n) w
+            | n > (maxBound - d) `div` 16 = Nothing
+            | otherwise = Just $! n * 16 + d
+          where
+            d = fromIntegral (hexToWord w)
 
-    dropLF bs =
-        case S.uncons bs of
-            Nothing -> do
-                bs2 <- readSource' src
-                unless (S.null bs2) $ dropLF bs2
-            Just (w8, bs') ->
-                leftoverSource src $
-                    if w8 == _lf then bs' else bs
+    -- The CRLF which ends chunk-data. Warp used to put anything else
+    -- back and read it as the next chunk size, so a chunk that was not
+    -- closed off ended the body early.
+    dropCRLF = do
+        line <- requireLine
+        unless (S.null line) $ throwIO BadChunkedBody
 
-    go NeedLen = getLen
-    go NeedLenNewline = dropCRLF >> getLen
-    go (HaveLen 0) = do
-        -- Drop the final CRLF
-        dropCRLF
-        I.writeIORef ref DoneChunking
-        return S.empty
-    go (HaveLen len) = do
-        bs <- readSource src
-        withLen len bs
-    go DoneChunking = return S.empty
+    dropTrailers total = do
+        mline <- readLine
+        case mline of
+            -- A client which leaves out the last CRLF and closes has
+            -- nothing left to hide behind it.
+            Nothing -> return ()
+            Just line -> unless (S.null line) $ do
+                let total' = total + S.length line
+                when (total' > maxTrailerLength) $ throwIO OverLargeHeader
+                dropTrailers total'
 
-    -- Get the length from the source, and then pass off control to withLen
-    getLen = do
-        bs <- readSource src
-        if S.null bs
-            then do
-                I.writeIORef ref $ assert False $ HaveLen 0
-                return S.empty
-            else do
-                (x, y) <-
-                    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 (== _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
+    requireLine = readLine >>= maybe (throwIO ConnectionClosedByPeer) return
 
-                let y' = S.drop 1 y
-                y'' <-
-                    if S.null y'
-                        then readSource src
-                        else return y'
-                withLen w y''
+    -- One line of the chunked framing: up to the next LF, without it or
+    -- the CR before it, leaving the rest of what was read in the source.
+    -- 'Nothing' when the connection ends where a line was to begin.
+    -- Warp used to give up one read short of the LF, which mis-read
+    -- every size line that arrived in more than two pieces.
+    readLine = loop 0 id
+      where
+        loop total front = do
+            bs <- readSource src
+            if S.null bs
+                then
+                    if total == 0
+                        then return Nothing
+                        else throwIO ConnectionClosedByPeer
+                else case S.elemIndex _lf bs of
+                    Nothing -> do
+                        let total' = total + S.length bs
+                        when (total' > maxChunkLineLength) $ throwIO OverLargeHeader
+                        loop total' (front . (bs :))
+                    Just ix -> do
+                        leftoverSource src $ S.drop (ix + 1) bs
+                        let line = S.concat $ front [S.take ix bs]
+                        when (S.length line > maxChunkLineLength) $
+                            throwIO OverLargeHeader
+                        return $ Just $ dropCR line
+        dropCR bs = case S.unsnoc bs of
+            Just (bs', w) | w == _cr -> bs'
+            _ -> bs
 
     hexToWord w
         | w <= _9 = w - _0
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,44 +1,80 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Network.Wai.Handler.Warp.Counter (
     Counter,
     newCounter,
+    HasDecreased (..),
     waitForZero,
-    increase,
-    decrease,
+    forkConnection,
     waitForDecreased,
     getCount,
+    getCountSTM,
+    threadManager,
 ) where
 
 import Control.Concurrent.STM
-
-import Network.Wai.Handler.Warp.Imports
+import System.ThreadManager (
+    ThreadManager,
+    countManaged,
+    forkManagedBy,
+    newThreadManager,
+    waitUntilAllGone,
+ )
 
-newtype Counter = Counter (TVar Int)
+-- | The connections of a server: how many there are, and which threads
+--   are serving them.
+--
+--   Both come from the 'ThreadManager', which counts a connection from
+--   when the accept loop keeps a place for it -- before the thread that
+--   will serve it has been scheduled, which is too late for a graceful
+--   shutdown to notice it.
+newtype Counter = Counter ThreadManager
 
 newCounter :: IO Counter
-newCounter = Counter <$> newTVarIO 0
+newCounter = Counter <$> newThreadManager
 
+-- | The manager owning the connections, for supervising them.
+threadManager :: Counter -> ThreadManager
+threadManager (Counter tm) = tm
+
 waitForZero :: Counter -> IO ()
-waitForZero (Counter var) = atomically $ do
-    x <- readTVar var
-    when (x > 0) retry
+waitForZero (Counter tm) = waitUntilAllGone tm
 
-waitForDecreased :: Counter -> IO ()
-waitForDecreased (Counter var) = do
-    n0 <- atomically $ readTVar var
-    atomically $ do
-        n <- readTVar var
-        check (n < n0)
+data HasDecreased = HasDecreased | NoConnections
+    deriving (Eq, Show)
 
-increase :: Counter -> IO ()
-increase (Counter var) = atomically $ modifyTVar' var $ \x -> x + 1
+waitForDecreased :: Counter -> IO HasDecreased
+waitForDecreased (Counter tm) = do
+    n0 <- atomically $ countManaged tm
+    if n0 <= 0
+        then pure NoConnections
+        else atomically $ do
+            n <- countManaged tm
+            check (n < n0)
+            pure HasDecreased
 
-decrease :: Counter -> IO ()
-decrease (Counter var) = atomically $ modifyTVar' var $ \x -> x - 1
+-- | Serving a connection on a thread made by the given fork.  The
+--   connection is counted from here rather than from when that thread
+--   starts: the accept loop does not wait for it, and a connection which
+--   has been accepted must not look to 'waitForZero' like one that is
+--   gone.
+forkConnection
+    :: Counter
+    -> (((forall x. IO x -> IO x) -> IO ()) -> IO ())
+    -- ^ The fork from the settings
+    -> ((forall x. IO x -> IO x) -> IO ())
+    -- ^ Serving the connection
+    -> IO ()
+forkConnection (Counter tm) fork io = forkManagedBy tm fork "Warp just forked" io
 
 -- | Get the current count of open connections.
 --
--- Since 3.4.11
+-- @since 3.4.11
 getCount :: Counter -> IO Int
-getCount (Counter var) = readTVarIO var
+getCount = atomically . getCountSTM
+
+-- | Get the current count in an 'STM' transaction.
+--
+-- @since 3.4.13
+getCountSTM :: Counter -> STM Int
+getCountSTM (Counter tm) = countManaged tm
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
@@ -46,12 +46,13 @@
 #ifdef WINDOWS
 withFdCache _ action = action getFdNothing
 #else
-withFdCache 0 action = action getFdNothing
-withFdCache duration action =
-    bracket
-        (initialize duration)
-        terminate
-        (action . getFd)
+withFdCache duration action
+    | duration <= 0 = action getFdNothing
+    | otherwise =
+        bracket
+            (initialize duration)
+            terminate
+            (action . getFd)
 
 ----------------------------------------------------------------
 
@@ -66,10 +67,10 @@
 newActiveStatus = MutableStatus <$> newIORef Active
 
 refresh :: MutableStatus -> Refresh
-refresh (MutableStatus ref) = writeIORef ref Active
+refresh (MutableStatus ref) = atomicWriteIORef ref Active
 
 inactive :: MutableStatus -> IO ()
-inactive (MutableStatus ref) = writeIORef ref Inactive
+inactive (MutableStatus ref) = atomicWriteIORef ref Inactive
 
 ----------------------------------------------------------------
 
@@ -146,13 +147,16 @@
 
 -- | Getting 'Fd' and 'Refresh' from the mutable Fd cacher.
 getFd :: MutableFdCache -> FilePath -> IO (Maybe Fd, Refresh)
-getFd mfc@(MutableFdCache reaper) path = look mfc path >>= get
+getFd mfc@(MutableFdCache reaper) path = do
+    mEnt <- look mfc path
+    entryToResult <$> get mEnt
   where
+    entryToResult (FdEntry fd mst) = (Just fd, refresh mst)
     get Nothing = do
-        ent@(FdEntry fd mst) <- newFdEntry path
+        ent <- newFdEntry path
         reaperAdd reaper (path, ent)
-        return (Just fd, refresh mst)
-    get (Just (FdEntry fd mst)) = do
+        pure ent
+    get (Just ent@(FdEntry _ mst)) = do
         refresh mst
-        return (Just fd, refresh mst)
+        pure ent
 #endif
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,5 +1,4 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.File (
@@ -9,17 +8,19 @@
     H.parseByteRanges,
 ) where
 
-import Data.Array ((!))
 import qualified Data.ByteString.Char8 as C8 (pack)
-import Network.HTTP.Date
+import Network.HTTP.Date (HTTPDate, parseHTTPDate)
 import qualified Network.HTTP.Types as H
-import qualified Network.HTTP.Types.Header as H
-import Network.Wai
+import qualified Network.HTTP.Types.Header as Header
+import Network.Wai (FilePart (..))
 
 import qualified Network.Wai.Handler.Warp.FileInfoCache as I
-import Network.Wai.Handler.Warp.Header
+import Network.Wai.Handler.Warp.Header (
+    IndexedRequestHeader (..),
+    ResponseHeaderPresence (..),
+ )
 import Network.Wai.Handler.Warp.Imports
-import Network.Wai.Handler.Warp.PackInt
+import Network.Wai.Handler.Warp.PackInt (packIntegral)
 
 ----------------------------------------------------------------
 
@@ -34,18 +35,16 @@
     :: I.FileInfo
     -> H.ResponseHeaders
     -> H.Method
-    -> IndexedHeader
-    -- ^ Response
-    -> IndexedHeader
-    -- ^ Request
+    -> ResponseHeaderPresence
+    -> IndexedRequestHeader
     -> RspFileInfo
 conditionalRequest finfo hs0 method rspidx reqidx = case condition of
     nobody@(WithoutBody _) -> nobody
     WithBody s _ off len ->
         let !hs1 = addContentHeaders hs0 off len size
-            !hs = case rspidx ! fromEnum ResLastModified of
-                Just _ -> hs1
-                Nothing -> (H.hLastModified, date) : hs1
+            !hs
+                | hasLastModified rspidx = hs1
+                | otherwise = (H.hLastModified, date) : hs1
          in WithBody s hs off len
   where
     !mtime = I.fileInfoTime finfo
@@ -72,57 +71,67 @@
 
 ----------------------------------------------------------------
 
-ifModifiedSince :: IndexedHeader -> Maybe HTTPDate
-ifModifiedSince reqidx = reqidx ! fromEnum ReqIfModifiedSince >>= parseHTTPDate
+ifModifiedSince :: IndexedRequestHeader -> Maybe HTTPDate
+ifModifiedSince reqidx = reqidxIfModifiedSince reqidx >>= parseHTTPDate
 
-ifUnmodifiedSince :: IndexedHeader -> Maybe HTTPDate
-ifUnmodifiedSince reqidx = reqidx ! fromEnum ReqIfUnmodifiedSince >>= parseHTTPDate
+ifUnmodifiedSince :: IndexedRequestHeader -> Maybe HTTPDate
+ifUnmodifiedSince reqidx = reqidxIfUnmodifiedSince reqidx >>= parseHTTPDate
 
-ifRange :: IndexedHeader -> Maybe HTTPDate
-ifRange reqidx = reqidx ! fromEnum ReqIfRange >>= parseHTTPDate
+ifRange :: IndexedRequestHeader -> Maybe HTTPDate
+ifRange reqidx = reqidxIfRange reqidx >>= parseHTTPDate
 
 ----------------------------------------------------------------
 
-ifmodified :: IndexedHeader -> HTTPDate -> H.Method -> Maybe RspFileInfo
+ifmodified
+    :: IndexedRequestHeader
+    -> HTTPDate
+    -> H.Method
+    -> Maybe RspFileInfo
 ifmodified reqidx mtime method = do
     date <- ifModifiedSince reqidx
     -- 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
+    guard . isNothing $ reqidxIfNoneMatch reqidx
     -- "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 -> HTTPDate -> Maybe RspFileInfo
+ifunmodified
+    :: IndexedRequestHeader -> HTTPDate -> Maybe RspFileInfo
 ifunmodified reqidx mtime = do
     date <- ifUnmodifiedSince reqidx
     -- 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 . isNothing $ reqidxIfMatch reqidx
     guard $ date /= mtime && date < mtime
     Just $ WithoutBody H.preconditionFailed412
 
 -- TODO: Should technically also strongly match on ETags.
-ifrange :: IndexedHeader -> HTTPDate -> H.Method -> Integer -> Maybe RspFileInfo
+ifrange
+    :: IndexedRequestHeader
+    -> 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
+    rng <- reqidxRange reqidx
     guard $ method == H.methodGet
     return $
         if date == mtime
             then parseRange rng size
             else WithBody H.ok200 [] 0 size
 
-unconditional :: IndexedHeader -> Integer -> RspFileInfo
+unconditional :: IndexedRequestHeader -> Integer -> RspFileInfo
 unconditional reqidx =
-    case reqidx ! fromEnum ReqRange of
+    case reqidxRange reqidx of
         Nothing -> WithBody H.ok200 [] 0
         Just rng -> parseRange rng
 
@@ -130,28 +139,35 @@
 
 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
+    Just (r : _) | Just (!beg, !end) <- checkRange r size ->
+        let !len = end - beg + 1
             s =
                 if beg == 0 && end == size - 1
                     then H.ok200
                     else H.partialContent206
          in WithBody s [] beg len
+    _ -> WithoutBody H.requestedRangeNotSatisfiable416
 
-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)
+-- | The first and last byte a range asks for, or 'Nothing' when it asks
+--   for nothing the file holds, which RFC 9110 section 14.4 answers with
+--   416.
+checkRange :: H.ByteRange -> Integer -> Maybe (Integer, Integer)
+checkRange (H.ByteRangeFrom beg) size
+    | beg < 0 || beg >= size = Nothing
+    | otherwise = Just (beg, size - 1)
+checkRange (H.ByteRangeFromTo beg end) size
+    | beg < 0 || beg > end || beg >= size = Nothing
+    | otherwise = Just (beg, min (size - 1) end)
+checkRange (H.ByteRangeSuffix count) size
+    | count <= 0 || size <= 0 = Nothing
+    | otherwise = Just (max 0 (size - count), size - 1)
 
 ----------------------------------------------------------------
 
 -- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'
 -- for the range specified.
 contentRangeHeader :: Integer -> Integer -> Integer -> H.Header
-contentRangeHeader beg end total = (H.hContentRange, range)
+contentRangeHeader beg end total = (Header.hContentRange, range)
   where
     range =
         C8.pack
@@ -183,7 +199,10 @@
          in ctrng : hs'
   where
     !lengthBS = packIntegral len
-    !hs' = (H.hContentLength, lengthBS) : (H.hAcceptRanges, "bytes") : hs
+    !hs' =
+        (Header.hContentLength, lengthBS)
+            : (Header.hAcceptRanges, "bytes")
+            : filter (\(h, _) -> h /= Header.hContentLength && h /= Header.hAcceptRanges) hs
 
 -- |
 --
diff --git a/Network/Wai/Handler/Warp/HTTP1.hs b/Network/Wai/Handler/Warp/HTTP1.hs
--- a/Network/Wai/Handler/Warp/HTTP1.hs
+++ b/Network/Wai/Handler/Warp/HTTP1.hs
@@ -181,7 +181,7 @@
     -> Source
     -> Request
     -> Maybe (IORef Int)
-    -> IndexedHeader
+    -> IndexedRequestHeader
     -> IO ByteString
     -> IO ReuseConnection
 processRequest settings ii conn app th istatus src req mremainingRef idxhdr nextBodyFlush = do
diff --git a/Network/Wai/Handler/Warp/HTTP2.hs b/Network/Wai/Handler/Warp/HTTP2.hs
--- a/Network/Wai/Handler/Warp/HTTP2.hs
+++ b/Network/Wai/Handler/Warp/HTTP2.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -13,6 +14,7 @@
 import Data.IORef (readIORef)
 import qualified Data.IORef as I
 import GHC.Conc.Sync (labelThread, myThreadId)
+import qualified Network.HTTP2.Client as H2C
 import qualified Network.HTTP2.Frame as H2
 import qualified Network.HTTP2.Server as H2
 import Network.Socket (SockAddr)
@@ -29,6 +31,14 @@
 import qualified Network.Wai.Handler.Warp.Settings as S
 import Network.Wai.Handler.Warp.Types
 
+-- Early Hints wiring needs both the http-semantics 'auxSendInformational' field
+-- (0.4.1) and the http2 sender support that actually emits it (5.4.2).
+#define HAS_EARLY_HINTS_SUPPORT (MIN_VERSION_http_semantics(0,4,1) && MIN_VERSION_http2(5,4,2))
+
+#if HAS_EARLY_HINTS_SUPPORT
+import qualified Network.HTTP.Types as H
+#endif
+
 ----------------------------------------------------------------
 
 http2
@@ -65,19 +75,32 @@
                 , H2.confPeerSockAddr = peersa
                 , H2.confReadNTimeout = True
                 }
-    checkTLS
+    ok <- checkTLS
     setConnHTTP2 conn True
-    H2.run H2.defaultServerConfig conf $
-        http2server "Warp HTTP/2" settings ii transport peersa app
+    when ok $
+        endedNormally $
+            H2.run H2.defaultServerConfig conf $
+                http2server "Warp HTTP/2" settings ii transport peersa app
   where
+    -- http2 ends a connection which has run its course with
+    -- 'ConnectionIsClosed', which is no exception to report.
+    endedNormally = E.handle $ \e -> case e of
+        H2C.ConnectionIsClosed -> return ()
+        _ -> E.throwIO e
+    -- A GOAWAY ends the connection, so there is nothing left to serve
+    -- on it.
     checkTLS = case transport of
-        TCP -> return () -- direct
-        tls -> unless (tls12orLater tls) $ goaway conn H2.InadequateSecurity "Weak TLS"
+        TCP -> return True -- direct
+        tls
+            | tls12orLater tls -> return True
+            | otherwise -> do
+                goaway conn H2.InadequateSecurity "Weak TLS"
+                return False
     tls12orLater tls = tlsMajorVersion tls == 3 && tlsMinorVersion tls >= 3
 
 -- | Converting WAI application to the server type of http2 library.
 --
--- Since 3.3.11
+-- @since 3.3.11
 http2server
     :: String
     -> S.Settings
@@ -89,7 +112,12 @@
 http2server label settings ii transport addr app h2req0 aux0 response = do
     tid <- myThreadId
     labelThread tid (label ++ " http2server " ++ show addr)
-    req <- toWAIRequest h2req0 aux0
+    req0 <- toWAIRequest h2req0 aux0
+#if HAS_EARLY_HINTS_SUPPORT
+    let req = req0{requestSendEarlyHints = H2.auxSendInformational aux0 (H.mkStatus 103 "Early Hints")}
+#else
+    let req = req0
+#endif
     ref <- I.newIORef Nothing
     eResponseReceived <- E.try $ app req $ \rsp -> do
         (h2rsp, st, hasBody) <- fromResponse settings ii req rsp
@@ -97,22 +125,31 @@
         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
+    msent <- I.readIORef ref
+    let logSent (h2rsp, pps, st) = do
             let msiz = fromIntegral <$> H2.responseBodySize h2rsp
             logResponse req st msiz
             mapM_ (logPushPromise req) pps
+    case eResponseReceived of
+        Right ResponseReceived -> case msent of
+            Just sent -> logSent sent
+            -- Reachable only through Network.Wai.Internal: the
+            -- application said it had answered without answering.
+            Nothing -> E.throwIO $ userError "no response from the application"
         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
+                case msent of
+                    -- The response has gone out, so this exception
+                    -- cannot replace it, which is what istatus keeps
+                    -- HTTP/1 from doing.
+                    Just sent -> logSent sent
+                    Nothing -> do
+                        let ersp = S.settingsOnExceptionResponse settings e
+                        (h2rsp, _, _) <- fromResponse settings ii req ersp
+                        _ <- response h2rsp []
+                        logSent (h2rsp, [], responseStatus ersp)
     return ()
   where
     toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th transport
@@ -150,9 +187,13 @@
     handler = throughAsync (return "")
 
 -- connClose must not be called here since Run:fork calls it
-goaway :: Connection -> H2.ErrorCodeId -> ByteString -> IO ()
-goaway Connection{..} etype debugmsg = connSendAll bytestream
+--
+-- The SETTINGS frame is this server's half of the connection preface,
+-- which RFC 9113 has it send before anything else, GOAWAY included.
+goaway :: Connection -> H2.ErrorCode -> ByteString -> IO ()
+goaway Connection{..} etype debugmsg = connSendAll $ preface <> bytestream
   where
     einfo = H2.encodeInfo id 0
+    preface = H2.encodeFrame einfo $ H2.SettingsFrame []
     frame = H2.GoAwayFrame 0 etype debugmsg
     bytestream = H2.encodeFrame einfo frame
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
@@ -15,7 +15,7 @@
 
 -- | 'PositionReadMaker' based on file descriptor cache.
 --
--- Since 3.3.13
+-- @since 3.3.13
 pReadMaker :: InternalInfo -> PositionReadMaker
 pReadMaker ii path = do
     (mfd, refresh) <- getFd ii path
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
@@ -85,24 +85,33 @@
             Nothing -> case mAuth of
                 Just auth -> (tokenHost, auth) : reqths
                 _ -> reqths
-    !mPath = getHeaderValue tokenPath reqvt -- SHOULD
-    !colonMethod = fromJust $ getHeaderValue tokenMethod reqvt -- MUST
-    !mAuth = getHeaderValue tokenAuthority reqvt -- SHOULD
-    !mHost = getHeaderValue tokenHost reqvt
-    !mRange = getHeaderValue tokenRange reqvt
-    !mReferer = getHeaderValue tokenReferer reqvt
-    !mUserAgent = getHeaderValue tokenUserAgent reqvt
+    !mPath = getFieldValue tokenPath reqvt -- SHOULD
+    !colonMethod = fromJust $ getFieldValue tokenMethod reqvt -- MUST
+    !mAuth = getFieldValue tokenAuthority reqvt -- SHOULD
+    !mHost = getFieldValue tokenHost reqvt
+    !mRange = getFieldValue tokenRange reqvt
+    !mReferer = getFieldValue tokenReferer reqvt
+    !mUserAgent = getFieldValue 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)
     !path = H.extractPath unparsedPath
     !rawPath = if S.settingsNoParsePath settings then unparsedPath else path
+    -- We use an "atomic" function here, because we can't influence when it
+    -- will be used.
+    modifyDataKey f = atomicModifyIORef' ref $ \mOldKey ->
+        let !mNewKey = f mOldKey
+         in (mNewKey, ())
     -- fixme: pauseTimeout. th is not available here.
-    !vaultValue =
+    -- Lazy on purpose (~ defeats -XStrict): most handlers never touch
+    -- 'vault', so don't pay for the inserts unless somebody looks.
+    ~vaultValue =
         Vault.insert getFileInfoKey (getFileInfo ii)
             . Vault.insert getHTTP2DataKey (readIORef ref)
-            . Vault.insert setHTTP2DataKey (writeIORef ref)
-            . Vault.insert modifyHTTP2DataKey (modifyIORef' ref)
+            -- We use 'atomicWriteIORef' here, because we don't expect it
+            -- to be used often, and it's use is out of our control.
+            . Vault.insert setHTTP2DataKey (atomicWriteIORef ref)
+            . Vault.insert modifyHTTP2DataKey modifyDataKey
             . Vault.insert pauseTimeoutKey (T.pause th)
 #ifdef MIN_VERSION_crypton_x509
             . Vault.insert getClientCertificateKey (getTransportClientCertificate transport)
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,122 +1,140 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Network.Wai.Handler.Warp.Header where
+module Network.Wai.Handler.Warp.Header (
+    IndexedRequestHeader (..),
+    ResponseHeaderPresence (..),
+    indexRequestHeader,
+    defaultIndexRequestHeader,
+    indexResponseHeader,
+) where
 
-import Data.Array
-import Data.Array.ST
 import qualified Data.ByteString as BS
 import Data.CaseInsensitive (foldedCase)
+import Data.List as L (foldl')
+import Data.Maybe (isJust)
 import Network.HTTP.Types
 
 import Network.Wai.Handler.Warp.Types
 
 ----------------------------------------------------------------
 
--- | Array for a set of HTTP headers.
-type IndexedHeader = Array Int (Maybe HeaderValue)
-
-----------------------------------------------------------------
-
-indexRequestHeader :: RequestHeaders -> IndexedHeader
-indexRequestHeader hdr = traverseHeader hdr requestMaxIndex requestKeyIndex
-
-data RequestHeaderIndex
-    = ReqContentLength
-    | ReqTransferEncoding
-    | ReqExpect
-    | ReqConnection
-    | ReqRange
-    | ReqHost
-    | ReqIfModifiedSince
-    | ReqIfUnmodifiedSince
-    | ReqIfRange
-    | ReqReferer
-    | ReqUserAgent
-    | ReqIfMatch
-    | ReqIfNoneMatch
-    deriving (Enum, Bounded)
-
--- | 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\"
--- - \"If-Range\"
--- - \"Referer\"
--- - \"User-Agent\"
--- - \"If-Match\"
--- - \"If-None-Match\"
-requestMaxIndex :: Int
-requestMaxIndex = fromEnum (maxBound :: RequestHeaderIndex)
+-- | Strict record of the request headers that Warp inspects,
+--   one field per header.
+data IndexedRequestHeader = IndexedRequestHeader
+    { reqidxContentLength :: Maybe HeaderValue
+    , reqidxTransferEncoding :: Maybe HeaderValue
+    , reqidxExpect :: Maybe HeaderValue
+    , reqidxConnection :: Maybe HeaderValue
+    , reqidxRange :: Maybe HeaderValue
+    , reqidxHost :: Maybe HeaderValue
+    , reqidxHostRepeated :: Bool
+    -- ^ Whether more than one @Host@ field line was sent.
+    , reqidxIfModifiedSince :: Maybe HeaderValue
+    , reqidxIfUnmodifiedSince :: Maybe HeaderValue
+    , reqidxIfRange :: Maybe HeaderValue
+    , reqidxReferer :: Maybe HeaderValue
+    , reqidxUserAgent :: Maybe HeaderValue
+    , reqidxIfMatch :: Maybe HeaderValue
+    , reqidxIfNoneMatch :: Maybe HeaderValue
+    }
 
-requestKeyIndex :: HeaderName -> Int
-requestKeyIndex hn = case BS.length bs of
-    4 | bs == "host" -> fromEnum ReqHost
-    5 | bs == "range" -> fromEnum ReqRange
-    6 | bs == "expect" -> fromEnum ReqExpect
-    7 | bs == "referer" -> fromEnum ReqReferer
-    8
-        | bs == "if-range" -> fromEnum ReqIfRange
-        | bs == "if-match" -> fromEnum ReqIfMatch
-    10
-        | bs == "user-agent" -> fromEnum ReqUserAgent
-        | bs == "connection" -> fromEnum ReqConnection
-    13 | bs == "if-none-match" -> fromEnum ReqIfNoneMatch
-    14 | bs == "content-length" -> fromEnum ReqContentLength
-    17
-        | bs == "transfer-encoding" -> fromEnum ReqTransferEncoding
-        | bs == "if-modified-since" -> fromEnum ReqIfModifiedSince
-    19 | bs == "if-unmodified-since" -> fromEnum ReqIfUnmodifiedSince
-    _ -> -1
+indexRequestHeader :: RequestHeaders -> IndexedRequestHeader
+indexRequestHeader = L.foldl' insert defaultIndexRequestHeader
   where
-    bs = foldedCase hn
+    insert ix (key, val) = case BS.length bs of
+        4
+            | bs == "host" ->
+                ix
+                    { reqidxHost = Just val
+                    , reqidxHostRepeated = isJust (reqidxHost ix)
+                    }
+        5 | bs == "range" -> ix{reqidxRange = Just val}
+        6 | bs == "expect" -> ix{reqidxExpect = Just val}
+        7 | bs == "referer" -> ix{reqidxReferer = Just val}
+        8
+            | bs == "if-range" -> ix{reqidxIfRange = Just val}
+            | bs == "if-match" -> ix{reqidxIfMatch = Just val}
+        10
+            | bs == "user-agent" -> ix{reqidxUserAgent = Just val}
+            | bs == "connection" -> ix{reqidxConnection = Just val}
+        13 | bs == "if-none-match" -> ix{reqidxIfNoneMatch = Just val}
+        14
+            | bs == "content-length" ->
+                ix{reqidxContentLength = appendField (reqidxContentLength ix) val}
+        17
+            | bs == "transfer-encoding" ->
+                ix{reqidxTransferEncoding = appendField (reqidxTransferEncoding ix) val}
+            | bs == "if-modified-since" -> ix{reqidxIfModifiedSince = Just val}
+        19 | bs == "if-unmodified-since" -> ix{reqidxIfUnmodifiedSince = Just val}
+        _ -> ix
+      where
+        bs = foldedCase key
+        -- RFC 9112: repeated field lines are one comma separated list, so
+        -- keep them all. Taking the last line alone would let a second
+        -- Content-Length hide the length of the first, or a second
+        -- Transfer-Encoding its chunked coding.
+        appendField Nothing val' = Just val'
+        appendField (Just prev) val' = Just $ prev <> "," <> val'
 
-defaultIndexRequestHeader :: IndexedHeader
-defaultIndexRequestHeader = array (0, requestMaxIndex) [(i, Nothing) | i <- [0 .. requestMaxIndex]]
+-- | 'IndexedRequestHeader' with no headers set.
+defaultIndexRequestHeader :: IndexedRequestHeader
+defaultIndexRequestHeader =
+    IndexedRequestHeader
+        { reqidxContentLength = Nothing
+        , reqidxTransferEncoding = Nothing
+        , reqidxExpect = Nothing
+        , reqidxConnection = Nothing
+        , reqidxRange = Nothing
+        , reqidxHost = Nothing
+        , reqidxHostRepeated = False
+        , reqidxIfModifiedSince = Nothing
+        , reqidxIfUnmodifiedSince = Nothing
+        , reqidxIfRange = Nothing
+        , reqidxReferer = Nothing
+        , reqidxUserAgent = Nothing
+        , reqidxIfMatch = Nothing
+        , reqidxIfNoneMatch = Nothing
+        }
 
 ----------------------------------------------------------------
 
-indexResponseHeader :: ResponseHeaders -> IndexedHeader
-indexResponseHeader hdr = traverseHeader hdr responseMaxIndex responseKeyIndex
-
-data ResponseHeaderIndex
-    = ResContentLength
-    | ResServer
-    | ResDate
-    | ResLastModified
-    deriving (Enum, Bounded)
-
--- | The size for 'IndexedHeader' for HTTP Response.
-responseMaxIndex :: Int
-responseMaxIndex = fromEnum (maxBound :: ResponseHeaderIndex)
-
-responseKeyIndex :: HeaderName -> Int
-responseKeyIndex hn = case BS.length bs of
-    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
-
-----------------------------------------------------------------
+-- | Presence of the response headers Warp itself consults.
+--   Only these four headers are ever looked up on the response side, and
+--   only their presence, never their value, so a flat record of strict
+--   'Bool's built in a single traversal beats a boxed array.
+data ResponseHeaderPresence = ResponseHeaderPresence
+    { hasContentLength :: Bool
+    , hasServer :: Bool
+    , hasDate :: Bool
+    , hasLastModified :: Bool
+    , hasTransferEncoding :: Maybe HeaderValue
+    , hasConnection :: Maybe HeaderValue
+    }
 
-traverseHeader :: [Header] -> Int -> (HeaderName -> Int) -> IndexedHeader
-traverseHeader hdr maxidx getIndex = runSTArray $ do
-    arr <- newArray (0, maxidx) Nothing
-    mapM_ (insert arr) hdr
-    return arr
+indexResponseHeader :: ResponseHeaders -> ResponseHeaderPresence
+indexResponseHeader = go emptyResponseHeaderPresence
   where
-    insert arr (key, val)
-        | idx == -1 = return ()
-        | otherwise = writeArray arr idx (Just val)
+    go ix [] = ix
+    go ix (tup : rest) = go (insert ix tup) rest
+    insert ix (key, val) = case BS.length bs of
+        4 | bs == "date" -> ix{hasDate = True}
+        6 | bs == "server" -> ix{hasServer = True}
+        10 | bs == "connection" -> ix{hasConnection = Just val}
+        13 | bs == "last-modified" -> ix{hasLastModified = True}
+        14 | bs == "content-length" -> ix{hasContentLength = True}
+        17 | bs == "transfer-encoding" -> ix{hasTransferEncoding = Just val}
+        _ -> ix
       where
-        idx = getIndex key
+        bs = foldedCase key
+
+emptyResponseHeaderPresence :: ResponseHeaderPresence
+emptyResponseHeaderPresence =
+    ResponseHeaderPresence
+        { hasContentLength = False
+        , hasServer = False
+        , hasDate = False
+        , hasLastModified = False
+        , hasTransferEncoding = Nothing
+        , hasConnection = Nothing
+        }
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,26 +1,51 @@
 module Network.Wai.Handler.Warp.IO where
 
 import Control.Exception (mask_)
+import qualified Data.ByteString as B (length)
 import Data.ByteString.Builder (Builder)
 import Data.ByteString.Builder.Extra (Next (Chunk, Done, More), runBuilder)
 import Data.IORef (IORef, readIORef, writeIORef)
+import Foreign.Ptr (plusPtr)
 import Network.Wai.Handler.Warp.Buffer
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.Types
 
 toBufIOWith
     :: Int -> IORef WriteBuffer -> (ByteString -> IO ()) -> Builder -> IO Integer
-toBufIOWith maxRspBufSize writeBufferRef io builder = do
+toBufIOWith = unsafeToBufIOWithOffset 0
+
+-- | Like 'toBufIOWith' but the first @offset@ bytes of the write buffer
+-- are assumed to be already filled (e.g. with a response header composed
+-- directly into the buffer). They are flushed together with the first
+-- batch of builder output and included in the returned total.
+--
+-- === WARNING: @offset@ MUST NOT exceed the current buffer size!!!
+--
+-- This function performs NO bounds checking on @offset@. The builder is
+-- handed the pointer @buffer + offset@ with @bufSize - offset@ bytes of
+-- claimed free space, so an oversized @offset@ points past the end of the
+-- allocation and advertises negative capacity, i.e. out-of-bounds writes
+-- and memory corruption. Every caller MUST verify
+-- @offset < bufSize@ of the current write buffer first (see the
+-- @hdrLen@ check in 'Network.Wai.Handler.Warp.Response.sendRsp').
+unsafeToBufIOWithOffset
+    :: Int
+    -> Int
+    -> IORef WriteBuffer
+    -> (ByteString -> IO ())
+    -> Builder
+    -> IO Integer
+unsafeToBufIOWithOffset offset0 maxRspBufSize writeBufferRef io builder = do
     writeBuffer <- readIORef writeBufferRef
-    loop writeBuffer firstWriter 0
+    loop writeBuffer offset0 firstWriter 0
   where
     firstWriter = runBuilder builder
-    loop writeBuffer writer bytesSent = do
+    loop writeBuffer offset writer bytesSent = do
         let buf = bufBuffer writeBuffer
             size = bufSize writeBuffer
-        (len, signal) <- writer buf size
-        bufferIO buf len io
-        let totalBytesSent = toInteger len + bytesSent
+        (len, signal) <- writer (buf `plusPtr` offset) (size - offset)
+        bufferIO buf (offset + len) io
+        let totalBytesSent = toInteger (offset + len) + bytesSent
         case signal of
             Done -> return totalBytesSent
             More minSize next
@@ -41,10 +66,15 @@
                     biggerWriteBuffer <- mask_ $ do
                         bufFree writeBuffer
                         biggerWriteBuffer <- createWriteBuffer minSize
+                        -- This doesn't need to be "atomic", since these two
+                        -- functions are only used in 'sendResponse', which is
+                        -- ultimately only used in 'serveConnection', which does
+                        -- not share nor fork the created 'Connection'.
                         writeIORef writeBufferRef biggerWriteBuffer
                         return biggerWriteBuffer
-                    loop biggerWriteBuffer next totalBytesSent
-                | otherwise -> loop writeBuffer next totalBytesSent
+                    loop biggerWriteBuffer 0 next totalBytesSent
+                | otherwise -> loop writeBuffer 0 next totalBytesSent
             Chunk bs next -> do
                 io bs
-                loop writeBuffer next totalBytesSent
+                loop writeBuffer 0 next $
+                    totalBytesSent + fromIntegral (B.length bs)
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,27 +1,50 @@
 {-# 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 (..),
     makeSettingsAndCounter,
+    makeSettingsAndServerState,
 
-    -- * Connection counter
+    -- ** Connection counter
     Counter,
     getCount,
 
+    -- ** Server state
+    ServerState,
+    makeServerState,
+
     -- * Low level run functions
     runSettingsConnection,
     runSettingsConnectionMaker,
     runSettingsConnectionMakerSecure,
+    runSettingsConnectionMakerSecureWith,
     Transport (..),
 
+    -- ** Stopping the accept loop
+    Listener (..),
+    noListener,
+    makeListener,
+    AcceptStopped (..),
+
     -- * Connection
     Connection (..),
     socketConnection,
 
     -- ** Receive
     Recv,
+    makeGracefulRecv,
     RecvBuf,
 
     -- ** Buffer
@@ -43,10 +66,20 @@
     warpVersion,
 
     -- * Data types
+
+    -- |
+    --
+    -- The internals of 'IndexedHeader' have changed since @3.4.15@, so we
+    -- keep exporting it as a type synonym, but it is now a record instead of
+    -- an array.
+    -- As such there's no more 'requestMaxIndex', but we provide a blank
+    -- 'defaultIndexRequestHeader'.
     InternalInfo (..),
     HeaderValue,
     IndexedHeader,
-    requestMaxIndex,
+    -- I assume 'requestMaxIndex' was used in case anyone wanted to create
+    -- an empty array, so we replace it with 'defaultIndexRequestHeader'.
+    defaultIndexRequestHeader,
 
     -- * Time out manager
 
@@ -113,3 +146,5 @@
 import Network.Wai.Handler.Warp.Settings
 import Network.Wai.Handler.Warp.Types
 import Network.Wai.Handler.Warp.Windows
+
+type IndexedHeader = IndexedRequestHeader
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
@@ -16,8 +16,10 @@
 packIntegral n | n < 0 = error "packIntegral"
 packIntegral n = unsafeCreate len go0
   where
-    n' = fromIntegral n + 1 :: Double
-    len = ceiling $ logBase 10 n'
+    -- Counted by division: @ceiling (logBase 10 ...)@ in a 'Double' is
+    -- one short from 10^15 up, and 'go' then writes its last digit
+    -- before the buffer it was given.
+    !len = numDigits n
     go0 p = go n $ p `plusPtr` (len - 1)
     go :: Integral a => a -> Ptr Word8 -> IO ()
     go i p = do
@@ -26,6 +28,16 @@
         when (d /= 0) $ go d (p `plusPtr` (-1))
 {-# SPECIALIZE packIntegral :: Int -> ByteString #-}
 {-# SPECIALIZE packIntegral :: Integer -> ByteString #-}
+
+-- | How many digits a non-negative number is written with.
+numDigits :: Integral a => a -> Int
+numDigits = go 1
+  where
+    go !acc i = case i `quot` 10 of
+        0 -> acc
+        q -> go (acc + 1) q
+{-# SPECIALIZE numDigits :: Int -> Int #-}
+{-# SPECIALIZE numDigits :: Integer -> Int #-}
 
 -- |
 --
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,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
@@ -16,14 +15,12 @@
 ) where
 
 import qualified Control.Concurrent as Conc (yield)
-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)
+import Data.Word8 (_0, _comma, _cr, _lf, _space, _tab, isDigit)
 #ifdef MIN_VERSION_crypton_x509
 import Data.X509
 #endif
@@ -41,7 +38,6 @@
 import Network.Wai.Handler.Warp.FileInfoCache
 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.RequestHeader
 import Network.Wai.Handler.Warp.Settings (
     Settings,
@@ -70,7 +66,7 @@
     -> IO
         ( Request
         , Maybe (I.IORef Int)
-        , IndexedHeader
+        , IndexedRequestHeader
         , IO ByteString
         )
     -- ^
@@ -83,15 +79,18 @@
     (method, unparsedPath, path, query, httpversion, hdr) <-
         parseHeaderLines hdrlines
     let idxhdr = indexRequestHeader hdr
-        expect = idxhdr ! fromEnum ReqExpect
+        expect = reqidxExpect idxhdr
         handle100Continue = handleExpect conn httpversion expect
+    checkHost httpversion idxhdr
     (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 rawPath = if settingsNoParsePath settings then unparsedPath else path
-        vaultValue =
+        -- Lazy on purpose (~ defeats -XStrict): most handlers never touch
+        -- 'vault', so don't pay for the inserts unless somebody looks.
+        ~vaultValue =
             Vault.insert pauseTimeoutKey (Timeout.pause th)
                 . Vault.insert getFileInfoKey (getFileInfo ii)
 #ifdef MIN_VERSION_crypton_x509
@@ -112,10 +111,11 @@
                 , requestBody = rbody'
                 , vault = vaultValue
                 , requestBodyLength = bodyLength
-                , requestHeaderHost = idxhdr ! fromEnum ReqHost
-                , requestHeaderRange = idxhdr ! fromEnum ReqRange
-                , requestHeaderReferer = idxhdr ! fromEnum ReqReferer
-                , requestHeaderUserAgent = idxhdr ! fromEnum ReqUserAgent
+                , requestHeaderHost = reqidxHost idxhdr
+                , requestHeaderRange = reqidxRange idxhdr
+                , requestHeaderReferer = reqidxReferer idxhdr
+                , requestHeaderUserAgent = reqidxUserAgent idxhdr
+                , requestSendEarlyHints = \_ -> pure ()
                 }
     return (req, remainingRef, idxhdr, rbodyFlush)
 
@@ -136,11 +136,24 @@
         else push maxTotalHeaderLength src (THStatus 0 0 id id) bs
 
 data NoKeepAliveRequest = NoKeepAliveRequest
-    deriving (Show, Typeable)
+    deriving (Show)
 instance Exception NoKeepAliveRequest
 
 ----------------------------------------------------------------
 
+-- | Refusing a request whose @Host@ RFC 9112 section 3.2 refuses.
+--
+-- A proxy routes on the first @Host@ and an application reads
+-- 'requestHeaderHost', the last of them: a repeated one is a way to
+-- reach a virtual host the proxy would not have routed to.
+checkHost :: H.HttpVersion -> IndexedRequestHeader -> IO ()
+checkHost httpversion idxhdr
+    | reqidxHostRepeated idxhdr = throwIO BadHost
+    | httpversion >= H.http11, isNothing (reqidxHost idxhdr) = throwIO BadHost
+    | otherwise = return ()
+
+----------------------------------------------------------------
+
 handleExpect
     :: Connection
     -> H.HttpVersion
@@ -159,32 +172,87 @@
 
 bodyAndSource
     :: Source
-    -> IndexedHeader
+    -> IndexedRequestHeader
     -> 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)
+bodyAndSource src idxhdr = do
+    framing <- bodyFraming idxhdr
+    case framing of
+        FramedByChunks -> do
+            csrc <- mkCSource src
+            return (readCSource csrc, Nothing, ChunkedBody)
+        FramedByLength len -> do
+            isrc@(ISource _ remaining) <- mkISource src len
+            return (readISource isrc, Just remaining, KnownLength $ fromIntegral len)
+
+-- | How the end of the request body is found (RFC 9112, section 6).
+data BodyFraming
+    = FramedByChunks
+    | FramedByLength Int
+
+-- | Deciding how the request body is framed, or refusing the request.
+--
+-- Anything other than one framing this server and every intermediary
+-- agree on is refused rather than read some way of warp's own: whoever
+-- reads it the other way sees one request where warp sees two, which is
+-- how a request is smuggled past a proxy.
+bodyFraming :: IndexedRequestHeader -> IO BodyFraming
+bodyFraming idxhdr = case reqidxTransferEncoding idxhdr of
+    Nothing -> FramedByLength <$> contentLength (reqidxContentLength idxhdr)
+    -- Transfer-Encoding wins over Content-Length, so sending both is a
+    -- way of showing each reader the framing it prefers. Take neither.
+    Just _ | isJust (reqidxContentLength idxhdr) -> throwIO AmbiguousBodyLength
+    Just te -> case reverse $ codings te of
+        -- The only coding warp implements, and the only one it can be
+        -- sure an intermediary passed on undisturbed.
+        ["chunked"] -> return FramedByChunks
+        -- Chunked frames the body, but warp decodes no coding under it.
+        "chunked" : _ -> throwIO UnsupportedTransferEncoding
+        -- Without chunked last, the length cannot be determined at all.
+        _ -> throwIO AmbiguousBodyLength
   where
-    chunked = isChunked $ idxhdr ! fromEnum ReqTransferEncoding
+    -- A comma separated list, each element allowed its own surrounding
+    -- whitespace. RFC 9110 has a recipient ignore empty elements, so
+    -- "chunked", " chunked" and "chunked," are each the one coding.
+    codings =
+        filter (not . S.null) . map (CI.foldCase . stripOWS) . S.split _comma
 
-toLength :: Maybe HeaderValue -> Int
-toLength Nothing = 0
-toLength (Just bs) = readInt bs
+-- | The length a Content-Length gives, or no body when there is none.
+--
+-- RFC 9112 asks for a value of nothing but digits, and for repeated
+-- Content-Lengths to be refused unless every one of them says the same
+-- thing. Warp used to read the leading digits and take 0 for the rest,
+-- so "abc", a value too large for an 'Int', and a second Content-Length
+-- hiding the first all became a request with no body at all -- and the
+-- bytes that were the body became the next request on the connection.
+contentLength :: Maybe HeaderValue -> IO Int
+contentLength Nothing = return 0
+contentLength (Just bs) = case map (readLength . stripOWS) $ S.split _comma bs of
+    Just len : lens | all (== Just len) lens -> return len
+    _ -> throwIO AmbiguousBodyLength
+  where
+    readLength v
+        | S.null v || not (S.all isDigit v) = Nothing
+        | otherwise = S.foldl' accumulate (Just 0) v
+    accumulate Nothing _ = Nothing
+    accumulate (Just n) w
+        -- A length warp cannot hold is a length warp cannot enforce.
+        | n > (maxBound - d) `div` 10 = Nothing
+        | otherwise = Just $! n * 10 + d
+      where
+        d = fromIntegral (w - _0)
 
-isChunked :: Maybe HeaderValue -> Bool
-isChunked (Just bs) = CI.foldCase bs == "chunked"
-isChunked _ = False
+-- | Optional whitespace, which RFC 9112 allows around the elements of a
+--   list and gives no meaning to.
+stripOWS :: ByteString -> ByteString
+stripOWS = fst . S.spanEnd isOWS . S.dropWhile isOWS
 
+isOWS :: Word8 -> Bool
+isOWS w = w == _space || w == _tab
+
 ----------------------------------------------------------------
 
 timeoutBody
@@ -218,6 +286,10 @@
             -- headers. Now we need to resume it to avoid a slowloris
             -- attack during request body sending.
             Timeout.resume timeoutHandle
+            -- This doesn't need to be "atomic", since this is only used in
+            -- 'recvRequest' to create the 'requestBody' function. And getting
+            -- chunks of the request in a concurrent setting is asking for
+            -- trouble anyway.
             I.writeIORef isFirstRef False
 
         bs <- rbody
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
@@ -7,6 +7,7 @@
 import Control.Exception (throwIO)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as C8 (unpack)
+import qualified Data.ByteString.Unsafe as SU
 import Data.ByteString.Internal (memchr)
 import qualified Data.CaseInsensitive as CI
 import Data.Word8
@@ -37,7 +38,7 @@
 parseHeaderLines (firstLine : otherLines) = do
     (method, path', query, httpversion) <- parseRequestLine firstLine
     let path = H.extractPath path'
-        hdr = map parseHeader otherLines
+    hdr <- mapM parseHeader otherLines
     return (method, path', path, query, httpversion, hdr)
 
 ----------------------------------------------------------------
@@ -131,8 +132,65 @@
 -- ("Host","example.com:8080")
 -- >>> parseHeader "NoSemiColon"
 -- ("NoSemiColon","")
-parseHeader :: ByteString -> H.Header
-parseHeader s =
-    let (k, rest) = S.break (== _colon) s
-        rest' = S.dropWhile (\c -> c == _space || c == _tab) $ S.drop 1 rest
-     in (CI.mk k, rest')
+-- >>> parseHeader "Content-Length : 47"
+-- *** Exception: Warp: Invalid header field name: "Content-Length "
+-- >>> parseHeader "X-Foo: a\rContent-Length: 47"
+-- *** Exception: Warp: CR or NUL in a header field line
+parseHeader :: ByteString -> IO H.Header
+parseHeader s = do
+    -- The line was ended by an LF, and the CR before it is already
+    -- gone, so any CR left here is a bare one. RFC 9110 section 5.5
+    -- asks for it to be refused or replaced: a recipient which takes a
+    -- bare CR for a line terminator reads a field, and a framing field
+    -- among them, where warp reads only data.
+    when (hasControl s) $ throwIO BadHeaderLine
+    -- RFC 9112 asks for 400 here, because a recipient which instead
+    -- repairs the name reads a header where warp reads none: a
+    -- Content-Length hidden that way is a request body warp does not
+    -- know it is being sent.
+    when (S.null k || not (S.all isTchar k)) $ throwIO $ BadFieldName k
+    return (CI.mk k, rest')
+  where
+    (k, rest) = S.break (== _colon) s
+    rest' = S.dropWhile isOWS $ S.drop 1 rest
+    isOWS c = c == _space || c == _tab
+    -- Two passes of memchr beat one pass of a lambda here by a wide
+    -- margin, and 'S.elem' is the way to ask for memchr: measured over
+    -- a browser's request headers, this takes a fifth of the time that
+    -- @S.any (_cr ==)@ does and a fifteenth of the time that one
+    -- @S.any@ with a two-way lambda does.
+    hasControl bs = S.elem _cr bs || S.elem _nul bs
+
+-- | Whether RFC 9110 allows the character in a header field name.
+--
+-- One lookup, where a chain of ranges and an 'elem' over fifteen bytes
+-- used to be.
+isTchar :: Word8 -> Bool
+isTchar w = SU.unsafeIndex tchars (fromIntegral w) == 1
+
+-- | 'isTchar' for every byte there is.
+tchars :: ByteString
+tchars = S.pack $ map tchar [minBound .. maxBound]
+  where
+    tchar w
+        | isAsciiUpper w || isAsciiLower w || isDigit w = 1
+        | w `elem` symbols = 1
+        | otherwise = 0
+    symbols =
+        [ _exclam
+        , _numbersign
+        , _dollar
+        , _percent
+        , _ampersand
+        , _quotesingle
+        , _asterisk
+        , _plus
+        , _hyphen
+        , _period
+        , _circum
+        , _underscore
+        , _grave
+        , _bar
+        , _tilde
+        ]
+{-# NOINLINE tchars #-}
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
@@ -7,6 +7,7 @@
 module Network.Wai.Handler.Warp.Response (
     sendResponse,
     sanitizeHeaderValue, -- for testing
+    containsRecoverableWhitespace, -- for benchmarking
     --  Provided here for backwards compatibility.
     warpVersion,
     hasBody,
@@ -16,25 +17,25 @@
 ) where
 
 import qualified Control.Exception as E
-import Data.Array ((!))
 import qualified Data.ByteString as S
+import Data.ByteString.Internal (toForeignPtr, unsafeCreate)
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Builder.Extra (flush)
 import Data.ByteString.Builder.HTTP.Chunked (
     chunkedTransferEncoding,
     chunkedTransferTerminator,
  )
-import qualified Data.ByteString.Char8 as C8
 import qualified Data.CaseInsensitive as CI
-import Data.Function (on)
-import Data.List (deleteBy)
+import Data.Foldable (for_)
+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
 import Data.Streaming.ByteString.Builder (
     newByteStringBuilderRecv,
     reuseBufferStrategy,
  )
-import Data.Word8 (_cr, _lf, _space, _tab)
+import Data.Word8 (_cr, _lf, _nul, _space)
+import Foreign (copyBytes, plusForeignPtr, pokeByteOff, withForeignPtr)
 import qualified Network.HTTP.Types as H
-import qualified Network.HTTP.Types.Header as H
+import qualified Network.HTTP.Types.Header as Header
 import Network.Wai
 import Network.Wai.Internal
 import qualified System.TimeManager as T
@@ -43,7 +44,7 @@
 import qualified Network.Wai.Handler.Warp.Date as D
 import Network.Wai.Handler.Warp.File
 import Network.Wai.Handler.Warp.Header
-import Network.Wai.Handler.Warp.IO (toBufIOWith)
+import Network.Wai.Handler.Warp.IO (toBufIOWith, unsafeToBufIOWithOffset)
 import Network.Wai.Handler.Warp.Imports
 import Network.Wai.Handler.Warp.ResponseHeader
 import Network.Wai.Handler.Warp.Settings
@@ -111,7 +112,7 @@
     -> T.Handle
     -> Request
     -- ^ HTTP request.
-    -> IndexedHeader
+    -> IndexedRequestHeader
     -- ^ Indexed header of HTTP request.
     -> IO ByteString
     -- ^ source from client, for raw response
@@ -120,7 +121,23 @@
     -> IO Bool
     -- ^ Returing True if the connection is persistent.
 sendResponse settings conn ii th req reqidxhdr src response = do
+    -- Decide connection persistence
+    isShuttingDown <-
+        case settingsServerState settings of
+            Just serverState -> currentShuttingDownState serverState
+            -- Should never be reached!
+            -- (cf. 'makeServerState' in 'runSettingsConnectionMakerSecure')
+            Nothing -> pure False
+    let shouldPersist = not isShuttingDown && ret
+        addConnection hs =
+            if shouldPersist || responseWantsToClose
+                then hs
+                else (Header.hConnection, "close") : hs
+
+    -- Adjust headers
     hs <- addConnection . addAltSvc settings <$> addServerAndDate hs0
+
+    -- Start response logic
     if hasBody s
         then do
             -- The response to HEAD does not have body.
@@ -133,31 +150,39 @@
             case ms of
                 Nothing -> return ()
                 Just realStatus -> logger req realStatus mlen
-            T.tickle th
-            return ret
         else do
             _ <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody
             logger req s Nothing
-            T.tickle th
-            return isPersist
+    T.tickle th
+    return shouldPersist
   where
+    -- From Settings --
     defServer = settingsServerName settings
     logger = settingsLogger settings
     maxRspBufSize = settingsMaxBuilderResponseBufferSize settings
+
+    -- From Request --
+    method = requestMethod req
+    isHead = method == H.methodHead
     ver = httpVersion req
+    isHttp11 = ver == H.http11
+    reqSaysPersist = checkReqConnectionHeader isHttp11 reqidxhdr
+
+    -- From Response --
     s = responseStatus response
     hs0 = sanitizeHeaders $ responseHeaders response
     rspidxhdr = indexResponseHeader hs0
-    addConnection hs = if (hasBody s && not ret) || (not (hasBody s) && not isPersist)
-                       then (H.hConnection, "close") : hs
-                       else hs
+    hasLength = hasContentLength rspidxhdr
+    responseWantsToClose =
+        case hasConnection rspidxhdr of
+            Nothing -> False
+            Just v -> CI.foldCase v == "close"
+    isPersist = reqSaysPersist && not responseWantsToClose
+
+    -- Other --
     getdate = getDate ii
     addServerAndDate = addDate getdate rspidxhdr . addServer defServer rspidxhdr
-    (isPersist, isChunked0) = infoFromRequest req reqidxhdr
-    isChunked = not isHead && isChunked0
-    (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr (isPersist, isChunked)
-    method = requestMethod req
-    isHead = method == H.methodHead
+    needsChunked = isHttp11 && not hasLength
     rsp = case response of
         ResponseFile _ _ path mPart -> RspFile path mPart reqidxhdr (T.tickle th)
         ResponseBuilder _ _ b
@@ -167,43 +192,74 @@
             | isHead -> RspNoBody
             | otherwise -> RspStream fb needsChunked
         ResponseRaw raw _ -> RspRaw raw src
+    -- Should be False if (http10 && not hasLength), regardless of what
+    -- the 'Connection' header says. (as long as the response should have a body)
+    isKeepAlive =
+        isPersist && (isHttp11 || hasLength || isHead || not (hasBody s))
     -- Make sure we don't hang on to 'response' (avoid space leak)
     !ret = case response of
+        -- Will get 'Content-Length' header later on using the
+        -- 'addContentHeaders(ForFilePart)' functions, so if the
+        -- 'Connection' header says we persist, we persist.
         ResponseFile{} -> isPersist
         ResponseBuilder{} -> isKeepAlive
         ResponseStream{} -> isKeepAlive
+        -- Is already an ongoing open connection, so if it is done,
+        -- the connection should be closed.
         ResponseRaw{} -> False
 
 ----------------------------------------------------------------
 
+-- | As per RFC 9110 we replace any newlines (\r\n) or \NUL with spaces
+-- Values without CR/LF/NUL (the overwhelmingly common case) leave the
+-- header list untouched; only a dirty value triggers a rebuild.
 sanitizeHeaders :: H.ResponseHeaders -> H.ResponseHeaders
-sanitizeHeaders = map (sanitize <$>)
+sanitizeHeaders hdrs
+      -- slow path
+    | any (containsRecoverableWhitespace . snd) hdrs = map (sanitize <$>) hdrs
+      -- fast path
+    | otherwise = hdrs
   where
-    sanitize v
-        | containsNewlines v = sanitizeHeaderValue v -- slow path
-        | otherwise = v -- fast path
+    sanitize bs
+        | containsRecoverableWhitespace bs = sanitizeHeaderValue bs
+        | otherwise = bs
 
-{-# INLINE containsNewlines #-}
-containsNewlines :: ByteString -> Bool
-containsNewlines = S.any (\w -> w == _cr || w == _lf)
+-- Yes, this is quicker than @S.any (\w -> w == _lf || w == _cr || w == _nul)@
+-- because of `bytestring`'s rewrite rules.
+containsRecoverableWhitespace :: ByteString -> Bool
+containsRecoverableWhitespace bs =
+    S.any (_lf ==) bs || S.any (_cr ==) bs || S.any (_nul ==) bs
 
-{-# INLINE sanitizeHeaderValue #-}
+{-# INLINE isRecoverableWhitespace #-}
+-- | CR, LF and NUL can safely be replaced with a SP according to RFC 9110
+-- <https://www.rfc-editor.org/rfc/rfc9110.html#section-5.5-5>
+isRecoverableWhitespace :: Word8 -> Bool
+isRecoverableWhitespace w = w == _cr || w == _lf || w == _nul
+
 sanitizeHeaderValue :: ByteString -> ByteString
-sanitizeHeaderValue v = case C8.lines $ S.filter (/= _cr) v of
-    [] -> ""
-    x : xs -> C8.intercalate "\r\n" (x : mapMaybe addSpaceIfMissing xs)
+sanitizeHeaderValue v =
+    case S.findIndices isRecoverableWhitespace v of
+        -- Nothing to replace
+        [] -> v
+        -- Found CR, LF or NUL.
+        ixs ->
+            unsafeCreate len $ \dst -> do
+                withForeignPtr fptr $ \src -> do
+                    -- copy the bytestring
+                    copyBytes dst src len
+                    -- and then replace the offending bytes
+                    for_ ixs $ \ix -> pokeByteOff dst ix _space
   where
-    addSpaceIfMissing line = case S.uncons line of
-        Nothing -> Nothing
-        Just (first, _)
-            | first == _space || first == _tab -> Just line
-            | otherwise -> Just $ _space `S.cons` line
+    (fptr', offset, len) = toForeignPtr v
+    -- We need to use the offset for backwards compatibility with
+    -- "bytestring < 0.11"
+    fptr = fptr' `plusForeignPtr` offset
 
 ----------------------------------------------------------------
 
 data Rsp
     = RspNoBody
-    | RspFile FilePath (Maybe FilePart) IndexedHeader (IO ())
+    | RspFile FilePath (Maybe FilePart) IndexedRequestHeader (IO ())
     | RspBuilder Builder Bool
     | RspStream StreamingBody Bool
     | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString)
@@ -217,7 +273,7 @@
     -> H.HttpVersion
     -> H.Status
     -> H.ResponseHeaders
-    -> IndexedHeader -- Response
+    -> ResponseHeaderPresence
     -> Int -- maxBuilderResponseBufferSize
     -> H.Method
     -> Rsp
@@ -228,42 +284,69 @@
     -- Not adding Content-Length.
     -- User agents treats it as Content-Length: 0.
     composeHeader ver s hs >>= connSendAll conn
-    return (Just s, Nothing)
+    return (Just s, Just 0)
 
 ----------------------------------------------------------------
 
-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
-        writeBufferRef = connWriteBuffer conn
+sendRsp conn _ th ver s hs rspidxhdr maxRspBufSize _ (RspBuilder body needsChunked) = do
+    writeBuffer <- readIORef writeBufferRef
     len <-
-        toBufIOWith
-            maxRspBufSize
-            writeBufferRef
-            (\bs -> connSendAll conn bs >> T.tickle th)
-            hdrBdy
-    return (Just s, Just len)
+        -- SAFETY: this check is what makes the unchecked writes below
+        -- memory-safe, do not weaken it. composeHeaderPtr writes hdrLen
+        -- bytes into the write buffer with no bounds checking of its own,
+        -- and unsafeToBufIOWithOffset requires an offset within the
+        -- buffer (it hands the builder buffer + offset with
+        -- bufSize - offset bytes of claimed free space). If hdrLen could
+        -- reach the buffer size, either write would run past the end of
+        -- the allocation and corrupt memory, so oversized headers must
+        -- take the composeHeaderBuilder fallback.
+        if hdrLen < bufSize writeBuffer
+            then do
+                -- Compose the header directly into the connection write
+                -- buffer and run the body builder right after it, saving
+                -- a copy of the header bytes through an intermediate
+                -- ByteString.
+                _ <- composeHeaderPtr (bufBuffer writeBuffer) ver s hs'
+                unsafeToBufIOWithOffset hdrLen maxRspBufSize writeBufferRef send bdy
+            else do
+                -- Huge headers: fall back to composing a separate header
+                -- ByteString and letting the builder machinery copy it.
+                (header, _) <- composeHeaderBuilder ver s hs rspidxhdr needsChunked
+                toBufIOWith maxRspBufSize writeBufferRef send (header <> bdy)
+    --              small adjustment to only count the body
+    return (Just s, Just $ len - fromIntegral hdrLen)
+  where
+    hs'
+        | needsChunked = addTransferEncoding rspidxhdr hs
+        | otherwise = hs
+    hdrLen = composeHeaderLength s hs'
+    bdy
+        | needsChunked = chunkedTransferEncoding body <> chunkedTransferTerminator
+        | otherwise = body
+    writeBufferRef = connWriteBuffer conn
+    send bs = connSendAll conn bs >> T.tickle th
 
 ----------------------------------------------------------------
 
-sendRsp conn _ th ver s hs _ _ _ (RspStream streamingBody needsChunked) = do
-    header <- composeHeaderBuilder ver s hs needsChunked
+sendRsp conn _ th ver s hs rspidxhdr _ _ (RspStream streamingBody needsChunked) = do
+    (header, hdrLen) <- composeHeaderBuilder ver s hs rspidxhdr needsChunked
     (recv, finish) <-
         newByteStringBuilderRecv $
             reuseBufferStrategy $
                 toBuilderBuffer $
                     connWriteBuffer conn
+    -- We'll be counting how many bytes we send with this 'IORef'
+    sizeCounter <- newIORef (0 :: Integer)
+    let sendFragmentAndCount bs = do
+            sendFragment conn th bs
+            -- add amount of bytes to count
+            S.length bs `addToCounter` sizeCounter
     let send builder = do
             popper <- recv builder
             let loop = do
                     bs <- popper
                     unless (S.null bs) $ do
-                        sendFragment conn th bs
+                        sendFragmentAndCount bs
                         loop
             loop
         sendChunk
@@ -272,9 +355,16 @@
     send header
     streamingBody sendChunk (sendChunk flush)
     when needsChunked $ send chunkedTransferTerminator
-    mbs <- finish
-    maybe (return ()) (sendFragment conn th) mbs
-    return (Just s, Nothing) -- fixme: can we tell the actual sent bytes?
+    -- final flush
+    finish >>= mapM_ sendFragmentAndCount
+    finalSize <- readIORef sizeCounter
+    --              small adjustment to only count the body
+    return (Just s, Just $ finalSize - fromIntegral hdrLen)
+  where
+    addToCounter :: Int -> IORef Integer -> IO ()
+    addToCounter bytes ref =
+        atomicModifyIORef' ref $ \old ->
+            (old + fromIntegral bytes, ())
 
 ----------------------------------------------------------------
 
@@ -352,7 +442,7 @@
     -> H.HttpVersion
     -> H.Status
     -> H.ResponseHeaders
-    -> IndexedHeader
+    -> ResponseHeaderPresence
     -> Int
     -> H.Method
     -> FilePath
@@ -362,6 +452,8 @@
     -> IO (Maybe H.Status, Maybe Integer)
 sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize method path beg len hook
     | method == H.methodHead =
+        -- FIXME: We could check the size of the file and add a
+        -- 'Content-Length' header to give the requester more information?
         sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody
     | otherwise = do
         lheader <- composeHeader ver s hs
@@ -377,7 +469,7 @@
     -> T.Handle
     -> H.HttpVersion
     -> H.ResponseHeaders
-    -> IndexedHeader
+    -> ResponseHeaderPresence
     -> Int
     -> H.Method
     -> IO (Maybe H.Status, Maybe Integer)
@@ -395,7 +487,7 @@
         (RspBuilder body True)
   where
     s = H.notFound404
-    hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
+    hs = replaceHeader Header.hContentType "text/plain; charset=utf-8" hs0
     body = byteString "File not found"
 
 ----------------------------------------------------------------
@@ -415,49 +507,23 @@
 
 ----------------------------------------------------------------
 
-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
-  where
-    ver = httpVersion req
-    conn = reqidxhdr ! fromEnum ReqConnection
-    checkPersist11 (Just x)
-        | CI.foldCase x == "close" = False
-    checkPersist11 _ = True
-    checkPersist10 (Just x)
-        | CI.foldCase x == "keep-alive" = True
-    checkPersist10 _ = False
-
-checkChunk :: Request -> Bool
-checkChunk req = httpVersion req == H.http11
+-- | We infer from the request whether the connection should be persisted.
+checkReqConnectionHeader :: Bool -> IndexedRequestHeader -> Bool
+checkReqConnectionHeader isHttp11 reqidxhdr =
+    case reqidxConnection reqidxhdr of
+        -- If no "Connection" header, then default: HTTP/1.1 == persist
+        Nothing -> isHttp11
+        Just val ->
+            let connValue = CI.foldCase val
+             in if isHttp11
+                    then connValue /= "close"
+                    else connValue == "keep-alive"
 
 ----------------------------------------------------------------
 
--- Used for ResponseBuilder and ResponseSource.
--- Don't use this for ResponseFile since this logic does not fit
--- for ResponseFile. For instance, isKeepAlive should be True in some cases
--- even if the response header does not have Content-Length.
+-- | Only checks for status codes, NOT for methods.
 --
--- 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)
-  where
-    needsChunked = isChunked && not hasLength
-    isKeepAlive = isPersist && (isChunked || hasLength)
-    hasLength = isJust $ rspidxhdr ! fromEnum ResContentLength
-
-----------------------------------------------------------------
-
+-- This is by design and some handling relies on HEAD being a separate check.
 hasBody :: H.Status -> Bool
 hasBody s =
     sc /= 204
@@ -468,28 +534,41 @@
 
 ----------------------------------------------------------------
 
-addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders
-addTransferEncoding hdrs = (H.hTransferEncoding, "chunked") : hdrs
+-- | We ASSUME there's no middleware that will chunk the transfer, so
+-- we'll add it to the headers if there's no other encoding, or add it
+-- to the end in case it is.
+-- (e.g. if a 'Middleware' were to add "Transfer-Encoding: gzip")
+addTransferEncoding :: ResponseHeaderPresence -> H.ResponseHeaders -> H.ResponseHeaders
+addTransferEncoding rspidxhdr =
+    case hasTransferEncoding rspidxhdr of
+        Just value -> replaceHeader Header.hTransferEncoding (value <> ", chunked")
+        Nothing -> ((Header.hTransferEncoding, "chunked") :)
 
 addDate
-    :: IO D.GMTDate -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders
-addDate getdate rspidxhdr hdrs = case rspidxhdr ! fromEnum ResDate of
-    Nothing -> do
+    :: IO D.GMTDate -> ResponseHeaderPresence -> H.ResponseHeaders -> IO H.ResponseHeaders
+addDate getdate rspidxhdr hdrs
+    | hasDate rspidxhdr = return hdrs
+    | otherwise = do
         gmtdate <- getdate
-        return $ (H.hDate, gmtdate) : hdrs
-    Just _ -> return hdrs
+        return $ (Header.hDate, gmtdate) : hdrs
 
 ----------------------------------------------------------------
 
 {-# INLINE addServer #-}
 addServer
-    :: HeaderValue -> IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
-addServer "" rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of
-    Nothing -> hdrs
-    _ -> filter ((/= H.hServer) . fst) hdrs
-addServer serverName rspidxhdr hdrs = case rspidxhdr ! fromEnum ResServer of
-    Nothing -> (H.hServer, serverName) : hdrs
-    _ -> hdrs
+    :: HeaderValue -> ResponseHeaderPresence -> H.ResponseHeaders -> H.ResponseHeaders
+addServer serverName rspidxhdr hdrs =
+    case serverName of
+        -- empty string means there shouldn't be a "Server" header
+        ""
+            | serverPresent -> filter ((/= Header.hServer) . fst) hdrs
+            | otherwise -> hdrs
+        -- Anything else should set the "Server" header if it isn't already set
+        _
+            | not serverPresent -> (Header.hServer, serverName) : hdrs
+            | otherwise -> hdrs
+  where
+    serverPresent = hasServer rspidxhdr
 
 addAltSvc :: Settings -> H.ResponseHeaders -> H.ResponseHeaders
 addAltSvc settings hs = case settingsAltSvc settings of
@@ -498,19 +577,23 @@
 
 ----------------------------------------------------------------
 
--- |
+-- | Replaces a header, instead of just adding it which might lead to
+-- duplicate entries of the same header name.
 --
 -- >>> 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 k v hdrs = (k, v) : filter ((/= k) . fst) hdrs
 
 ----------------------------------------------------------------
 
 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 =
-    byteString <$> composeHeader ver s hs
+    :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> ResponseHeaderPresence -> Bool -> IO (Builder, Int)
+composeHeaderBuilder ver s hs rspidxhdr shouldChunk = do
+    bs <- composeHeader ver s finalHdrs
+    pure (byteString bs, S.length bs)
+  where
+    finalHdrs
+        | shouldChunk = addTransferEncoding rspidxhdr hs
+        | otherwise = hs
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,12 +1,16 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Network.Wai.Handler.Warp.ResponseHeader (composeHeader) where
+module Network.Wai.Handler.Warp.ResponseHeader (
+    composeHeader,
+    composeHeaderPtr,
+    composeHeaderLength,
+) where
 
 import qualified Data.ByteString as S
 import Data.ByteString.Internal (create)
 import qualified Data.CaseInsensitive as CI
-import Data.List (foldl')
+import Data.List as List (foldl')
 import Data.Word8
 import Foreign.Ptr
 import GHC.Storable
@@ -18,14 +22,32 @@
 ----------------------------------------------------------------
 
 composeHeader :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> IO ByteString
-composeHeader !httpversion !status !responseHeaders = create len $ \ptr -> do
-    ptr1 <- copyStatus ptr httpversion status
-    ptr2 <- copyHeaders ptr1 responseHeaders
-    void $ copyCRLF ptr2
+composeHeader !httpversion !status !responseHeaders =
+    create len $ \ptr ->
+        void $ composeHeaderPtr ptr httpversion status responseHeaders
   where
-    !len = 17 + slen + foldl' fieldLength 0 responseHeaders
+    !len = composeHeaderLength status responseHeaders
+
+-- | The exact number of bytes 'composeHeaderPtr' writes for this
+-- status line and header list (including the final CRLF).
+composeHeaderLength :: H.Status -> H.ResponseHeaders -> Int
+composeHeaderLength !status !responseHeaders =
+    17 + slen + List.foldl' fieldLength 0 responseHeaders
+  where
     fieldLength !l (!k, !v) = l + S.length (CI.original k) + S.length v + 4
     !slen = S.length $ H.statusMessage status
+
+-- | Compose the response header directly into the given buffer,
+-- returning the number of bytes written. The buffer must have room
+-- for at least 'composeHeaderLength' bytes.
+composeHeaderPtr
+    :: Ptr Word8 -> H.HttpVersion -> H.Status -> H.ResponseHeaders -> IO Int
+{-# INLINE composeHeaderPtr #-}
+composeHeaderPtr !ptr !httpversion !status !responseHeaders = do
+    ptr1 <- copyStatus ptr httpversion status
+    ptr2 <- copyHeaders ptr1 responseHeaders
+    ptr3 <- copyCRLF ptr2
+    return $! ptr3 `minusPtr` ptr
 
 httpVer11 :: ByteString
 httpVer11 = "HTTP/1.1 "
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,19 +1,31 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
-{-# LANGUAGE MultiWayIf #-}
 
 module Network.Wai.Handler.Warp.Run where
 
 import Control.Arrow (first)
+import Control.Concurrent.STM (
+    STM,
+    retry,
+    TVar,
+    atomically,
+    check,
+    modifyTVar',
+    newTVarIO,
+    readTVar,
+    writeTVar,
+ )
 import qualified Control.Exception as E
 import qualified Data.ByteString as S
-import Data.IORef (newIORef, readIORef)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.Streaming.Network (bindPortTCP)
-import Foreign.C.Error (Errno (..), eCONNABORTED, eMFILE)
+import Foreign.C.Error (Errno (..), eMFILE)
 import GHC.Conc.Sync (labelThread, myThreadId)
 import GHC.IO.Exception (IOErrorType (..), IOException (..))
 import Network.Socket (
@@ -25,21 +37,26 @@
     fdSocket,
 #endif
     getSocketName,
+    isClosedSocketError,
+    isTransientAcceptError,
+    unsafeClose,
+    withReadable,
     setSocketOption,
     withSocketsDo,
  )
 #if MIN_VERSION_network(3,1,1)
-import Network.Socket (gracefulClose)
+import Network.Socket (gracefulClose, unsafeGracefulClose)
 #endif
 import Network.Socket.BufferPool
 import qualified Network.Socket.ByteString as Sock
 import Network.Wai
 import System.Environment (lookupEnv)
 import System.IO.Error (ioeGetErrorType)
+import qualified System.ThreadManager as T
 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
@@ -48,22 +65,24 @@
 import Network.Wai.Handler.Warp.HTTP2 (http2)
 import Network.Wai.Handler.Warp.HTTP2.Types (isHTTP2)
 import Network.Wai.Handler.Warp.Imports hiding (readInt)
-import Network.Wai.Handler.Warp.SendFile
+import Network.Wai.Handler.Warp.SendFile (sendFile)
 import Network.Wai.Handler.Warp.Settings
+import Network.Wai.Handler.Warp.ShuttingDown (writeShuttingDown)
 import Network.Wai.Handler.Warp.Types
 
 -- | Creating 'Connection' for plain HTTP based on a given socket.
+--
+-- (N.B. make sure the 'Settings' have an initialized 'ServerState' to guarantee
+-- a graceful shutdown)
 socketConnection :: Settings -> Socket -> IO Connection
-#if MIN_VERSION_network(3,1,1)
 socketConnection set s = do
-#else
-socketConnection _ s = do
-#endif
+    (ss, _) <- makeServerState set
     bufferPool <- newBufferPool 2048 16384
     writeBuffer <- createWriteBuffer 16384
     writeBufferRef <- newIORef writeBuffer
     isH2 <- newIORef False -- HTTP/1.x
     mysa <- getSocketName s
+    appsInProgress <- newTVarIO 0
     return
         Connection
             { connSendMany = Sock.sendMany s
@@ -76,20 +95,25 @@
                         if h2
                             then settingsGracefulCloseTimeout2 set
                             else settingsGracefulCloseTimeout1 set
-                if tm == 0
-                    then close s
-                    else gracefulClose s tm `E.catch` throughAsync (return ())
+                    (closer, gracefulCloser)
+                        | settingsUnsafeClose set = (unsafeClose, unsafeGracefulClose)
+                        | otherwise = (close, gracefulClose)
+                if tm <= 0
+                    then closer s
+                    else gracefulCloser s tm `E.catch` throughAsync (return ())
 #else
             , connClose = close s
 #endif
-            , connRecv = receive' s bufferPool
+            , connRecv = receive' bufferPool ss appsInProgress
             , connRecvBuf = \_ _ -> return True -- obsoleted
             , connWriteBuffer = writeBufferRef
             , connHTTP2 = isH2
             , connMySockAddr = mysa
+            , connAppsInProgress = appsInProgress
             }
   where
-    receive' sock pool = E.handle handler $ receive sock pool
+    receive' bufferPool ss appsInProgress =
+        E.handle handler $ makeGracefulRecv s bufferPool ss appsInProgress
       where
         handler :: E.IOException -> IO ByteString
         handler e
@@ -109,9 +133,7 @@
             hook
             headers
 
-    sendall = sendAll' s
-
-    sendAll' sock bs =
+    sendall bs =
         E.handleJust
             ( \e ->
                 if ioeGetErrorType e == ResourceVanished
@@ -119,8 +141,30 @@
                     else Nothing
             )
             E.throwIO
-            $ Sock.sendAll sock bs
+            $ killableSendAll s bs
 
+-- | 'Sock.sendAll' which the timeout can kill.  On Windows a plain send is
+-- a foreign call no asynchronous exception reaches; this one waits in STM,
+-- and is cancelled if the waiting thread is killed.
+killableSendAll :: Socket -> ByteString -> IO ()
+killableSendAll s bs = void $ Sock.sendAllWith s bs (retry :: STM ())
+
+-- | Create a 'Recv' which stops receiving when the server is shutting down
+-- and no 'Application' is still using this 'Socket'.
+--
+-- Nothing is closed and no thread is interrupted to make it return: the
+-- read and the shutdown are waited for at once, inside 'receiveWith'.
+makeGracefulRecv :: Socket -> BufferPool -> ServerState -> TVar Int -> Recv
+makeGracefulRecv sock pool ss appsInProgress = do
+    r <- receiveWith sock pool checkShutdown
+    case r of
+        Left () -> return ""
+        Right bs -> return bs
+  where
+    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 ()
@@ -130,7 +174,7 @@
 -- environment variable. Uses the 'Port' given when the variable is unset.
 -- This calls 'runSettings' with 'defaultSettings'.
 --
--- Since 3.0.9
+-- @since 3.0.9
 runEnv :: Port -> Application -> IO ()
 runEnv p app = do
     mp <- lookupEnv "PORT"
@@ -156,32 +200,94 @@
                 runSettingsSocket set socket app
             )
 
--- | This installs a shutdown handler for the given socket and
--- calls 'runSettingsConnection' with the default connection setup action
--- which handles plain (non-cipher) HTTP.
--- When the listen socket in the second argument is closed, all live
--- connections are gracefully shut down.
+-- | What the accept loop waits on at the top of each turn, and what it
+--   leaves behind when it stops.
 --
+-- A server used to be stopped by closing the listening socket under the
+-- thread waiting in @accept@ on it.  That takes an IO manager that can wake
+-- a thread out of a wait by closing the file descriptor under it, which is
+-- what 'GHC.Conc.closeFdWith' is for, and the IO manager that provides it
+-- is not the only one there will be.  So the loop waits for the socket and
+-- for the shutdown at once and ends on whichever comes first; the socket is
+-- closed after it, by which time nothing is waiting on it.
+data Listener = Listener
+    { acceptOrStop :: IO (Maybe (Socket, SockAddr))
+    -- ^ Accepts a connection.  'Nothing' instead once the server has been
+    -- asked to stop: giving up has to be composed with the accept itself,
+    -- so the accept belongs here rather than beside it.
+    , closeListener :: IO ()
+    -- ^ Run once the accept loop has ended and before the connections are
+    -- waited for: the port is a successor's to take, and a successor should
+    -- not have to wait out someone else's drain for it.
+    }
+
+-- | For a caller that handed warp a connection maker and no socket.  There
+--   is nothing here to accept and nothing to close, and such a server ends
+--   the way it always did: by whatever its maker accepts on being closed.
+noListener :: Listener
+noListener = Listener{acceptOrStop = return Nothing, closeListener = return ()}
+
+-- | Thrown by a connection maker which was told to stop rather than handed
+--   a connection, and caught by the accept loop.  A maker has to return a
+--   connection or throw, so this is how it says that there will not be one.
+data AcceptStopped = AcceptStopped deriving (Show)
+
+instance E.Exception AcceptStopped
+
+makeListener :: Settings -> Socket -> IO Listener
+makeListener set socket = do
+    stopping <- newTVarIO False
+    settingsInstallShutdownHandler set $ atomically $ writeTVar stopping True
+    return
+        Listener
+            { acceptOrStop = closedAsStopped $ do
+                r <- withReadable socket (told stopping) $ settingsAccept set socket
+                return $ either (const Nothing) Just r
+            , closeListener = unsafeClose socket
+            }
+  where
+    told stopping = check =<< readTVar stopping
+    -- Closing the listening socket is how a server was stopped before there
+    -- was anything to tell, and callers that do it are still out there. It
+    -- means the same thing the shutdown handler means: stop accepting.
+    -- Ending the loop quietly is what happened before, and 'closeListener'
+    -- closing an already-closed socket is no error.
+    closedAsStopped = E.handle $ \e ->
+        if isClosedSocketError e then return Nothing else E.throwIO e
+
+-- | This installs a shutdown handler for the given socket and runs the
+-- default connection setup action, which handles plain (non-cipher) HTTP.
+-- Running the handler stops the server accepting, closes the listening
+-- socket, and gracefully shuts the live connections down.
+--
 -- The supplied socket can be a Unix named socket, which
 -- can be used when reverse HTTP proxying into your application.
 --
 -- Note that the 'settingsPort' will still be passed to 'Application's via the
 -- 'serverPort' record.
 runSettingsSocket :: Settings -> Socket -> Application -> IO ()
-runSettingsSocket set@Settings{settingsAccept = accept'} socket app = do
-    settingsInstallShutdownHandler set closeListenSocket
-    runSettingsConnection set getConn app
+runSettingsSocket oldSettings socket app = do
+    listener <- makeListener oldSettings socket
+    (_, newSettings) <- makeServerState oldSettings
+    runSettingsConnectionMakerSecureWith
+        newSettings
+        listener
+        (first ((,TCP) <$>) <$> getConnMaker listener newSettings)
+        app
   where
-    getConn = do
-        (s, sa) <- accept' socket
+    getConnMaker listener set = do
+        (conn, sa) <- getConn listener set
+        return (return conn, sa)
+
+    getConn listener set = do
+        macc <- acceptOrStop listener
+        (s, sa) <- maybe (E.throwIO AcceptStopped) return macc
         setSocketCloseOnExec s
         -- NoDelay causes an error for AF_UNIX.
         setSocketOption s NoDelay 1 `E.catch` throughAsync (return ())
         conn <- socketConnection set s
         return (conn, sa)
 
-    closeListenSocket = close socket
-
 -- | The connection setup action would be expensive. A good example
 -- is initialization of TLS.
 -- So, this converts the connection setup action to the connection maker
@@ -190,7 +296,7 @@
 -- This allows the expensive computations to be performed
 -- in a separate worker thread instead of the main server loop.
 --
--- Since 1.3.5
+-- @since 1.3.5
 runSettingsConnection
     :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
 runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMaker app
@@ -215,19 +321,30 @@
 -- The connection maker can return a connection of either plain HTTP
 -- or HTTP over TLS.
 --
--- Since 2.1.4
+-- @since 2.1.4
 runSettingsConnectionMakerSecure
     :: Settings -> IO (IO (Connection, Transport), SockAddr) -> Application -> IO ()
-runSettingsConnectionMakerSecure set getConnMaker app = do
-    settingsBeforeMainLoop set
-    counter <- case settingsConnectionCounter set of
-        Just c -> pure c
-        Nothing -> newCounter
-    withII set $ acceptConnection set getConnMaker app counter
+runSettingsConnectionMakerSecure set = runSettingsConnectionMakerSecureWith set noListener
 
+-- | 'runSettingsConnectionMakerSecure' for a caller that has the listening
+--   socket, and so can say how the accept loop waits on it and what becomes
+--   of it when the loop stops.
+runSettingsConnectionMakerSecureWith
+    :: Settings
+    -> Listener
+    -> IO (IO (Connection, Transport), SockAddr)
+    -> Application
+    -> IO ()
+runSettingsConnectionMakerSecureWith oldSettings listener getConnMaker app = do
+    settingsBeforeMainLoop oldSettings
+    (ServerState{serverConnectionCounter}, newSettings) <- makeServerState oldSettings
+    withII newSettings $ \ii ->
+        initFdExhaustionRef >>=
+            acceptConnection newSettings listener getConnMaker app serverConnectionCounter ii
+
 -- | Running an action with internal info.
 --
--- Since 3.3.11
+-- @since 3.3.11
 withII :: Settings -> (InternalInfo -> IO a) -> IO a
 withII set action =
     withTimeoutManager $ \tm ->
@@ -263,22 +380,38 @@
 -- Our approach is explained in the comments below.
 acceptConnection
     :: Settings
+    -> Listener
     -> 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 = do
+acceptConnection set listener getConnMaker app counter ii fdRef = do
     -- First mask all exceptions in acceptLoop. This is necessary to
     -- ensure that no async exception is throw between the call to
     -- acceptNewConnection and the registering of connClose.
     --
-    -- acceptLoop can be broken by closing the listening socket.
-    void $ 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.
-    gracefulShutdown set counter
+    -- acceptLoop ends when the listener says the server has been asked
+    -- to stop.
+    -- Whatever ends the loop, the connections being served do not outlive
+    -- it: 'stopAfter' kills what the manager still owns and rethrows.
+    -- Warp forks a thread per connection and nothing else owns them, so
+    -- without this they go on running after the caller of 'runSettings'
+    -- has been handed its exception back.  See #1126.
+    flip (T.stopAfter (threadManager counter)) (const $ return ()) $ do
+        void $ E.mask_ acceptLoop
+        -- Nothing is waiting on the listening socket any more, so it can be
+        -- closed and the port left to a successor rather than held for as
+        -- long as the connections below take to finish.
+        closeListener listener
+        -- 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.
+        gracefulShutdown set counter
   where
     acceptLoop = do
         -- Allow async exceptions before receiving the next connection maker.
@@ -298,22 +431,57 @@
                 fork set mkConn addr app counter ii
                 acceptLoop
 
-    acceptNewConnection = do
+    -- The maker throws this when the server has been asked to stop, which
+    -- is not a failure to report.
+    acceptNewConnection =
+        acceptNewConnection' `E.catch` \AcceptStopped -> return Nothing
+
+    acceptNewConnection' = do
         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 getErrno (Errno cInt) = cInt
                     isErrno err = ioe_errno e == Just (getErrno err)
-                if | isErrno eCONNABORTED -> acceptNewConnection
+                -- isTransientAcceptError is about one queued connection
+                -- rather than about the listening socket, and says which
+                -- errno those are. The connection has left the queue by
+                -- then, so the retry blocks for a new one rather than
+                -- spinning on the same failure.
+                if | isTransientAcceptError e -> 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
-                       settingsOnException set Nothing $ E.toException e
-                       waitForDecreased counter
-                       acceptNewConnection
+                        handleFdExhaustion e
+                        acceptNewConnection'
                    | otherwise -> do
-                       settingsOnException set Nothing $ E.toException e
-                       return Nothing
+                        -- 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
@@ -324,29 +492,37 @@
     -> 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.
-    --
-    -- 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
-        -- vulnerable to attacks (e.g., Slowloris), we do nothing to
-        -- protect the server. It is therefore vital that mkConn is well
-        -- vetted.
-        --
-        -- 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.
-        E.bracket mkConn cleanUp (serve unmask)
+fork set mkConn addr app counter ii =
+    -- The connection is counted from here rather than from the thread
+    -- below.  The accept loop does not wait for that thread to be
+    -- scheduled, so counting there leaves a window in which the connection
+    -- is accepted and not counted, and 'gracefulShutdown' waits on this
+    -- counter.
+    -- Eta-expanded so that GHC 9.0, which lacks deep subsumption, accepts
+    -- 'runConnection' at the rank-2 type.
+    forkConnection counter (settingsFork set) (\unmask -> runConnection unmask)
   where
+    runConnection unmask =
+        -- Call the user-supplied on exception code if any
+        -- exceptions are thrown.
+        --
+        -- 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 (onConnectionException set addr) $
+            -- 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
+            -- vulnerable to attacks (e.g., Slowloris), we do nothing to
+            -- protect the server. It is therefore vital that mkConn is well
+            -- vetted.
+            --
+            -- 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.
+            E.bracket mkConn cleanUp (serve unmask)
+
     cleanUp (conn, _) =
         connClose conn `E.finally` do
             writeBuffer <- readIORef $ connWriteBuffer conn
@@ -368,8 +544,8 @@
                 -- above ensures the connection is closed.
                 when goingon $ serveConnection conn ii th addr transport set app
 
-    onOpen adr = increase counter >> settingsOnOpen set adr
-    onClose adr _ = decrease counter >> settingsOnClose set adr
+    onOpen adr = settingsOnOpen set adr
+    onClose adr _ = settingsOnClose set adr
 
 serveConnection
     :: Connection
@@ -391,13 +567,19 @@
                 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
+            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
+            http1 settings ii conn transport app' origAddr th bs
   where
     recv4 bs0 = do
         bs1 <- connRecv conn
@@ -430,11 +612,32 @@
 #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
+
+-- [FD_EXHAUSTION]
+-- No need for "atomic" variants, since this is only used in a tight loop in
+-- 'acceptConnection'.
+resetFdExhaustion :: IORef FdExhaustion -> IO ()
+resetFdExhaustion = flip writeIORef NoFdIssue
+
+setFdExhaustion :: IORef FdExhaustion -> IO ()
+setFdExhaustion = flip writeIORef FdExhausted -- [FD_EXHAUSTION]
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
@@ -38,7 +38,7 @@
 --   This makes use of the file descriptor cache.
 --   For other OSes, this is identical to 'readSendFile'.
 --
--- Since: 3.1.0
+-- @since 3.1.0
 sendFile :: Socket -> Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
 #ifdef SENDFILEFD
 sendFile s _ _ _ fid off len act hdr = case mfid of
@@ -88,7 +88,7 @@
 --   This makes use of the file descriptor cache.
 --   For Windows, this is emulated by 'Handle'.
 --
--- Since: 3.1.0
+-- @since 3.1.0
 #ifdef WINDOWS
 readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
 readSendFile buf siz send fid off0 len0 hook headers = do
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
@@ -9,15 +9,16 @@
 
 module Network.Wai.Handler.Warp.Settings where
 
-import Control.Exception (SomeException(..), fromException, throw)
+import Control.Concurrent.STM (STM)
+import Control.Exception (SomeException (..), fromException, throw)
 import qualified Data.ByteString.Builder as Builder
 import qualified Data.ByteString.Char8 as C8
 import Data.Streaming.Network (HostPreference)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
+import GHC.Exts (fork#)
 import GHC.IO (IO (IO), unsafeUnmask)
 import GHC.IO.Exception (IOErrorType (..))
-import GHC.Prim (fork#)
 import qualified Network.HTTP.Types as H
 import Network.Socket (SockAddr, Socket, accept)
 import Network.Wai
@@ -25,8 +26,14 @@
 import System.IO.Error (ioeGetErrorType)
 import System.TimeManager
 
-import Network.Wai.Handler.Warp.Counter (Counter, newCounter)
+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)
@@ -37,6 +44,16 @@
 import qualified Paths_warp
 #endif
 
+-- | Report a worker exception with the address captured for that connection.
+-- An optional callback preserves the existing exception observer's meaning:
+-- setting the ordinary observer later still changes the default fallback.
+-- No shared peer state or synthetic Request is needed (#1113).
+onConnectionException :: Settings -> SockAddr -> SomeException -> IO ()
+onConnectionException settings address =
+    case settingsOnConnectionException settings of
+        Just report -> report address
+        Nothing -> settingsOnException settings Nothing
+
 -- | 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'
@@ -50,12 +67,15 @@
     -- ^ 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.
+    , settingsOnConnectionException :: Maybe (SockAddr -> SomeException -> IO ())
+    -- ^ Optional observer for exceptions escaping a connection worker. Nothing
+    -- delegates to settingsOnException with no request, preserving its defaults.
     , settingsOnExceptionResponse :: SomeException -> Response
     -- ^ A function to create `Response` when an exception occurs.
     --
     -- Default: 500, text/plain, \"Something went wrong\"
     --
-    -- Since 2.0.3
+    -- @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 ()
@@ -75,7 +95,7 @@
     --
     -- Default: do nothing.
     --
-    -- Since 1.3.6
+    -- @since 1.3.6
     , settingsFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
     -- ^ Code to fork a new thread to accept a connection.
     --
@@ -84,7 +104,7 @@
     --
     -- Default: 'defaultFork'
     --
-    -- Since 3.0.4
+    -- @since 3.0.4
     , settingsAccept :: Socket -> IO (Socket, SockAddr)
     -- ^ Code to accept a new connection.
     --
@@ -93,7 +113,7 @@
     --
     -- Default: 'defaultAccept'
     --
-    -- Since 3.3.24
+    -- @since 3.3.24
     , settingsNoParsePath :: Bool
     -- ^ Perform no parsing on the rawPathInfo.
     --
@@ -101,7 +121,7 @@
     --
     -- Default: False
     --
-    -- Since 2.0.3
+    -- @since 2.0.3
     , settingsInstallShutdownHandler :: IO () -> IO ()
     -- ^ An action to install a handler (e.g. Unix signal handler)
     -- to close a listen socket.
@@ -109,62 +129,68 @@
     --
     -- Default: no action
     --
-    -- Since 3.0.1
+    -- @since 3.0.1
     , settingsServerName :: ByteString
     -- ^ Default server name if application does not set one.
     --
-    -- Since 3.0.2
+    -- @since 3.0.2
     , settingsMaximumBodyFlush :: Maybe Int
     -- ^ See @setMaximumBodyFlush@.
     --
-    -- Since 3.0.3
+    -- @since 3.0.3
     , settingsProxyProtocol :: ProxyProtocol
     -- ^ Specify usage of the PROXY protocol.
     --
-    -- Since 3.0.5
+    -- @since 3.0.5
     , settingsSlowlorisSize :: Int
     -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048
     --
-    -- Since 3.1.2
+    -- @since 3.1.2
     , settingsHTTP2Enabled :: Bool
     -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True
     --
-    -- Since 3.1.7
+    -- @since 3.1.7
     , settingsLogger :: Request -> H.Status -> Maybe Integer -> IO ()
     -- ^ A log function. Default: no action.
     --
-    -- Since 3.1.10
+    -- @settingsLogger req status mSentBytes@
+    --
+    -- /N.B. @Maybe Integer@ is the concrete bytes of the message body/
+    -- /after all the headers have been sent. This is 'Nothing' when/
+    -- /'responseRaw' is used. (e.g. when using websockets)/
+    --
+    -- @since 3.1.10
     , settingsServerPushLogger :: Request -> ByteString -> Integer -> IO ()
     -- ^ A HTTP/2 server push log function. Default: no action.
     --
-    -- Since 3.2.7
+    -- @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
+    -- @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
+    -- @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
+    -- @since 3.3.5
     , settingsMaxTotalHeaderLength :: Int
     -- ^ Determines the maximum header size that Warp will tolerate when using HTTP/1.x.
     --
-    -- Since 3.3.8
+    -- @since 3.3.8
     , settingsAltSvc :: Maybe ByteString
     -- ^ Specify the header value of Alternative Services (AltSvc:).
     --
     -- Default: Nothing
     --
-    -- Since 3.3.11
+    -- @since 3.3.11
     , settingsMaxBuilderResponseBufferSize :: Int
     -- ^ Determines the maxium buffer size when sending `Builder` responses
     -- (See `responseBuilder`).
@@ -178,7 +204,7 @@
     --
     -- Default: 1049_000_000 = 1 MiB.
     --
-    -- Since 3.3.22
+    -- @since 3.3.22
     , settingsConnectionCounter :: Maybe Counter
     -- ^ A counter for tracking open connections.
     -- Use 'makeSettingsAndCounter' to create settings with a counter,
@@ -186,7 +212,27 @@
     --
     -- Default: 'Nothing' (warp creates an internal counter)
     --
-    -- Since 3.4.11
+    -- /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
+    , settingsUnsafeClose :: Bool
+    -- ^ Whether to close connections with network's 'unsafeClose' and
+    -- 'unsafeGracefulClose', which skip the IO manager.  Use this only if
+    -- no thread uses a connection's socket after warp closes it, which
+    -- 'responseRaw' applications cannot always promise.
+    --
+    -- Default: 'False'.
+    --
+    -- @since 3.4.21
     }
 
 -- | Specify usage of the PROXY protocol.
@@ -198,6 +244,87 @@
     | -- | 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.
+--
+-- Connections are considered "open" the moment they are accepted by the socket.
+--
+-- @since 3.4.13
+currentOpenConnections :: ServerState -> IO Int
+currentOpenConnections = getCount . serverConnectionCounter
+
+-- | Get the currently open connections of the server in an 'STM' transaction.
+--
+-- Connections are considered "open" the moment they are accepted by the socket.
+--
+-- @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
@@ -206,6 +333,7 @@
         { settingsPort = 3000
         , settingsHost = "*4"
         , settingsOnException = defaultOnException
+        , settingsOnConnectionException = Nothing
         , settingsOnExceptionResponse = defaultOnExceptionResponse
         , settingsOnOpen = const $ return True
         , settingsOnClose = const $ return ()
@@ -232,22 +360,34 @@
         , settingsAltSvc = Nothing
         , settingsMaxBuilderResponseBufferSize = 1049000000
         , settingsConnectionCounter = Nothing
+        , settingsServerState = Nothing
+        , settingsUnsafeClose = False
         }
 
--- | Create 'Settings' with a connection counter.
+-- | Create 'defaultSettings' with a connection counter.
 -- Use 'getCount' on the returned 'Counter' to check open connections.
 --
--- Since 3.4.11
+-- /DEPRECATED in favor of 'makeSettingsAndServerState'/
+--
+-- @since 3.4.11
 makeSettingsAndCounter :: IO (Counter, Settings)
 makeSettingsAndCounter = do
-    counter <- newCounter
-    pure (counter, defaultSettings{settingsConnectionCounter = Just counter})
+    (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.
 --
--- Since 2.1.3
+-- @since 2.1.3
 defaultShouldDisplayException :: SomeException -> Bool
 defaultShouldDisplayException se
     | Just (_ :: InvalidRequest) <- fromException se = False
@@ -260,7 +400,7 @@
 -- | Printing an exception to standard error
 --   if `defaultShouldDisplayException` returns `True`.
 --
--- Since: 3.1.0
+-- @since: 3.1.0
 defaultOnException :: Maybe Request -> SomeException -> IO ()
 defaultOnException _ e =
     when (defaultShouldDisplayException e) $
@@ -270,10 +410,12 @@
 
 -- | Sending 400 for bad requests.
 --   Sending 500 for internal server errors.
--- Since: 3.1.0
+-- @since: 3.1.0
 --   Sending 413 for too large payload.
 --   Sending 431 for too large headers.
--- Since 3.2.27
+-- @since 3.2.27
+--   Sending 501 for an unsupported transfer coding.
+-- @since 3.4.17
 defaultOnExceptionResponse :: SomeException -> Response
 defaultOnExceptionResponse e
     | isAsyncException e = throw e
@@ -287,6 +429,11 @@
             H.status431
             [(H.hContentType, "text/plain; charset=utf-8")]
             "Request header fields too large"
+    | Just UnsupportedTransferEncoding <- fromException e =
+        responseLBS
+            H.notImplemented501
+            [(H.hContentType, "text/plain; charset=utf-8")]
+            "Unsupported transfer coding"
     | Just (_ :: InvalidRequest) <- fromException e =
         responseLBS
             H.badRequest400
@@ -301,7 +448,7 @@
 -- | Exception handler for the debugging purpose.
 --   500, text/plain, a showed exception.
 --
--- Since: 2.0.3.2
+-- @since: 2.0.3.2
 exceptionResponseForDebug :: SomeException -> Response
 exceptionResponseForDebug e =
     responseBuilder
@@ -311,7 +458,7 @@
 
 -- | 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
+-- @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.
diff --git a/Network/Wai/Handler/Warp/ShuttingDown.hs b/Network/Wai/Handler/Warp/ShuttingDown.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Handler/Warp/ShuttingDown.hs
@@ -0,0 +1,34 @@
+-- Most important is to not export the data constructor from this module
+-- and to not expose 'writeShuttingDown' to the end user.
+module Network.Wai.Handler.Warp.ShuttingDown (
+    ShuttingDown,
+    newShuttingDown,
+    readShuttingDown,
+    readShuttingDownSTM,
+    writeShuttingDown,
+) where
+
+import Control.Concurrent.STM (
+    STM,
+    TVar,
+    atomically,
+    newTVarIO,
+    readTVar,
+    readTVarIO,
+    writeTVar,
+ )
+
+newtype ShuttingDown = ShuttingDown (TVar Bool)
+
+newShuttingDown :: IO ShuttingDown
+newShuttingDown = ShuttingDown <$> newTVarIO False
+
+readShuttingDown :: ShuttingDown -> IO Bool
+readShuttingDown (ShuttingDown var) = readTVarIO var
+
+readShuttingDownSTM :: ShuttingDown -> STM Bool
+readShuttingDownSTM (ShuttingDown var) = readTVar var
+
+writeShuttingDown :: ShuttingDown -> Bool -> IO ()
+writeShuttingDown (ShuttingDown var) b =
+    atomically $ writeTVar var b
diff --git a/Network/Wai/Handler/Warp/Types.hs b/Network/Wai/Handler/Warp/Types.hs
--- a/Network/Wai/Handler/Warp/Types.hs
+++ b/Network/Wai/Handler/Warp/Types.hs
@@ -1,13 +1,12 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Network.Wai.Handler.Warp.Types where
 
-import qualified Data.ByteString as S
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Typeable (Typeable)
+import Control.Concurrent.STM (TVar)
 import qualified Control.Exception as E
+import qualified Data.ByteString as S
+import Data.IORef (IORef, writeIORef, newIORef, readIORef)
 #ifdef MIN_VERSION_crypton_x509
 import Data.X509
 #endif
@@ -46,7 +45,27 @@
       PayloadTooLarge
     | -- | Since 3.3.22
       RequestHeaderFieldsTooLarge
-    deriving (Eq, Typeable)
+    | -- | A transfer coding warp does not implement. Since 3.4.17
+      UnsupportedTransferEncoding
+    | -- | The length of the request body cannot be determined
+      --   reliably, so no reading of it can be trusted. Since 3.4.17
+      AmbiguousBodyLength
+    | -- | CR or NUL inside a header field line, which one reader
+      --   takes for a line terminator where another reads data.
+      --   Since 3.4.17
+      BadHeaderLine
+    | -- | A header field name which is not a token, which hides the
+      --   field from one reader but not another.
+      --   Since 3.4.17
+      BadFieldName ByteString
+    | -- | A chunked request body that does not keep to the framing
+      --   RFC 9112 gives it. Since 3.4.17
+      BadChunkedBody
+    | -- | No @Host@ in a HTTP\/1.1 request, or more than one, which
+      --   a router and this server may read differently.
+      --   Since 3.4.19
+      BadHost
+    deriving (Eq)
 
 instance Show InvalidRequest where
     show (NotEnoughLines xs) = "Warp: Incomplete request headers, received: " ++ show xs
@@ -59,6 +78,12 @@
     show (BadProxyHeader s) = "Warp: Invalid PROXY protocol header: " ++ show s
     show RequestHeaderFieldsTooLarge = "Request header fields too large"
     show PayloadTooLarge = "Payload too large"
+    show UnsupportedTransferEncoding = "Warp: Unsupported transfer coding"
+    show AmbiguousBodyLength = "Warp: Ambiguous request body length"
+    show BadHeaderLine = "Warp: CR or NUL in a header field line"
+    show (BadFieldName n) = "Warp: Invalid header field name: " ++ show n
+    show BadChunkedBody = "Warp: Malformed chunked request body"
+    show BadHost = "Warp: Missing or repeated Host"
 
 instance E.Exception InvalidRequest
 
@@ -71,7 +96,7 @@
 -- Used to determine whether keeping the HTTP1.1 connection / HTTP2 stream alive is safe
 -- or irrecoverable.
 newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody E.SomeException
-    deriving (Show, Typeable)
+    deriving (Show)
 
 instance E.Exception ExceptionInsideResponseBody
 
@@ -81,7 +106,7 @@
 --   On Unix, a file descriptor would be specified to make use of
 --   the file descriptor cache.
 --
--- Since: 3.1.0
+-- @since 3.1.0
 data FileId = FileId
     { fileIdPath :: FilePath
     , fileIdFd :: Maybe Fd
@@ -89,7 +114,7 @@
 
 -- |  fileid, offset, length, hook action, HTTP headers
 --
--- Since: 3.1.0
+-- @since 3.1.0
 type SendFile = FileId -> Integer -> Integer -> IO () -> [ByteString] -> IO ()
 
 -- | A write buffer of a specified size
@@ -130,11 +155,20 @@
     , 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
     }
 
+-- This function isn't used nor exported...
 getConnHTTP2 :: Connection -> IO Bool
 getConnHTTP2 = readIORef . connHTTP2
 
+-- This doesn't need to be "atomic", since it is only really used for
+-- determining how long to wait before closing the socket in 'socketConnection'.
 setConnHTTP2 :: Connection -> Bool -> IO ()
 setConnHTTP2 = writeIORef . connHTTP2
 
@@ -150,6 +184,8 @@
 ----------------------------------------------------------------
 
 -- | Type for input streaming.
+--
+-- /Caveat: a 'Source' is meant to be used in one thread only./
 data Source = Source !(IORef ByteString) !(IO ByteString)
 
 mkSource :: IO ByteString -> IO Source
@@ -157,6 +193,7 @@
     ref <- newIORef S.empty
     return $! Source ref func
 
+-- | Caveats from 'Source' apply.
 readSource :: Source -> IO ByteString
 readSource (Source ref func) = do
     bs <- readIORef ref
@@ -167,9 +204,12 @@
             return bs
 
 -- | Read from a Source, ignoring any leftovers.
+--
+-- /Caveats from 'Source' apply./
 readSource' :: Source -> IO ByteString
 readSource' (Source _ func) = func
 
+-- | Caveats from 'Source' apply.
 leftoverSource :: Source -> ByteString -> IO ()
 leftoverSource (Source ref _) = writeIORef ref
 
diff --git a/bench/Parser.hs b/bench/Parser.hs
--- a/bench/Parser.hs
+++ b/bench/Parser.hs
@@ -19,6 +19,7 @@
 import Prelude hiding (lines)
 
 import Network.Wai.Handler.Warp.Request (FirstRequest (..), headerLines)
+import Network.Wai.Handler.Warp.Response (containsRecoverableWhitespace)
 import Network.Wai.Handler.Warp.Types
 
 import Criterion.Main
@@ -54,6 +55,16 @@
             , bench "new parsing 25" $ whnfAppIO testIt (chunkRequest 25)
             , bench "new parsing 100" $ whnfAppIO testIt (chunkRequest 100)
             ]
+        , bgroup
+            "containsRecoverableWhitespace"
+            -- Clean values (no CR/LF/NUL) are the overwhelmingly common case and
+            -- the one the fast path must stay cheap for; the dirty case is
+            -- what forces a rebuild in 'sanitizeHeaders'.
+            [ bench "clean short" $ whnf containsRecoverableWhitespace "Mighttpd/2.5.8"
+            , bench "clean long" $ whnf containsRecoverableWhitespace cleanLong
+            , bench "dirty" $
+                whnf containsRecoverableWhitespace "text/html\r\nInjected: header"
+            ]
         ]
   where
     testIt req = producer req >>= headerLines 800 FirstRequest
@@ -241,6 +252,11 @@
                      in return $! (method, rpath, qstring, hv)
                 else throwIO NonHttp
         _ -> throwIO $ BadFirstLine $ B.unpack s
+
+-- A long, clean header value (no CR/LF): forces the memchr scan to walk the
+-- whole value before deciding it is clean.
+cleanLong :: S.ByteString
+cleanLong = S.replicate 512 _A
 
 producer :: [ByteString] -> IO Source
 producer a = do
diff --git a/bench/ResponseBench.hs b/bench/ResponseBench.hs
new file mode 100644
--- /dev/null
+++ b/bench/ResponseBench.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | End-to-end benchmark of the response path: everything 'sendResponse'
+-- does per response except the actual socket write (the Connection is a
+-- sink). Covers header sanitization, indexing, Server/Date insertion,
+-- header composition, chunking, buffer management and timeout handling.
+module Main (main) where
+
+import Control.Concurrent.STM (newTVarIO)
+import Control.Monad (replicateM_)
+import Criterion.Main
+import Data.ByteString.Builder (byteString)
+import Data.IORef (newIORef)
+import qualified Network.HTTP.Types as H
+import qualified Network.HTTP.Types.Header as H
+import Network.Socket (SockAddr (..))
+import Network.Wai (defaultRequest)
+import Network.Wai.Internal (Request (..), Response (..))
+import qualified System.TimeManager as T
+
+import Network.Wai.Handler.Warp.Buffer (createWriteBuffer)
+import Network.Wai.Handler.Warp.Header
+import Network.Wai.Handler.Warp.Response (sendResponse)
+import Network.Wai.Handler.Warp.ResponseHeader (composeHeader)
+import Network.Wai.Handler.Warp.Settings (defaultSettings)
+import Network.Wai.Handler.Warp.Types
+
+main :: IO ()
+main = do
+    writeBuf <- createWriteBuffer 16384 >>= newIORef
+    http2Ref <- newIORef False
+    apps <- newTVarIO (0 :: Int)
+    let conn =
+            Connection
+                { connSendMany = \_ -> return ()
+                , connSendAll = \_ -> return ()
+                , connSendFile = \_ _ _ _ _ -> return ()
+                , connClose = return ()
+                , connRecv = return ""
+                , connRecvBuf = \_ _ -> return True
+                , connWriteBuffer = writeBuf
+                , connHTTP2 = http2Ref
+                , connMySockAddr = SockAddrInet 0 0
+                , connAppsInProgress = apps
+                }
+    mgr <- T.initialize 30000000
+    th <- T.register mgr (return ())
+    let ii =
+            InternalInfo
+                { timeoutManager = mgr
+                , getDate = return "Fri, 18 Jul 2026 12:00:00 GMT"
+                , getFd = \_ -> return (Nothing, return ())
+                , getFileInfo = \_ -> ioError (userError "no file info in bench")
+                }
+        req = defaultRequest{httpVersion = H.http11, requestMethod = H.methodGet}
+        reqidxhdr = indexRequestHeader reqHdrs
+        send = sendResponse defaultSettings conn ii th req reqidxhdr (return "")
+    defaultMain
+        [ bgroup
+            "sendResponse"
+            [ bench "builder 4 headers content-length" $ whnfIO $ send (rspB hdrs4)
+            , bench "builder 3 headers chunked" $ whnfIO $ send (rspB hdrs3NoCL)
+            , bench "builder 20 headers content-length" $ whnfIO $ send (rspB hdrs20)
+            , bench "no body 204" $ whnfIO $ send rsp204
+            , bench "stream 64 fragments" $ whnfIO $ send (rspS 64)
+            ]
+        , bgroup
+            "headers"
+            [ bench "composeHeader 5 headers" $
+                whnfIO $
+                    composeHeader H.http11 H.status200 hdrs5
+            , bench "indexRequestHeader" $ whnf indexRequestHeader reqHdrs
+            , bench "indexResponseHeader" $ whnf indexResponseHeader hdrs5
+            ]
+        ]
+  where
+    body = byteString "Hello, World!"
+    rspB hs = ResponseBuilder H.status200 hs body
+    -- One fragment per write/flush pair, the shape an SSE-style body has.
+    rspS n = ResponseStream H.status200 hdrs3NoCL $ \write flush ->
+        replicateM_ n (write body >> flush)
+    rsp204 = ResponseBuilder H.status204 [] mempty
+    reqHdrs =
+        [ (H.hHost, "127.0.0.1:3011")
+        , (H.hUserAgent, "wrk/4.2.0")
+        , (H.hAccept, "*/*")
+        , ("Accept-Encoding", "gzip, deflate")
+        , (H.hConnection, "keep-alive")
+        ]
+    hdrs4 =
+        [ (H.hContentType, "text/plain; charset=utf-8")
+        , (H.hContentLength, "13")
+        , (H.hCacheControl, "no-cache")
+        , ("X-Request-Id", "0123456789abcdef")
+        ]
+    hdrs3NoCL =
+        [ (H.hContentType, "text/plain; charset=utf-8")
+        , (H.hCacheControl, "no-cache")
+        , ("X-Request-Id", "0123456789abcdef")
+        ]
+    -- what composeHeader sees after warp added Server and Date
+    hdrs5 =
+        (H.hServer, "Warp/3.4.15")
+            : (H.hDate, "Fri, 18 Jul 2026 12:00:00 GMT")
+            : hdrs3NoCL
+    hdrs20 =
+        hdrs4
+            ++ [ (H.hCacheControl, "private, max-age=0")
+               , ("ETag", "\"33a64df551425fcc55e4d42a148795d9f25f89d4\"")
+               , (H.hLastModified, "Wed, 21 Oct 2015 07:28:00 GMT")
+               , ("X-Frame-Options", "SAMEORIGIN")
+               , ("X-Content-Type-Options", "nosniff")
+               , ("X-XSS-Protection", "1; mode=block")
+               , ("Strict-Transport-Security", "max-age=31536000; includeSubDomains")
+               , ("Content-Security-Policy", "default-src 'self'")
+               , ("Referrer-Policy", "strict-origin-when-cross-origin")
+               , ("Access-Control-Allow-Origin", "*")
+               , ("Vary", "Accept-Encoding")
+               , ("Set-Cookie", "session=abc123; Path=/; HttpOnly; Secure")
+               , ("X-Runtime", "0.012345")
+               , ("X-Served-By", "cache-lhr-1234")
+               , ("Age", "0")
+               , ("Via", "1.1 varnish")
+               ]
diff --git a/test/BufferSpec.hs b/test/BufferSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/BufferSpec.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module BufferSpec (main, spec) where
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Builder as BLD
+import Data.IORef as I
+import Network.Wai.Handler.Warp.Buffer (createWriteBuffer)
+import Network.Wai.Handler.Warp.IO (toBufIOWith)
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck (NonNegative (..))
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = describe "toBufIOWith" $ do
+    it "counts short bytestrings" $
+        testBufIOWith 10
+    -- This failed before fixing 'toBufIOWith'
+    it "counts long bytestrings" $ do
+        testBufIOWith 1000000
+    modifyMaxSize (const 10000000) . prop "counts bytestrings of different sizes" $
+        \(NonNegative i) -> testBufIOWith i
+
+testBufIOWith :: Int -> Expectation
+testBufIOWith bsLen = do
+    len <- toBufIOWithBuilder $ BLD.byteString $ S.replicate bsLen 0
+    len `shouldBe` fromIntegral bsLen
+
+toBufIOWithBuilder :: BLD.Builder -> IO Integer
+toBufIOWithBuilder bld = do
+    countRef <- newIORef 0 :: IO (IORef Int)
+    buf <- createWriteBuffer 16384
+    bufRef <- newIORef buf
+    let go bs = modifyIORef' countRef (+ S.length bs)
+    toBufIOWith 1049000000 bufRef go bld
diff --git a/test/ConnectionExceptionSpec.hs b/test/ConnectionExceptionSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/ConnectionExceptionSpec.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ConnectionExceptionSpec (spec) where
+
+import Control.Concurrent (Chan, newChan, readChan, writeChan, newEmptyMVar, putMVar, takeMVar, tryPutMVar)
+import Control.Concurrent.Async (link, withAsync)
+import Control.Exception (Exception, SomeException, bracket, finally, fromException, throwIO, toException)
+import Control.Monad (forM_, replicateM, void)
+import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef')
+import Data.Maybe (isJust)
+import qualified Data.Streaming.Network as N
+import Network.HTTP.Types (internalServerError500)
+import Network.Socket (SockAddr (SockAddrInet), close, tupleToHostAddress)
+import Network.Wai (remoteHost)
+import Network.Wai.Handler.Warp
+import Network.Wai.Handler.Warp.Internal (runSettingsConnectionMakerSecure)
+import System.Timeout (timeout)
+import Test.Hspec
+
+import HTTP (responseStatus, sendGET)
+
+-- Regression for https://github.com/yesodweb/wai/issues/1113. A connection
+-- maker can fail before any Request exists, but Warp already owns its peer.
+data ConnectionFailure = ConnectionFailure Int deriving (Show)
+instance Exception ConnectionFailure
+
+type Observation = (Int, Maybe SockAddr)
+
+spec :: Spec
+spec = describe "connection exception peer" $ do
+    it "preserves the legacy observer when no peer observer is installed" $ do
+        events <- newChan
+        makers <- newChan
+        let settings = setOnException (\request -> record events (remoteHost <$> request)) defaultSettings
+        withAsync (runSettingsConnectionMakerSecure settings (readChan makers) unusedApplication) $ \server -> do
+            link server
+            writeChan makers (throwIO (ConnectionFailure 1), peer 100)
+            timeout 2000000 (readChan events) `shouldReturn` Just (1, Nothing)
+
+    it "gets the current legacy observer as the default connection observer" $ do
+        events <- newChan
+        let settings = setOnException (\request -> record events (remoteHost <$> request)) defaultSettings
+        getOnConnectionException settings (peer 110) (toException (ConnectionFailure 2))
+        timeout 2000000 (readChan events) `shouldReturn` Just (2, Nothing)
+
+    it "uses only the connection observer regardless of setter order" $
+        forM_ [False, True] $ \legacyLast -> do
+            calls <- newIORef ([] :: [String])
+            let legacy _ _ = modifyIORef' calls (++ ["legacy"])
+                connection _ _ = modifyIORef' calls (++ ["connection"])
+                settings = if legacyLast
+                    then setOnException legacy $ setOnConnectionException connection defaultSettings
+                    else setOnConnectionException connection $ setOnException legacy defaultSettings
+            getOnConnectionException settings (peer 120) (toException (ConnectionFailure 3))
+            readIORef calls `shouldReturn` ["connection"]
+
+    it "keeps accept failures on the legacy observer because no peer was obtained" $ do
+        calls <- newIORef ([] :: [(String, Bool)])
+        let legacy request _ = modifyIORef' calls (++ [("legacy", isJust request)])
+            connection _ _ = modifyIORef' calls (++ [("connection", False)])
+            settings = setOnException legacy $ setOnConnectionException connection defaultSettings
+        runSettingsConnectionMakerSecure settings (ioError (userError "accept failed")) unusedApplication
+        readIORef calls `shouldReturn` [("legacy", False)]
+
+    it "keeps application exceptions on the legacy observer with their request" $
+        bracket (N.bindRandomPortTCP "127.0.0.1") (close . snd) $ \(port, listener) -> do
+            events <- newChan
+            connectionCalled <- newIORef False
+            ready <- newEmptyMVar
+            let legacy request exception = writeChan events (isJust request, show exception)
+                connection _ _ = writeIORef connectionCalled True
+                settings = setBeforeMainLoop (putMVar ready ())
+                    $ setOnException legacy
+                    $ setOnConnectionException connection defaultSettings
+                application _ _ = throwIO (ConnectionFailure 4)
+            withAsync (runSettingsSocket settings listener application) $ \server -> do
+                link server
+                timeout 2000000 (takeMVar ready) `shouldReturn` Just ()
+                response <- sendGET ("http://127.0.0.1:" ++ show port ++ "/")
+                responseStatus response `shouldBe` internalServerError500
+                timeout 2000000 (readChan events) `shouldReturn` Just (True, "ConnectionFailure 4")
+                readIORef connectionCalled `shouldReturn` False
+
+    it "reports each sequential connection maker's own peer" $ do
+        events <- newChan
+        makers <- newChan
+        let settings = observePeer (record events) defaultSettings
+        withAsync (runSettingsConnectionMakerSecure settings (readChan makers) unusedApplication) $ \server -> do
+            link server
+            forM_ [(5, 130), (6, 140)] $ \(failureId, peerId) -> do
+                writeChan makers (throwIO (ConnectionFailure failureId), peer peerId)
+                timeout 2000000 (readChan events) `shouldReturn` Just (failureId, Just (peer peerId))
+
+    it "reports peers when overlapping connection makers fail in reverse order" $ do
+        events <- newChan
+        makers <- newChan
+        started <- newChan
+        first <- newEmptyMVar
+        second <- newEmptyMVar
+        let settings = observePeer (record events) defaultSettings
+            maker i gate = writeChan started i >> takeMVar gate >> throwIO (ConnectionFailure i)
+        withAsync (runSettingsConnectionMakerSecure settings (readChan makers) unusedApplication) $ \server -> do
+            link server
+            writeChan makers (maker 7 first, peer 150)
+            writeChan makers (maker 8 second, peer 160)
+            -- Release both workers even when a readiness assertion fails.
+            let release = forM_ [first, second] $ \gate -> void (tryPutMVar gate ())
+            flip finally release $ do
+                ready <- timeout 2000000 (replicateM 2 (readChan started))
+                fmap length ready `shouldBe` Just 2
+                putMVar second ()
+                secondEvent <- timeout 2000000 (readChan events)
+                putMVar first ()
+                firstEvent <- timeout 2000000 (readChan events)
+                (secondEvent, firstEvent) `shouldBe` (Just (8, Just (peer 160)), Just (7, Just (peer 150)))
+  where
+    unusedApplication _ _ = fail "connection maker must fail before the application"
+
+-- Install the peer observer used by the regression assertions. The original
+-- failing commit had to infer peers from Maybe Request.
+observePeer :: (Maybe SockAddr -> SomeException -> IO ()) -> Settings -> Settings
+observePeer report = setOnConnectionException (report . Just)
+
+record :: Chan Observation -> Maybe SockAddr -> SomeException -> IO ()
+record events address exception = case fromException exception of
+    Just (ConnectionFailure i) -> writeChan events (i, address)
+    Nothing -> throwIO exception
+
+peer :: Int -> SockAddr
+peer i = SockAddrInet (fromIntegral (40000 + i)) (tupleToHostAddress (127, 0, 0, fromIntegral i))
diff --git a/test/ConnectionSpec.hs b/test/ConnectionSpec.hs
--- a/test/ConnectionSpec.hs
+++ b/test/ConnectionSpec.hs
@@ -2,73 +2,80 @@
 
 module ConnectionSpec (spec) where
 
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as S8
 import Network.HTTP.Types
 import Network.Wai
 import Network.Wai.Handler.Warp
-import RunSpec (withApp, withMySocket, msWrite, msRead)
+import RunSpec (msRead, msWrite, withApp, withMySocket)
 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"
+    describe "HTTP/1.0 Connection: close behavior" $ 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.
+        -- (In HTTP/1.0 this requires closing the connection to delimit the
+        -- response; or rather, lack of persistence info)
+        testClose
+            "when response implies close (HTTP/1.0 Keep-Alive, but no Content-Length)"
+            (responseLBS status200 [] "foo")
+            "GET / HTTP/1.0\r\nConnection: Keep-Alive\r\n\r\n"
+        testClose
+            "sends \"Connection: close\" on regular HTTP/1.0 GET request"
+            (responseBuilder status200 [] "foo")
+            "GET / HTTP/1.0\r\nHost: localhost\r\n\r\n"
+
+    describe "HTTP/1.1 Connection: close behavior" $ do
+        -- Response has no Content-Length and is not chunked (HEAD implies no body).
+        it "does NOT send \"Connection: close\" for HTTP/1.1 HEAD request" $ do
+            let app _ f = f $ responseBuilder 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 
+                msWrite ms "HEAD / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+                -- Should include the Connection header if present and also
+                -- should be less then all headers when it's absent, so we
+                -- don't wait for nothing.
+                response <- msRead ms 73
+                let headers = parseHeaders response
+                lookup "Connection" headers `shouldBe` Nothing
+        testClose
+            "when GET request has \"Connection: close\" (200 OK)"
+            (responseLBS status200 [] "foo")
+            "GET / HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"
+        testClose
+            "when HEAD request has \"Connection: close\" (200 OK)"
+            (responseLBS status200 [] "foo")
+            "HEAD / HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"
+        testClose
+            "when request has \"Connection: close\" (204 No Content)"
+            (responseLBS status204 [] "")
+            "GET / HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"
+        testClose
+            "when request has \"Connection: close\" (500 Internal Server Error)"
+            (responseLBS status500 [] "error")
+            "GET / HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n"
+  where
+    testClose name res input = do
+        let prefix = "sends \"Connection: close\" "
+        it (prefix <> name) $ do
+            let app _ f = f res
+            withApp defaultSettings app $ withMySocket $ \ms -> do
+                msWrite ms input
+                -- 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
+parseHeaders bs =
+    let allLines = S8.lines bs
         -- Drop status line
-        headerLines = takeWhile (not . S8.null . S8.filter (/= '\r')) $ drop 1 lines
-        parseLine line = 
+        headerLines = takeWhile (not . S8.null . S8.filter (/= '\r')) $ drop 1 allLines
+        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
+             in (k, S8.dropWhile (== ' ') $ S8.drop 1 v')
+     in map parseLine headerLines
diff --git a/test/EarlyHintsSpec.hs b/test/EarlyHintsSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/EarlyHintsSpec.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module EarlyHintsSpec (spec) where
+
+import Test.Hspec
+
+#define HAS_EARLY_HINTS_SUPPORT (MIN_VERSION_http_semantics(0,4,1) && MIN_VERSION_http2(5,4,2))
+
+#if HAS_EARLY_HINTS_SUPPORT
+import Control.Exception (bracket)
+import Data.ByteString (ByteString)
+import Data.IORef
+import Network.HPACK (TokenHeaderTable, getFieldValue)
+import Network.HPACK.Token (toToken)
+import Network.HTTP.Types (Status, methodGet, ok200, status200, status404)
+import qualified Network.HTTP2.Client as C
+import Network.Socket
+import Network.Wai
+import Network.Wai.Handler.Warp (Port, testWithApplication)
+
+spec :: Spec
+spec = describe "HTTP/2 Early Hints" $
+    it "delivers a WAI app's 103 Early Hints to the client before the final response (h2c)" $
+#ifdef WINDOWS
+        -- This test is failing on Windows (it hangs at @C.run@)
+        pendingWith "requires more testing on a Windows machine"
+#else
+        testWithApplication (pure app) $ \port -> do
+            hintsRef <- newIORef []
+            earlyHintsClient port hintsRef `shouldReturn` Just ok200
+            hints <- readIORef hintsRef
+            map (getFieldValue (toToken "link") . snd) hints
+                `shouldBe` (Just <$> earlyResponses)
+
+-- | The @Link@ header values delivered as Early Hints, in order.
+earlyResponses :: [ByteString]
+earlyResponses =
+    [ "</style.css>; rel=preload; as=style"
+    , "</app.js>; rel=preload; as=script"
+    ]
+
+-- | A WAI app that emits two Early Hints sections, then the final response.
+app :: Application
+app req respond
+    | pathInfo req == ["early"] = do
+        mapM_ (\link -> requestSendEarlyHints req [("link", link)]) earlyResponses
+        respond $ responseLBS status200 [("content-type", "text/plain")] "Hello"
+    | otherwise = respond $ responseLBS status404 [] ""
+
+-- | Drive Warp over h2c with the HTTP/2 client, recording each 103 Early Hints
+--   section via the client's informational handler, and return the final status.
+earlyHintsClient :: Port -> IORef [TokenHeaderTable] -> IO (Maybe Status)
+earlyHintsClient port hintsRef = withTCP "127.0.0.1" port $ \sock ->
+    bracket (C.allocSimpleConfig sock 4096) C.freeSimpleConfig $ \conf ->
+        C.run cliconf (conf{C.confOnInformational = onInformational}) $ \sendRequest _aux ->
+            sendRequest (C.requestNoBody methodGet "/early" []) (return . C.responseStatus)
+  where
+    cliconf = C.defaultClientConfig{C.authority = "127.0.0.1"}
+    onInformational _streamId tbl = modifyIORef' hintsRef (++ [tbl])
+
+-- | Connect to a TCP server, run an action, and close the socket afterwards.
+withTCP :: HostName -> Port -> (Socket -> IO a) -> IO a
+withTCP host port = bracket open close
+  where
+    open = do
+        addr : _ <- getAddrInfo (Just defaultHints{addrSocketType = Stream}) (Just host) (Just (show port))
+        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+        connect sock (addrAddress addr)
+        return sock
+#endif
+#else
+spec :: Spec
+spec = describe "HTTP/2 Early Hints" $
+    it "delivers a WAI app's 103 Early Hints to the client before the final response (h2c)" $
+        pendingWith "requires http2 >= 5.4.2 and http-semantics >= 0.4.1"
+#endif
diff --git a/test/FileSpec.hs b/test/FileSpec.hs
--- a/test/FileSpec.hs
+++ b/test/FileSpec.hs
@@ -130,3 +130,29 @@
             "gives the entire body and ignores the Range header if the condition isn't met"
             [("If-Range", farPast), ("Range", "bytes=2-7")]
             regularBody
+        -- A range which asks for nothing the file holds.  The first
+        -- of these used to be a negative length, which left the
+        -- request answered with nothing at all.
+        testFileRange
+            "returns a 416 for a range which begins past the end"
+            [("Range", "bytes=100-")]
+            $ WithoutBody status416
+        testFileRange
+            "returns a 416 for a range which begins at the end"
+            [("Range", "bytes=16-")]
+            $ WithoutBody status416
+        testFileRange
+            "returns a 416 for a suffix of no bytes"
+            [("Range", "bytes=-0")]
+            $ WithoutBody status416
+        -- RFC 9110, section 14.1.2: a suffix longer than the file asks
+        -- for the whole of it, which is not a range at all and so is a
+        -- 200 rather than a 206.
+        testFileRange
+            "gives the whole file for a suffix longer than it is"
+            [("Range", "bytes=-100")]
+            regularBody
+        testFileRange
+            "gives the whole file for a suffix exactly as long as it is"
+            [("Range", "bytes=-16")]
+            regularBody
diff --git a/test/GracefulShutdownSpec.hs b/test/GracefulShutdownSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/GracefulShutdownSpec.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+
+module GracefulShutdownSpec (spec) where
+
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Exception (bracket)
+import qualified Control.Exception as E
+import Control.Monad (void)
+import Data.IORef
+import Network.HTTP.Client
+import Network.HTTP.Types (ok200, status200)
+import Network.Socket
+import Network.Socket.ByteString (sendAll)
+import Network.Wai (responseLBS)
+import Network.Wai.Handler.Warp
+import System.ThreadManager (KilledByThreadManager (..))
+import System.Timeout (timeout)
+import Test.Hspec
+
+spec :: Spec
+spec = describe "graceful shutdown" $ do
+    it "kills what it is still serving when it is killed itself (#1126)" $ do
+        -- Warp forks a thread per connection, and nothing in the runtime
+        -- makes those the children of the thread running the server.  An
+        -- asynchronous exception to that thread used to leave them running.
+        servingNow <- newEmptyMVar
+        killed <- newEmptyMVar
+        let app _ respond =
+                ( do
+                    putMVar servingNow ()
+                    threadDelay 10_000_000
+                    respond $ responseLBS status200 [] ""
+                )
+                    `E.catch` \e -> putMVar killed e >> E.throwIO e
+        bracket openFreePort (close . snd) $ \(testPort, sock) -> do
+            server <- forkIO $ runSettingsSocket defaultSettings sock app
+            client <- openConnection testPort
+            sendAll client "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+            -- The application is in the middle of the request.
+            timeout 2_000_000 (takeMVar servingNow) `shouldReturn` Just ()
+            killThread server
+            timeout 2_000_000 (byManager <$> takeMVar killed) `shouldReturn` Just True
+            close client
+
+    it "kills a connection forked but not yet scheduled (#1126)" $ do
+        -- The thread records itself, so between the accept loop keeping a
+        -- place for it and the thread being scheduled there is nothing to
+        -- kill.  A 'settingsFork' which does not schedule at once -- what
+        -- the reporter of #1126 sets -- makes the window wide.
+        servingNow <- newEmptyMVar
+        forked <- newEmptyMVar
+        let app _ respond = do
+                putMVar servingNow ()
+                threadDelay 10_000_000
+                respond $ responseLBS status200 [] ""
+            set =
+                setFork
+                    ( \io -> void $ forkIOWithUnmask $ \unmask -> do
+                        -- Forked, with its place kept and not yet taken.
+                        putMVar forked ()
+                        threadDelay 300_000
+                        io unmask
+                    )
+                    defaultSettings
+        bracket openFreePort (close . snd) $ \(testPort, sock) -> do
+            server <- forkIO $ runSettingsSocket set sock app
+            client <- openConnection testPort
+            sendAll client "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+            timeout 2_000_000 (takeMVar forked) `shouldReturn` Just ()
+            killThread server
+            timeout 2_000_000 (takeMVar servingNow) `shouldReturn` Nothing
+            close client
+
+    it "waits for a connection accepted just before it stopped accepting" $ do
+        -- The window is between accepting a connection and the thread
+        -- serving it being scheduled. Delaying the thread makes it wide
+        -- enough to test; in a running server it is however long the RTS
+        -- takes to get to the new thread.
+        accepted <- newEmptyMVar
+        stopSlot <- newEmptyMVar
+        closed <- newIORef (0 :: Int)
+
+        let slowFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
+            slowFork act = do
+                -- A connection has been accepted.  Said here, where the
+                -- accept loop still is, rather than in the thread below,
+                -- which is the one being kept from running.
+                void $ tryPutMVar accepted ()
+                void $ forkIOWithUnmask $ \unmask -> do
+                    threadDelay 200_000
+                    act unmask
+
+            settings =
+                setFork slowFork $
+                    setInstallShutdownHandler (putMVar stopSlot) $
+                        setOnClose (\_ -> atomicModifyIORef' closed $ \n -> (n + 1, ())) $
+                            setGracefulShutdownTimeout (Just 5) $
+                                setOnException (\_ _ -> pure ()) defaultSettings
+
+            app _ respond = respond $ responseLBS status200 [("Content-Length", "0")] ""
+
+        bracket openFreePort (close . snd) $ \(testPort, sock) -> do
+            -- Connect before the server exists. openFreePort has already put
+            -- the socket in listen state, so this lands in its accept queue
+            -- in the kernel and stays there: closing the client end sends a
+            -- FIN but does not take it off the queue, and accept() still
+            -- hands it over. Queueing it up front is what makes the accept
+            -- loop's first accept() return immediately, rather than racing a
+            -- client connecting alongside it, which on a loaded machine it
+            -- can lose.
+            bracket (openConnection testPort) close $ \_ -> pure ()
+
+            withAsync (runSettingsSocket settings sock app) $ \server -> do
+                stopAccepting <- takeMVar stopSlot
+                -- The connection is accepted and the thread serving it is
+                -- still parked, which is the window this is about.
+                takeMVar accepted
+                stopAccepting
+                timeout 30_000_000 (wait server)
+                    >>= maybe (expectationFailure "Timeout waiting for server shutdown") pure
+                -- Returning is what lets the process exit, so a connection
+                -- still open here is one the client never hears back on.
+                connectionsClosed <- readIORef closed
+                connectionsClosed `shouldBe` 1
+
+    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
+    openConnection testPort = do
+        client <- socket AF_INET Stream defaultProtocol
+        connect client $
+            SockAddrInet (fromIntegral testPort) (tupleToHostAddress (127, 0, 0, 1))
+        pure client
+    -- set number of clients to the number of keep-alive connections
+    numClients = managerConnCount defaultManagerSettings
+    connectionRefused = \case
+        (HttpExceptionRequest _ (ConnectionFailure _)) -> True
+        _ -> False
+
+-- | Whether the exception is the one the thread manager kills a thread with.
+byManager :: E.SomeException -> Bool
+byManager e = case E.fromException e of
+    Just (KilledByThreadManager _) -> True
+    Nothing -> False
diff --git a/test/HTTP2Spec.hs b/test/HTTP2Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/HTTP2Spec.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module HTTP2Spec (spec) where
+
+import Control.Concurrent (threadDelay)
+import Control.Exception (bracket, throwIO)
+import Data.ByteString (ByteString)
+import Data.IORef
+import Network.HTTP.Types (Status, ok200, status200)
+import qualified Network.HTTP2.Client as C
+import Network.Socket
+import Network.Wai
+import Network.Wai.Handler.Warp (
+    Port,
+    defaultSettings,
+    setLogger,
+    setOnException,
+    withApplicationSettings,
+ )
+import Test.Hspec
+
+spec :: Spec
+spec = describe "http2server" $ do
+    it "reports nothing for a connection the client closes" $ do
+        excs <- newIORef []
+        let settings = setOnException (\_ e -> modifyIORef' excs (show e :)) defaultSettings
+        withApplicationSettings settings (pure hello) $ \port -> do
+            get port `shouldReturn` (Just ok200, "hello")
+            -- The connection ends once the client has closed it.
+            threadDelay 100000
+            -- http2's ConnectionIsClosed used to be reported here.
+            readIORef excs `shouldReturn` []
+    it "keeps the response of an application which throws after it" $ do
+        excs <- newIORef (0 :: Int)
+        logged <- newIORef []
+        let settings =
+                setLogger (\_ st _ -> modifyIORef' logged (st :)) $
+                    setOnException (\_ _ -> modifyIORef' excs (+ 1)) defaultSettings
+        withApplicationSettings settings (pure app) $ \port -> do
+            get port `shouldReturn` (Just ok200, "hello")
+            readIORef excs `shouldReturn` 1
+            -- The second response used to go out and be logged, so the
+            -- log said 500 where the client had been answered 200.
+            readIORef logged `shouldReturn` [ok200]
+
+hello :: Application
+hello _ respond = respond $ responseLBS status200 [] "hello"
+
+-- | Answers, then throws.  The response has gone out by then, so
+--   nothing can replace it.
+app :: Application
+app _ respond = do
+    _ <- respond $ responseLBS status200 [] "hello"
+    throwIO $ userError "after the response"
+
+-- | The status and body of one h2c request.
+get :: Port -> IO (Maybe Status, ByteString)
+get port = withTCP "127.0.0.1" port $ \sock ->
+    bracket (C.allocSimpleConfig sock 4096) C.freeSimpleConfig $ \conf ->
+        C.run cliconf conf $ \sendRequest _aux ->
+            sendRequest (C.requestNoBody "GET" "/" []) $ \rsp -> do
+                body <- C.getResponseBodyChunk rsp
+                return (C.responseStatus rsp, body)
+  where
+    cliconf = C.defaultClientConfig{C.authority = "127.0.0.1"}
+
+-- | Connect to a TCP server, run an action, and close the socket afterwards.
+withTCP :: HostName -> Port -> (Socket -> IO a) -> IO a
+withTCP host port = bracket open close
+  where
+    open = do
+        addr : _ <- getAddrInfo (Just defaultHints{addrSocketType = Stream}) (Just host) (Just (show port))
+        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+        connect sock (addrAddress addr)
+        return sock
diff --git a/test/PackIntSpec.hs b/test/PackIntSpec.hs
--- a/test/PackIntSpec.hs
+++ b/test/PackIntSpec.hs
@@ -12,3 +12,9 @@
     prop "" $ \(QC.Large n) ->
         let n' = fromIntegral (abs n :: Int)
          in packIntegral (n' :: Int) == C8.pack (show n')
+    -- Every power of ten from 10^15 up used to be written into a buffer
+    -- one byte too small for it.
+    it "writes a number of any size" $
+        let ns = [10 ^ e + d | e <- [0 .. 40 :: Int], d <- [-1, 0, 1 :: Integer]]
+         in map packIntegral (filter (>= 0) ns)
+                `shouldBe` map (C8.pack . show) (filter (>= 0) ns)
diff --git a/test/ResponseSpec.hs b/test/ResponseSpec.hs
--- a/test/ResponseSpec.hs
+++ b/test/ResponseSpec.hs
@@ -16,6 +16,22 @@
 main :: IO ()
 main = hspec spec
 
+testUnsatisfiable
+    :: S.ByteString
+    -- ^ range value
+    -> Spec
+testUnsatisfiable range = 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 ms 1024
+    head bss `shouldContain` "416"
+  where
+    app _ = ($ responseFile status200 [] "attic/hex" Nothing)
+    title = show range ++ " is not satisfiable"
+
 testRange
     :: S.ByteString
     -- ^ range value
@@ -73,42 +89,26 @@
 
 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.
-    -}
-
     describe "sanitizeHeaderValue" $ do
-        it "doesn't alter valid multiline header values" $ do
-            sanitizeHeaderValue "foo\r\n bar" `shouldBe` "foo\r\n bar"
-
-        it "adds missing spaces after \r\n" $ do
-            sanitizeHeaderValue "foo\r\nbar" `shouldBe` "foo\r\n bar"
-
-        it "discards empty lines" $ do
-            sanitizeHeaderValue "foo\r\n\r\nbar" `shouldBe` "foo\r\n bar"
-
-        context "when sanitizing single occurrences of \n" $ do
-            it "replaces \n with \r\n" $ do
-                sanitizeHeaderValue "foo\n bar" `shouldBe` "foo\r\n bar"
-
-            it "adds missing spaces after \n" $ do
-                sanitizeHeaderValue "foo\nbar" `shouldBe` "foo\r\n bar"
-
-        it "discards single occurrences of \r" $ do
-            sanitizeHeaderValue "foo\rbar" `shouldBe` "foobar"
+        it "replaces multiline header value's [CR LF NUL] with SP" $ do
+            sanitizeHeaderValue "foo\r\n bar" `shouldBe` "foo   bar"
+            sanitizeHeaderValue "foo\r\n\NULbar" `shouldBe` "foo   bar"
+            sanitizeHeaderValue "foo\r\n\r\nbar" `shouldBe` "foo    bar"
+            sanitizeHeaderValue "foo\n bar" `shouldBe` "foo  bar"
+            sanitizeHeaderValue "foo\nbar" `shouldBe` "foo bar"
+            sanitizeHeaderValue "foo\rbar" `shouldBe` "foo bar"
+            sanitizeHeaderValue "foo\NULbar" `shouldBe` "foo bar"
 
     describe "range requests" $ do
         testRange "2-3" "23" $ Just "2-3/16"
         testRange "5-" "56789abcdef" $ Just "5-15/16"
         testRange "5-8" "5678" $ Just "5-8/16"
         testRange "-3" "def" $ Just "13-15/16"
-        testRange "16-" "" $ Just "*/16"
+        -- A range which asks for nothing the file holds is 416, not a
+        -- 206 of no bytes.  "bytes */16" is the 416 form of the header.
+        testUnsatisfiable "16-"
+        testUnsatisfiable "100-"
+        testUnsatisfiable "-0"
         testRange "-17" "0123456789abcdef" Nothing
 
     describe "partial files" $ do
diff --git a/test/RunSpec.hs b/test/RunSpec.hs
--- a/test/RunSpec.hs
+++ b/test/RunSpec.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -150,7 +151,7 @@
         ( const $ do
             takeMVar baton
             -- use timeout to make sure we don't take too long
-            mres <- timeout (60 * 1000 * 1000) (f port)
+            mres <- timeout (3 * 1000 * 1000) (f port)
             case mres of
                 Nothing -> error "Timeout triggered, too slow!"
                 Just a -> pure a
@@ -199,7 +200,7 @@
 singleChunkedPostHello :: [ByteString]
 singleChunkedPostHello =
     [ "POST /hello HTTP/1.1\r\nHost: localhost\r\nTransfer-Encoding: chunked\r\n\r\n"
-    , "5\r\nHello\r\n0\r\n"
+    , "5\r\nHello\r\n0\r\n\r\n"
     ]
 
 spec :: Spec
@@ -281,34 +282,29 @@
                         respond $ responseLBS status200 [] ""
                 withApp defaultSettings app $ withMySocket $ f iheaders
 
-        it "multiline headers" $ do
+        it "refuses multiline headers" $ do
             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
+                rsp <- msRead ms 17
                 headers <- I.readIORef iheaders
-                headers
-                    `shouldBe` [ ("foo", "bar")
-                               , (" baz", "")
-                               , ("\tbin", "")
-                               ]
+                S8.unpack rsp `shouldContain` "400"
+                headers `shouldBe` []
         it "no space between colon and value" $ do
             appWithSocket $ \iheaders ms -> do
-                let input = "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
+                let input = "GET / HTTP/1.1\r\nHost: foo\r\nfoo:bar\r\n\r\n"
                 msWrite ms input
                 threadDelay 5000
                 headers <- I.readIORef iheaders
-                headers `shouldBe` [("foo", "bar")]
-        it "does not recognize multiline headers" $ do
+                headers `shouldBe` [("Host", "foo"), ("foo", "bar")]
+        it "refuses multiline headers split across writes" $ 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
+                rsp <- msRead ms 17
                 headers <- I.readIORef iheaders
-                headers
-                    `shouldBe` [ ("foo", "and")
-                               , (" baz as well", "")
-                               ]
+                S8.unpack rsp `shouldContain` "400"
+                headers `shouldBe` []
 
     describe "chunked bodies" $ do
         it "works" $ do
@@ -322,9 +318,9 @@
             withApp defaultSettings app $ withMySocket $ \ms -> do
                 let input =
                         S.concat
-                            [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
+                            [ "POST / HTTP/1.1\r\nHost: foo\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"
+                            , "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: Chunked\r\n\r\n"
                             , "b\r\nHello World\r\n0\r\n\r\n"
                             ]
                 msWrite ms input
@@ -348,7 +344,7 @@
                 let input =
                         concat $
                             replicate 2 $
-                                ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"]
+                                ["POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: Chunked\r\n\r\n"]
                                     ++ replicate 50 "5\r\n12345\r\n"
                                     ++ ["0\r\n\r\n"]
                 mapM_ (msWrite ms) input
@@ -357,8 +353,16 @@
                     check $ count == 2
                 front <- I.readIORef ifront
                 front [] `shouldBe` replicate 2 (S.concat $ replicate 50 "12345")
+#ifndef WINDOWS
         -- For some reason, the following test on Windows causes the socket
         -- to be killed prematurely. Worth investigating in the future if possible.
+        --
+        -- @
+        --   test\RunSpec.hs:362:9:
+        --   1) Run, chunked bodies, in chunks
+        --        uncaught exception: IOException of type InvalidArgument
+        --        Network.Socket.sendBuf: invalid argument (Invalid argument)
+        -- @
         it "in chunks" $ do
             ifront <- I.newIORef id
             countVar <- newTVarIO (0 :: Int)
@@ -370,9 +374,9 @@
             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"
+                            [ "POST / HTTP/1.1\r\nHost: foo\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\nHost: foo\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
@@ -384,6 +388,7 @@
                     `shouldBe` [ "Hello World\nBye"
                                , "Hello World"
                                ]
+#endif
         it "timeout in request body" $ do
             ifront <- I.newIORef id
             let app req f = do
@@ -392,7 +397,7 @@
                             `onException` liftIO
                                 (I.atomicModifyIORef ifront (\front -> (front . ("consume interrupted" :), ())))
                     liftIO $
-                        threadDelay 4000000 `E.catch` \e -> do
+                        threadDelay 500000 `E.catch` \e -> do
                             I.atomicModifyIORef
                                 ifront
                                 ( \front ->
@@ -407,7 +412,7 @@
                 let bs1 = S.replicate 2048 88
                     bs2 = "This is short"
                     bs = S.append bs1 bs2
-                msWrite ms "POST / HTTP/1.1\r\n"
+                msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\n"
                 msWrite ms "content-length: "
                 msWrite ms $ S8.pack $ show $ S.length bs
                 msWrite ms "\r\n\r\n"
@@ -415,9 +420,299 @@
                 msWrite ms bs1
                 threadDelay 100000
                 msWrite ms bs2
-                threadDelay 5000000
+                threadDelay 1000000
                 front <- I.readIORef ifront
                 S.concat (front []) `shouldBe` bs
+
+    describe "header field values" $ do
+        let exchange hdrs = do
+                ipaths <- I.newIORef id
+                let app req f = do
+                        I.atomicModifyIORef ipaths $ \front ->
+                            (front . (rawPathInfo req :), ())
+                        f $ responseLBS status200 [] ""
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms $
+                        S.concat
+                            [ "POST / HTTP/1.1\r\nHost: foo\r\n"
+                            , hdrs
+                            , "\r\nGET /smuggled HTTP/1.1\r\nHost: foo\r\n\r\n"
+                            ]
+                    rsp <- msRead ms 17
+                    ipaths' <- I.readIORef ipaths
+                    return (S8.unpack rsp, ipaths' [])
+        it "refuses a bare CR" $ do
+            -- A recipient which ends a line at the bare CR reads a
+            -- Content-Length here, and so reads a body where warp would
+            -- read the next request.
+            (rsp, paths) <- exchange "X-Foo: a\rContent-Length: 36\r\n"
+            rsp `shouldContain` "400"
+            paths `shouldNotContain` ["/smuggled"]
+        it "refuses a NUL" $ do
+            (rsp, paths) <- exchange "X-Foo: a\NULb\r\n"
+            rsp `shouldContain` "400"
+            paths `shouldNotContain` ["/smuggled"]
+
+    describe "Content-Length framing" $ do
+        -- A Content-Length warp reads as no body at all, while whatever
+        -- is in front of it reads a body, is a request smuggled onto the
+        -- connection: the body is read here as the next request.
+        let exchange hdrs = do
+                ipaths <- I.newIORef id
+                let app req f = do
+                        I.atomicModifyIORef ipaths $ \front ->
+                            (front . (rawPathInfo req :), ())
+                        f $ responseLBS status200 [] ""
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms $
+                        S.concat
+                            [ "POST / HTTP/1.1\r\nHost: foo\r\n"
+                            , hdrs
+                            , "\r\nGET /smuggled HTTP/1.1\r\nHost: foo\r\n\r\n"
+                            ]
+                    rsp <- msRead ms 17
+                    ipaths' <- I.readIORef ipaths
+                    return (S8.unpack rsp, ipaths' [])
+            refuses name hdrs = it name $ do
+                (rsp, paths) <- exchange hdrs
+                rsp `shouldContain` "400"
+                paths `shouldNotContain` ["/smuggled"]
+        refuses
+            "refuses a Content-Length that is not a number"
+            "Content-Length: abc\r\n"
+        refuses
+            "refuses a Content-Length that overflows"
+            "Content-Length: 9223372036854775808\r\n"
+        refuses
+            "refuses Content-Lengths that disagree"
+            "Content-Length: 0\r\nContent-Length: 36\r\n"
+        it "accepts Content-Lengths that agree" $ do
+            ifront <- I.newIORef id
+            let app req f = do
+                    bss <- consumeBody $ getRequestBodyChunk req
+                    I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ())
+                    f $ responseLBS status200 [] ""
+            withApp defaultSettings app $ withMySocket $ \ms -> do
+                msWrite ms $
+                    S.concat
+                        [ "POST / HTTP/1.1\r\nHost: foo\r\n"
+                        , "Content-Length: 5\r\nContent-Length: 05\r\n\r\n"
+                        , "Hello"
+                        ]
+                _ <- msRead ms 17
+                front <- I.readIORef ifront
+                front [] `shouldBe` ["Hello"]
+
+    describe "ambiguous body framing" $ do
+        -- Each of these frames the body one way for warp and another way
+        -- for anything in front of it. Whichever way warp reads them, the
+        -- smuggled request must not reach the application.
+        let exchange hdrs = do
+                ipaths <- I.newIORef id
+                let app req f = do
+                        I.atomicModifyIORef ipaths $ \front ->
+                            (front . (rawPathInfo req :), ())
+                        f $ responseLBS status200 [] ""
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms $
+                        S.concat
+                            [ "POST / HTTP/1.1\r\nHost: foo\r\n"
+                            , hdrs
+                            , "\r\nGET /smuggled HTTP/1.1\r\nHost: foo\r\n\r\n"
+                            ]
+                    rsp <- msRead ms 17
+                    ipaths' <- I.readIORef ipaths
+                    return (S8.unpack rsp, ipaths' [])
+            frames name hdrs = it name $ do
+                (rsp, paths) <- exchange hdrs
+                rsp `shouldContain` "200"
+                paths `shouldNotContain` ["/smuggled"]
+            refuses name hdrs status = it name $ do
+                (rsp, paths) <- exchange hdrs
+                rsp `shouldContain` status
+                paths `shouldNotContain` ["/smuggled"]
+        frames
+            "reads a trailing space as part of the chunked coding"
+            "Transfer-Encoding: chunked \r\n"
+        frames
+            "reads a trailing tab as part of the chunked coding"
+            "Transfer-Encoding: chunked\t\r\n"
+        frames
+            "ignores an empty element after the chunked coding"
+            "Transfer-Encoding: chunked,\r\n"
+        frames
+            "ignores an empty element before the chunked coding"
+            "Transfer-Encoding: , chunked\r\n"
+        refuses
+            "refuses a Transfer-Encoding with no coding at all"
+            "Transfer-Encoding: ,\r\n"
+            "400"
+        refuses
+            "refuses a coding it cannot decode under chunked"
+            "Transfer-Encoding: gzip, chunked\r\n"
+            "501"
+        refuses
+            "refuses chunked that is not the final coding"
+            "Transfer-Encoding: chunked, gzip\r\n"
+            "400"
+        refuses
+            "refuses a transfer coding that is not chunked"
+            "Transfer-Encoding: identity\r\n"
+            "400"
+        refuses
+            "joins Transfer-Encoding field lines before reading them"
+            "Transfer-Encoding: chunked\r\nTransfer-Encoding: identity\r\n"
+            "400"
+        refuses
+            "refuses Content-Length together with Transfer-Encoding"
+            "Content-Length: 0\r\nTransfer-Encoding: chunked\r\n"
+            "400"
+        it "still reads an ordinary chunked body" $ do
+            ifront <- I.newIORef id
+            let app req f = do
+                    bss <- consumeBody $ getRequestBodyChunk req
+                    I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ())
+                    f $ responseLBS status200 [] ""
+            withApp defaultSettings app $ withMySocket $ \ms -> do
+                msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: chunked \r\n\r\n"
+                msWrite ms "b\r\nHello World\r\n0\r\n\r\n"
+                _ <- msRead ms 17
+                front <- I.readIORef ifront
+                front [] `shouldBe` ["Hello World"]
+
+    describe "header field names" $ do
+        -- Each of these is refused rather than repaired: a recipient
+        -- which repairs it reads a body of 36 bytes, which warp would
+        -- read as a request of its own.
+        let refuses name hdrs = it name $ do
+                ipaths <- I.newIORef id
+                let app req f = do
+                        I.atomicModifyIORef ipaths $ \front ->
+                            (front . (rawPathInfo req :), ())
+                        f $ responseLBS status200 [] ""
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms $
+                        S.concat
+                            [ "POST / HTTP/1.1\r\nHost: foo\r\n"
+                            , hdrs
+                            , "\r\nGET /smuggled HTTP/1.1\r\nHost: foo\r\n\r\n"
+                            ]
+                    rsp <- msRead ms 17
+                    paths <- I.readIORef ipaths
+                    S8.unpack rsp `shouldContain` "400"
+                    paths [] `shouldNotContain` ["/smuggled"]
+        refuses
+            "refuses whitespace between a field name and its colon"
+            "Content-Length : 36\r\n"
+        refuses
+            "refuses a control character in a field name"
+            "Content-Length\v: 36\r\n"
+        refuses
+            "refuses a continuation line"
+            "X-Foo: bar\r\n Content-Length: 36\r\n"
+        refuses
+            "refuses an empty field name"
+            ": 36\r\n"
+
+    describe "Host" $ do
+        -- A proxy routes on the first Host and the application reads the
+        -- last, so a request they can read differently is refused rather
+        -- than served to whichever host warp happens to pick.
+        let send req = do
+                ihosts <- I.newIORef id
+                let app r f = do
+                        I.atomicModifyIORef ihosts $ \front ->
+                            (front . (requestHeaderHost r :), ())
+                        f $ responseLBS status200 [] ""
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms req
+                    rsp <- msRead ms 17
+                    hosts <- I.readIORef ihosts
+                    return (S8.unpack rsp, hosts [])
+        it "refuses a HTTP/1.1 request without one" $ do
+            (rsp, hosts) <- send "GET /nohost HTTP/1.1\r\n\r\n"
+            rsp `shouldContain` "400"
+            hosts `shouldBe` []
+        it "refuses more than one" $ do
+            (rsp, hosts) <- send "GET /dup HTTP/1.1\r\nHost: a\r\nHost: b\r\n\r\n"
+            rsp `shouldContain` "400"
+            hosts `shouldBe` []
+        it "serves a HTTP/1.0 request without one" $ do
+            (rsp, hosts) <- send "GET /nohost HTTP/1.0\r\n\r\n"
+            rsp `shouldContain` "200"
+            hosts `shouldBe` [Nothing]
+
+    describe "malformed chunked bodies" $ do
+        -- The body is what the client says it is up to the empty line
+        -- which ends the trailer section. Each of these used to end the
+        -- body early, leaving the rest of it to be read as the next
+        -- request on the connection.
+        let withChunked body = do
+                ipaths <- I.newIORef id
+                let app req f = do
+                        I.atomicModifyIORef ipaths $ \front ->
+                            (front . (rawPathInfo req :), ())
+                        _ <- consumeBody $ getRequestBodyChunk req
+                        f $ responseLBS status200 [] ""
+                withApp defaultSettings app $ withMySocket $ \ms -> do
+                    msWrite ms $
+                        S.concat
+                            [ "POST / HTTP/1.1\r\nHost: foo\r\n"
+                            , "Transfer-Encoding: chunked\r\n\r\n"
+                            , body
+                            ]
+                    rsp <- msRead ms 17
+                    ipaths' <- I.readIORef ipaths
+                    return (S8.unpack rsp, ipaths' [])
+            smuggled = "GET /smuggled HTTP/1.1\r\nHost: foo\r\n\r\n"
+            refuses name body = it name $ do
+                (rsp, paths) <- withChunked body
+                rsp `shouldContain` "400"
+                paths `shouldNotContain` ["/smuggled"]
+        refuses "refuses a chunk size that is not a number" smuggled
+        refuses
+            "refuses a chunk that is not closed off by CRLF"
+            (S.concat ["5\r\nHello", smuggled])
+        refuses "refuses a chunk size that overflows" "ffffffffffffffffff\r\n"
+        it "refuses a chunk cut short by the end of input" $ do
+            -- A chunk promising a hundred bytes with ten sent and nothing
+            -- more. The body ended there and the application was handed a
+            -- short one as though it were whole: yesodweb/wai#1129.
+            ref <- I.newIORef Nothing
+            let onExc _ = I.writeIORef ref . Just
+                app req f = do
+                    _ <- consumeBody $ getRequestBodyChunk req
+                    f $ responseLBS status200 [] ""
+            withApp (setOnException onExc defaultSettings) app $ withMySocket $ \ms -> do
+                msWrite ms $
+                    S.concat
+                        [ "POST / HTTP/1.1\r\nHost: foo\r\n"
+                        , "Transfer-Encoding: chunked\r\n\r\n"
+                        , "64\r\n"
+                        , S8.pack (replicate 10 'A')
+                        ]
+                msClose ms
+                threadDelay 100000
+                res <- I.readIORef ref
+                show res `shouldBe` show (Just ConnectionClosedByPeer)
+        it "reads the trailer section to its end" $ do
+            (rsp, paths) <- withChunked $ S.concat ["0\r\nX-Trailer: y\r\n", smuggled]
+            rsp `shouldContain` "200"
+            paths `shouldBe` ["/"]
+        it "reads a chunk size split over several reads" $ do
+            ifront <- I.newIORef id
+            let app req f = do
+                    bss <- consumeBody $ getRequestBodyChunk req
+                    I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss :), ())
+                    f $ responseLBS status200 [] ""
+            withApp defaultSettings app $ withMySocket $ \ms -> do
+                msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\nTransfer-Encoding: chunked\r\n\r\n"
+                forM_ ["1", "2", "\r\n", S.replicate 0x12 65, "\r\n0\r\n\r\n"] $
+                    \piece -> threadDelay 50000 >> msWrite ms piece
+                _ <- msRead ms 17
+                front <- I.readIORef ifront
+                front [] `shouldBe` [S.replicate 0x12 65]
+
     describe "raw body" $ do
         it "works" $ do
             let app _req f = do
@@ -431,7 +726,7 @@
                         loop
                 doubleBS = S.concatMap $ \w -> S.pack [w, w]
             withApp defaultSettings app $ withMySocket $ \ms -> do
-                msWrite ms "POST / HTTP/1.1\r\n\r\n12345"
+                msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\n\r\n12345"
                 timeout 100000 (msRead ms 10) `shouldReturn` Just "1122334455"
                 msWrite ms "67890"
                 timeout 100000 (msRead ms 10) `shouldReturn` Just "6677889900"
@@ -464,7 +759,7 @@
                             loop
                 loop
         withApp defaultSettings app $ withMySocket $ \ms -> do
-            msWrite ms "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"
+            msWrite ms "POST / HTTP/1.1\r\nHost: foo\r\ntransfer-encoding: chunked\r\n\r\n"
             threadDelay 10000
             msWrite ms "5\r\nhello\r\n0\r\n\r\n"
             atomically $ do
@@ -479,6 +774,21 @@
         withApp defaultSettings app $ \port -> do
             res <- sendGET $ "http://127.0.0.1:" ++ show port
             responseBody res `shouldBe` "HelloHelloHelloHello"
+
+    describe "setUnsafeClose" $ do
+        let app _ f = f $ responseLBS status200 [("content-length", "6")] "unsafe"
+            readAll s = do
+                bs <- safeRecv s 4096
+                if S.null bs then return [] else (bs :) <$> readAll s
+            closes tm =
+                withApp (setGracefulCloseTimeout1 tm $ setUnsafeClose True defaultSettings) app $
+                    withMySocket $ \ms -> do
+                        msWrite ms "GET / HTTP/1.1\r\nHost: localhost\r\nconnection: close\r\n\r\n"
+                        bs <- S.concat <$> readAll (msSocket ms)
+                        S.takeWhile (/= 13) bs `shouldBe` "HTTP/1.1 200 OK"
+                        snd (S.breakSubstring "\r\n\r\n" bs) `shouldBe` "\r\n\r\nunsafe"
+        it "closes with unsafeClose" $ closes 0
+        it "closes with unsafeGracefulClose" $ closes 1000
 
     describe "head requests" $ do
         let fp = "test/head-response"
diff --git a/test/SendFileSpec.hs b/test/SendFileSpec.hs
--- a/test/SendFileSpec.hs
+++ b/test/SendFileSpec.hs
@@ -10,9 +10,7 @@
 import Network.Wai.Handler.Warp.SendFile
 import Network.Wai.Handler.Warp.Types
 import System.Directory
-import System.Exit
 import qualified System.IO as IO
-import System.Process (system)
 import Test.Hspec
 
 main :: IO ()
@@ -53,11 +51,11 @@
 
     describe "readSendFile" $ do
         it "sends a file correctly (1)" $
-            tryReadSendFile 10 0 1474 ["foo"] `shouldReturn` ExitSuccess
+            tryReadSendFile 10 0 1474 ["foo"] `shouldReturn` True
         it "sends a file correctly (2)" $
-            tryReadSendFile 10 0 1474 ["012345678", "901234"] `shouldReturn` ExitSuccess
+            tryReadSendFile 10 0 1474 ["012345678", "901234"] `shouldReturn` True
         it "sends a file correctly (3)" $
-            tryReadSendFile 10 20 100 ["012345678", "901234"] `shouldReturn` ExitSuccess
+            tryReadSendFile 10 20 100 ["012345678", "901234"] `shouldReturn` True
 
 tryPackHeader :: Int -> [ByteString] -> IO Int
 tryPackHeader siz hdrs = bracket (allocateBuffer siz) freeBuffer $ \buf ->
@@ -77,7 +75,7 @@
     send = BS.appendFile outputFile
     hook = return ()
 
-tryReadSendFile :: Int -> Integer -> Integer -> [ByteString] -> IO ExitCode
+tryReadSendFile :: Int -> Integer -> Integer -> [ByteString] -> IO Bool
 tryReadSendFile siz off len hdrs = bracket setup teardown $ \buf -> do
     mapM_ (BS.appendFile expectedFile) hdrs
     copyfile inputFile expectedFile off len
@@ -105,8 +103,12 @@
             return $ bs == bs'
         else return $ bs == ""
 
-compareFiles :: FilePath -> FilePath -> IO ExitCode
-compareFiles file1 file2 = system $ "cmp -s " ++ file1 ++ " " ++ file2
+-- | Whether two files hold the same bytes.
+--
+-- This used to shell out to @cmp@, which Windows does not have, so these
+-- three were the only tests here that could not pass there.
+compareFiles :: FilePath -> FilePath -> IO Bool
+compareFiles file1 file2 = (==) <$> BS.readFile file1 <*> BS.readFile file2
 
 copyfile :: FilePath -> FilePath -> Integer -> Integer -> IO ()
 copyfile src dst off len =
diff --git a/test/ServerStateSpec.hs b/test/ServerStateSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/ServerStateSpec.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ServerStateSpec where
+
+import Network.Wai.Handler.Warp (getServerState)
+import Network.Wai.Handler.Warp.Counter (Counter, forkConnection)
+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
+
+-- | One more connection on the counter, through a fork which makes no
+--   thread: the place is kept and never taken, which is all these tests
+--   ask of the counter.
+countOneMore :: Counter -> IO ()
+countOneMore counter = forkConnection counter (\_ -> return ()) (\_ -> return ())
+
+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)
+                    countOneMore $ serverConnectionCounter outerSS
+                    bothCount 1
+                    countOneMore $ 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
+                    countOneMore $ 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
@@ -9,6 +9,7 @@
 import System.Process
 import Test.Hspec
 
+import Network.Wai.Handler.Warp (defaultSettings, setOnException)
 import Network.Wai.Handler.Warp.WithApplication
 
 -- All these tests assume the "curl" process can be called directly.
@@ -31,16 +32,21 @@
 
         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
+            withApplicationSettings silentSettings mkApp $ \port -> do
                 output <- readProcess "curl" ["-s", "localhost:" ++ show port] ""
-                output `shouldContain` "Something went wron"
+                output `shouldContain` "Something went wrong"
 
     describe "testWithApplication" $ do
         it "propagates exceptions from the server to the executing thread" $ do
             let mkApp = return $ \_request _respond -> throwIO $ ErrorCall "foo"
-            testWithApplication
+            testWithApplicationSettings
+                silentSettings
                 mkApp
                 ( \port -> do
                     readProcess "curl" ["-s", "localhost:" ++ show port] ""
                 )
                 `shouldThrow` (errorCall "foo")
+  where
+    -- So that we don't muddy the test result screen.
+    -- (normally, 'defaultSettings' use 'defaultOnException', sending to 'stderr')
+    silentSettings = setOnException (\_ _ -> pure ()) defaultSettings
diff --git a/warp.cabal b/warp.cabal
--- a/warp.cabal
+++ b/warp.cabal
@@ -1,19 +1,19 @@
 cabal-version:      >=1.10
 name:               warp
-version:            3.4.12
+version:            3.4.21
 license:            MIT
 license-file:       LICENSE
 maintainer:         michael@snoyman.com
 author:             Michael Snoyman, Kazu Yamamoto, Matt Brown
 stability:          Stable
-homepage:           http://github.com/yesodweb/wai
+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
-    <http://www.stackage.org/package/warp>.
+    <https://www.stackage.org/package/warp>.
 
 category:           Web, Yesod
 build-type:         Simple
@@ -26,7 +26,8 @@
 
 source-repository head
     type:     git
-    location: git://github.com/yesodweb/wai.git
+    location: https://github.com/yesodweb/wai.git
+    subdir:   warp
 
 flag network-bytestring
     default: False
@@ -85,6 +86,7 @@
         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
@@ -96,27 +98,26 @@
     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,
-        ghc-prim,
         hashable,
         http-date,
-        http-types >=0.12,
+        http-types >=0.12 && <1,
+        http-semantics >=0.4 && <0.5,
         http2 >=5.4 && <5.5,
         iproute >=1.3.1,
-        recv >=0.1.0 && <0.2.0,
+        recv >=0.1.3 && <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,
+        time-manager >=0.5 && <0.6,
         vault >=0.3,
-        wai >=3.2.4 && <3.3,
+        wai >=3.2.5 && <3.3,
         word8
 
     if flag(x509)
@@ -131,7 +132,7 @@
             network-bytestring >=0.1.3 && <0.1.4
 
     else
-        build-depends: network >=2.3
+        build-depends: network >=3.2.12
 
     if flag(warp-debug)
         cpp-options: -DWARP_DEBUG
@@ -178,12 +179,17 @@
     build-tool-depends: hspec-discover:hspec-discover
     hs-source-dirs:     test .
     other-modules:
+        BufferSpec
         ConduitSpec
         ConnectionSpec
+        ConnectionExceptionSpec
+        EarlyHintsSpec
         ExceptionSpec
         FdCacheSpec
         FileSpec
+        GracefulShutdownSpec
         HTTP
+        HTTP2Spec
         PackIntSpec
         ReadIntSpec
         RequestSpec
@@ -191,6 +197,7 @@
         ResponseSpec
         RunSpec
         SendFileSpec
+        ServerStateSpec
         WithApplicationSpec
         Network.Wai.Handler.Warp
         Network.Wai.Handler.Warp.Internal
@@ -221,6 +228,7 @@
         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
@@ -233,7 +241,6 @@
     build-depends:
         base >=4.8 && <5,
         QuickCheck,
-        array,
         auto-update,
         async,
         bsb-http-chunked <0.1,
@@ -241,24 +248,26 @@
         case-insensitive >=0.2,
         containers,
         directory,
-        ghc-prim,
         hashable,
         hspec >=1.3,
         http-client,
         http-date,
         http-types >=0.12,
+        http-semantics >=0.4 && <0.5,
         http2 >=5.4 && <5.5,
         iproute >=1.3.1,
         network,
         process,
-        recv >=0.1.0 && <0.2.0,
+        recv >=0.1.3 && <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,
+        wai >=3.2.5 && <3.3,
+        -- workaround: this should be unnecessary
+        warp,
         word8
 
     if flag(x509)
@@ -290,19 +299,26 @@
     main-is:          Parser.hs
     hs-source-dirs:   bench .
     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.Header
+        Network.Wai.Handler.Warp.IO
         Network.Wai.Handler.Warp.Imports
         Network.Wai.Handler.Warp.MultiMap
+        Network.Wai.Handler.Warp.PackInt
         Network.Wai.Handler.Warp.ReadInt
         Network.Wai.Handler.Warp.Request
         Network.Wai.Handler.Warp.RequestHeader
+        Network.Wai.Handler.Warp.Response
+        Network.Wai.Handler.Warp.ResponseHeader
         Network.Wai.Handler.Warp.Settings
+        Network.Wai.Handler.Warp.ShuttingDown
         Network.Wai.Handler.Warp.Types
 
     if flag(include-warp-version)
@@ -311,19 +327,21 @@
     default-language: Haskell2010
     build-depends:
         base >=4.8 && <5,
-        array,
+        async,
         auto-update,
+        bsb-http-chunked,
         bytestring,
         case-insensitive,
         containers,
         criterion,
-        ghc-prim,
         hashable,
         http-date,
         http-types,
-        network,
+        http2,
+        iproute,
         network,
         recv,
+        simple-sendfile,
         stm,
         streaming-commons,
         text,
@@ -347,6 +365,78 @@
         build-depends:
             time,
             unix-compat >=0.2
+
+    if impl(ghc >=8)
+        default-extensions: Strict StrictData
+
+benchmark response
+    type:             exitcode-stdio-1.0
+    main-is:          ResponseBench.hs
+    hs-source-dirs:   bench .
+    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.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.Settings
+        Network.Wai.Handler.Warp.ShuttingDown
+        Network.Wai.Handler.Warp.Types
+
+    if flag(include-warp-version)
+        other-modules: Paths_warp
+
+    default-language: Haskell2010
+    ghc-options:      -threaded
+    build-depends:
+        base >=4.8 && <5,
+        array,
+        auto-update,
+        bsb-http-chunked,
+        bytestring,
+        case-insensitive,
+        containers,
+        criterion,
+        hashable,
+        http-date,
+        http-types,
+        network,
+        recv,
+        stm,
+        streaming-commons,
+        text,
+        time-manager,
+        vault,
+        wai,
+        word8
+
+    if flag(x509)
+        build-depends: crypton-x509
+
+    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
+    else
+        other-modules: Network.Wai.Handler.Warp.MultiMap
+        build-depends: unix
 
     if impl(ghc >=8)
         default-extensions: Strict StrictData