From 35d595be283a39e5764033d45397fb9cebaa61ad Mon Sep 17 00:00:00 2001 From: Sean Parsons Date: Sun, 19 Jul 2026 12:33:35 +0100 Subject: [PATCH] warp: cache a ForeignPtr in WriteBuffer, drop per-flush allocation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit bufferIO called newForeignPtr_ + PS on every write-buffer flush (at least once per response) and toBuilderBuffer did the same once per streaming response, allocating a fresh ForeignPtr wrapper each time for a pointer that is stable for the WriteBuffer's lifetime. WriteBuffer gains a bufFPtr field minted once in createWriteBuffer (finalizer-free; bufFree remains the only free path). bufferIO takes the WriteBuffer and slices the cached ForeignPtr; toBuilderBuffer reuses it. The only site that replaces a WriteBuffer (the growth branch in toBufIOWith) goes through createWriteBuffer, so pointer and ForeignPtr cannot drift. SendFile callers, which only receive a raw pointer through the public SendFile signature, keep the old behavior via rawBufferIO. API note: WriteBuffer(..) is exported from Internal, so the new field is visible to anyone constructing it literally; createWriteBuffer remains the sanctioned constructor. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_011HBrMGfWRxTpYeEB4UT8Kf warp/time-manager: slash per-request TimerManager traffic Profiling showed the dominant per-request cost was not allocation but operations against GHC's process-global TimerManager: every HTTP/1 request did pause (unregister) before the app, resume (register) in the respond callback, tickle (update) after sendResponse, plus tickle per large recv chunk, and streaming responses did resume+pause around EVERY fragment. Each operation also re-fetched the TimerManager from a global IORef. Changes: * time-manager: the Handle caches the TimerManager (fetched once at registration; it is stable for the process lifetime), the time of the last registration/update (monotonic clock), and a rate-limit threshold of min(1s, timeout/4). tickle now performs the real updateTimeout only when the deadline has drifted by more than the threshold; the common case is one VDSO clock read, one IORef read and a compare, with zero timer-queue traffic. The timeout/4 floor keeps rate limiting from eating more than 25% of short timeouts. * warp: streaming bodies switch from resume/pause per fragment to resume once before the body, a rate-limited tickle per fragment, and pause after. The timeout is therefore armed while user code computes between fragments: a stream that produces nothing for a full timeout period is now killed (previously it could stall forever between fragments), and sends themselves are covered, closing a slowloris gap. Apps streaming with output gaps longer than the timeout (e.g. SSE without heartbeats) will notice. Semantics: timeouts can fire up to min(1s, timeout/4) early relative to the last suppressed tickle. Timeout firing verified manually (idle, keep-alive-then-idle and stalled-stream connections all closed at ~3.01s with setTimeout 3). Measured (keep-alive hello-world, wrk -t4 -c100, -N4): 35.7k -> 51.9k req/s (+45%); sendResponse micro 1.58us -> 436ns; -3.5KB allocated per request. This was the single largest win of the series. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_011HBrMGfWRxTpYeEB4UT8Kf warp: track in-flight apps with an IORef instead of STM Every request paid two full STM transactions just to bump the graceful-shutdown in-flight counter (bracket_ around the app invocation), even when no shutdown ever happens. connAppsInProgress becomes an IORef Int updated with atomicModifyIORef' (exact, no lost updates). The only consumer was makeGracefulRecv's STM wait; during shutdown it now polls the counter at 20ms intervals (sleeping inside timeout around the socket-readiness STM wait, so no busy loop) while still feeding data to streams that are in progress. The not-shutting-down path is unchanged. warp-tls updated to match. Honest measurement note: this changed neither throughput nor allocation measurably on a keep-alive hello-world load test at this concurrency; it is kept for the simpler hot path and one fewer STM dependency per request. API change: Connection.connAppsInProgress and makeGracefulRecv (exposed via Internal) change type from TVar Int to IORef Int. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_011HBrMGfWRxTpYeEB4UT8Kf warp: compose response header directly into the write buffer For RspBuilder responses (responseBuilder/responseLBS, the most common response type) the header block was copied twice: composeHeader allocated a fresh pinned ByteString and filled it, then the byteString builder copied those bytes again into the connection's write buffer (response headers are nearly always < 4096 bytes, so bytestring's builder copies rather than inserts). Changes: * ResponseHeader gains composeHeaderPtr (write the status line and headers at a raw pointer, returning the length) and composeHeaderLength; composeHeader is now a thin wrapper, sharing the copy loops. * IO gains toBufIOWithOffset, the existing loop generalized with a starting offset; the seed bytes are flushed with the first batch and counted in the returned total, so the length reported to the logger is unchanged. toBufIOWith = toBufIOWithOffset 0. * sendRsp composes the header in place when it fits in the current write buffer and runs the (possibly chunked) body builder after it; oversized headers fall back to the old path. Wire bytes verified byte-identical against master for content-length, chunked, and 20-header responses (only Date differing). Measured: sendResponse 4 headers -6%, 20 headers -11%, about -430 bytes allocated per request. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_011HBrMGfWRxTpYeEB4UT8Kf warp: stop rebuilding clean response headers, index in one pass sendResponse traversed and rebuilt the response header list 5-6 times per response: * sanitizeHeaders ran map (sanitize <$>) unconditionally, allocating a fresh list + tuples per response even though header values almost never contain CR/LF, and scanned every value byte with S.any. * indexResponseHeader built a boxed Data.Array via runSTArray even though only four slots (Content-Length, Server, Date, Last-Modified) are ever consulted. Changes: * sanitizeHeaders now detects dirty values first (S.elemIndex, i.e. memchr, for CR and LF) and returns the input list untouched in the clean case; the rebuild happens only when something actually needs sanitizing. Dirty-value output is unchanged. * IndexedResponseHeader is a four-field strict record filled in a single list traversal; call sites use plain selectors instead of bounds-checked array reads. The dead ResponseHeaderIndex enum is removed. Measured (GHC 9.10.3, warp:bench:response): sendResponse with 4 headers 1.58us -> 1.39us (-12%), with 20 headers 2.80us -> 2.08us (-26%); about -425 bytes allocated per request in a keep-alive hello-world load test. Behavior byte-identical; spec suite passes. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_011HBrMGfWRxTpYeEB4UT8Kf warp: add end-to-end response-path benchmark The existing bench suite (bench/Parser.hs) covers only request-line parsing and header splitting; the entire response side (header sanitization, indexing, Server/Date insertion, composition, chunking, buffer management, timeout handling) was unmeasured. Add warp:bench:response, a criterion benchmark that drives the real sendResponse with a sink Connection (connSendAll discards), a real time-manager Handle and a realistic indexed request header, so the whole per-response path is measured end to end without socket IO. Also benches composeHeader/indexRequestHeader/indexResponseHeader in isolation. Compiled -threaded with the library's Strict/StrictData to match production semantics. Baseline on GHC 9.10.3 (this machine): builder response with 4 headers 1.58us, 20 headers 2.80us, 204-no-body 727ns. Also sets benchmarks: True in cabal.project so the suite is built by default. Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_011HBrMGfWRxTpYeEB4UT8Kf Merge PR #1087 upper bound for 'http-types' Because I'm preparing for a major-major rework of headers, we should add upper bounds ASAP. The packages that do not use headers from 'http-types' do not need an upper bound. ('wai' uses type synonyms only, which is forwards-compatible) Merge pull request #1088 from yesodweb/indexedheader-safety Safer IndexedHeader warp: bumped version and add to ChangeLog warp: use a safer 'IndexedHeader' to avoid request/response mixups warp: better API for 'IndexedHeader' Using a phantom type parameter will give more guarantees that the correct Enum is used. Otherwise, you could mix up 'RequestHeaderIndex' and 'ResponseHeaderIndex' without any compile time errors. This _DOES_ impact the API in 'Network.Wai.Handler.Warp.Internal' but as it is prefaced to break easily, this shouldn't be a big problem. bump version to 3.4.14 and add to ChangeLog Merge pull request #1084 from yesodweb/fix-waitForDecreased-at-zero-connections Fix wait for decreased at zero connections warp: fix 'waitForDecreased' locking on 0 connections warp: give the result of checking the connections counter ci: linux has 2 directories for GHCup for some reason? ci: attempt to simplify 'Cache dependencies' ci: use correct match for os and unique keys per GHC version ci: trailing commas aren't allowed, I guess? ci: no newlines in 'case' ci: add ghcup binaries dir to cache, and 'APPDATA' dirs for Windows ci: testing if we can maybe cache the executables too ci: LTS-23 now also needs 'extra-deps' wai-extra: comment/layout fix ci: adjust 'stack.yaml/stack-nightly.yaml' to build with current stackage Merge pull request #1081 from alexfmpe/patch-1 Retroactively add note about threaded runtime to changelog Retroactively add note about threaded runtime to changelog Merge pull request #1077 from yesodweb/fix-windows-not-working-with-waitReadSocketSTM Fix windows not working with wait read socket stm warp: update Changelog for 'network' adjustment warp: add CPP to limit usage of 'waitReadSocketSTM'. Merge pull request #1078 from yesodweb/remove-Typeable-deriving Remove typeable deriving warp(-tls): same here since 'wai(-extra)' actively supports only 'base >= 4.12', 'Typeable' is automatically derived warp: forgot an extra 'pure' warp: bumped patch version to be able to publish a new version that isn't actually different in code, except that it hopefully works on Windows again warp: omit 'waitReadSocketSTM' when on WINDOWS Merge pull request #1072 from Bodigrim/patch-1 Add since annotation to connAppsInProgress Add since annotation to connAppsInProgress Merge pull request #1071 from yesodweb/Vlix/graceful-shutdown Vlix/graceful shutdown Co-authored-by: Michał Kłeczek Co-authored-by: Kazu Yamamoto warp: clarifying comment to 'Response.hs' warp: move 'Counter' documentation below the new 'ServerState' and don't hard-set nightly builds to use GHC 9.12.2 warp: removing redundant exports from 'Internal' * 'newServerState' is not used in 'warp-tls' * other functions already get exported from regular 'Warp.hs' warp: added disclaimer to 'Internal.hs' module to give potential users better expectations warp: renamed to 'makeGracefulRecv' and added documentation warp(-tls): changes according to code review * Use 'Control.Concurrent.STM' instead of 'GHC.Conc' when possible * Revert excessive diffs * Add deprecation message to 'settingsConnectionCounter' documentation * Better naming of boolean ('ok' -> 'isShuttingDown') warp-tls: bump version and Changelog warp-tls: adjust for 'warp-3.4.13' warp: extra exports for 'warp-tls' We don't want to expose 'newCounter' and 'ShuttingDown', so I've changed the argument to 'makeRecv' to 'ServerState' and the type of 'appsInProgress' to 'TVar Int'. warp: revert 'socketConnection' to use 'ShuttingDown' from the 'Settings' warp/test: added tests for 'ServerState' warp: version bump and ChangeLog entry warp: expose 'ServerState' selectively The 'ServerState' should be READ-ONLY so that users can not break internal logic. warp/test: add test for graceful shutdown Co-authored-by: Michał Kłeczek relaxing boundary Merge pull request #1069 from edsko/edsko/stopAfterWithResult Introduce `stopAfterWithResult` warp: use 'ShuttingDown' from 'ServerState' and 'connAppsInProgress' to gracefully handle shutdown warp: add 'ServerState' to 'Settings' as focus for queriable internals for users ! These should of course only ever be READ-ONLY ! warp: add 'ShuttingDown' module warp: add 'getCountSTM' Introduce `stopAfterWithResult` workaround for cabal test Merge pull request #1063 from Vlix/fix/remove-crypton-cpp Removed unreachable code from `wai-app-static` wai-app-static: removed the unreachable code since the removal of 'crypton' as a dependency relaxing boundaries Merge branch 'remove-crypton' wai-app-static: ver bumps up removing crypton from wai-app-static fix wai-app-static.cabal Merge ram branch wai-app-static: ver bumps up using "ram" instead of "memory" mime-types: also bumped version in cabal file -> 0.1.2.2 Merge pull request #1059 from zoominsoftware/feat/mime-avif mime-types: add image/avif mime-types: add image/avif Merge pull request #1057 from yesodweb/time-manager-documentation-refactor Time manager documentation refactor time-manager: updated 'ChangeLog.md' with PR links time-manager: bumping patch version, because the code does the same and just changed some documentation/comments time-manager: lots of documentation additions/tweaks time-manager: actually touching some code time-manager: added constraints to 'base' dependency of test-suite Merge pull request #1056 from yesodweb/time-manager-tests Time manager tests hopefully fixes nightly time-manager: added an extra test to mix up resume/pause time-manager: finished tests for 'System.TimeManager' minor adjustments time-manager: moved 'getTimerManager' to 'Internal' module to also test "oldResume" time-manager: first set of tests time-manager: moved some definitions to 'Internal' module to add to test suite Merge pull request #1055 from yesodweb/time-manager-resume-fix Time manager `resume` fix bumped version and added to ChangeLog added/adjusted comments and documentation added a 'forkIO' to not block on throwing the exception added state to the 'Handle' to adjust 'resume' helper function to only act when handle is registered s/return/pure/ allowing tls v2.2 Merge pull request #1051 from ners/mime-javascript mime-types: change type for JavaScript files to text/javascript Merge pull request #1052 from konsumlamm/master Update source-repository sections & avoid `ghc-prim` dependency Fix remaining source-repository sections Merge pull request #958 from wireapp/send-conn-close warp: Send `Connection: close` when closing the connection Update source-repository sections Use https Avoid ghc-prim dependency Merge pull request #1048 from kazu-yamamoto/system-timer-manager2 using GHC.Event.TimerManager mime-types: change type for JavaScript files to text/javascript warp: Add more HTTP/1.1 Connection: close tests warp: Add test for Connection: close header behavior warp: Update changelog warp: Bump version to 3.4.12 warp: Send `Connection: close` when closing the conn Merge pull request #1050 from domenkozar/domenkozar/open-connection-count warp: expose open connection count via getOpenConnectionCount warp: expose open connection count via getOpenConnectionCount Adds ability to monitor the number of currently open connections by storing the connection counter in Settings and exposing it through a new getOpenConnectionCount function. 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Opus 4.5 manual from @Vlix typo (@Vlix) changelog feedback from @Vlix updating doc fixing broken functions documentation adding DEPRECATED fix CI warp: ver bumps up warp: using newest dependencies review from @Vlix Manager 0 as defaultManager allowing time-manager v0.3 time-manager: ver bumps up changelog time-manager: ver bumps up exporting emptyHandle used in http-semantics noline adding isAllGone using http2 5.3.11 fourmolu auto-update: add to changelog for documentation fix auto-update: fixed some @since notations wai-extra: haven't published '3.1.18' yet, so combining changes and doing that now --- warp/Network/Wai/Handler/Warp/Buffer.hs | 18 ++++++++++++++---- warp/Network/Wai/Handler/Warp/IO.hs | 2 +- warp/Network/Wai/Handler/Warp/SendFile.hs | 8 ++++---- warp/Network/Wai/Handler/Warp/Types.hs | 5 +++++ 4 files changed, 24 insertions(+), 9 deletions(-) diff --git a/warp/Network/Wai/Handler/Warp/Buffer.hs b/warp/Network/Wai/Handler/Warp/Buffer.hs index 931ea8a8c..73e7122ed 100644 --- a/warp/Network/Wai/Handler/Warp/Buffer.hs +++ b/warp/Network/Wai/Handler/Warp/Buffer.hs @@ -4,6 +4,7 @@ module Network.Wai.Handler.Warp.Buffer ( freeBuffer, toBuilderBuffer, bufferIO, + rawBufferIO, ) where import Data.IORef (IORef, readIORef) @@ -23,9 +24,11 @@ import Network.Wai.Handler.Warp.Types createWriteBuffer :: BufSize -> IO WriteBuffer createWriteBuffer size = do bytes <- allocateBuffer size + fptr <- newForeignPtr_ bytes return WriteBuffer { bufBuffer = bytes + , bufFPtr = fptr , bufSize = size , bufFree = freeBuffer bytes } @@ -48,12 +51,19 @@ freeBuffer = free toBuilderBuffer :: IORef WriteBuffer -> IO B.Buffer toBuilderBuffer writeBufferRef = do writeBuffer <- readIORef writeBufferRef - let ptr = bufBuffer writeBuffer + let fptr = bufFPtr writeBuffer + ptr = bufBuffer writeBuffer size = bufSize writeBuffer - fptr <- newForeignPtr_ ptr return $ B.Buffer fptr ptr ptr (ptr `plusPtr` size) -bufferIO :: Buffer -> Int -> (ByteString -> IO ()) -> IO () -bufferIO ptr siz io = do +-- | Slice the given number of bytes out of a 'WriteBuffer' using its +-- cached 'ForeignPtr', without allocating a fresh wrapper. +bufferIO :: WriteBuffer -> Int -> (ByteString -> IO ()) -> IO () +bufferIO writeBuffer siz io = io $ PS (bufFPtr writeBuffer) 0 siz + +-- | Like 'bufferIO' for callers that only have a raw pointer. +-- This allocates a fresh 'ForeignPtr' wrapper on every call. +rawBufferIO :: Buffer -> Int -> (ByteString -> IO ()) -> IO () +rawBufferIO ptr siz io = do fptr <- newForeignPtr_ ptr io $ PS fptr 0 siz diff --git a/warp/Network/Wai/Handler/Warp/IO.hs b/warp/Network/Wai/Handler/Warp/IO.hs index dd0dbac09..f87a41715 100644 --- a/warp/Network/Wai/Handler/Warp/IO.hs +++ b/warp/Network/Wai/Handler/Warp/IO.hs @@ -19,7 +19,7 @@ toBufIOWith maxRspBufSize writeBufferRef io builder = do let buf = bufBuffer writeBuffer size = bufSize writeBuffer (len, signal) <- writer buf size - bufferIO buf len io + bufferIO writeBuffer len io let totalBytesSent = toInteger len + bytesSent case signal of Done -> return totalBytesSent diff --git a/warp/Network/Wai/Handler/Warp/SendFile.hs b/warp/Network/Wai/Handler/Warp/SendFile.hs index ff558bca1..8422eefb6 100644 --- a/warp/Network/Wai/Handler/Warp/SendFile.hs +++ b/warp/Network/Wai/Handler/Warp/SendFile.hs @@ -72,7 +72,7 @@ packHeader buf siz send hook (bs : bss) n let dst = buf `plusPtr` n (bs1, bs2) = BS.splitAt room bs void $ copy dst bs1 - bufferIO buf siz send + rawBufferIO buf siz send hook packHeader buf siz send hook (bs2 : bss) 0 where @@ -98,7 +98,7 @@ readSendFile buf siz send fid off0 len0 hook headers = do IO.withBinaryFile path IO.ReadMode $ \h -> do IO.hSeek h IO.AbsoluteSeek off0 n <- IO.hGetBufSome h buf' (mini room len0) - bufferIO buf (hn + n) send + rawBufferIO buf (hn + n) send hook let n' = fromIntegral n fptr <- newForeignPtr_ buf @@ -123,7 +123,7 @@ readSendFile buf siz send fid off0 len0 hook headers = let room = siz - hn buf' = buf `plusPtr` hn n <- positionRead fd buf' (mini room len0) off0 - bufferIO buf (hn + n) send + rawBufferIO buf (hn + n) send hook let n' = fromIntegral n loop fd (len0 - n') (off0 + n') @@ -139,7 +139,7 @@ readSendFile buf siz send fid off0 len0 hook headers = | len <= 0 = return () | otherwise = do n <- positionRead fd buf (mini siz len) off - bufferIO buf n send + rawBufferIO buf n send let n' = fromIntegral n hook loop fd (len - n') (off + n') diff --git a/warp/Network/Wai/Handler/Warp/Types.hs b/warp/Network/Wai/Handler/Warp/Types.hs index 2663223c3..8a92e38f5 100644 --- a/warp/Network/Wai/Handler/Warp/Types.hs +++ b/warp/Network/Wai/Handler/Warp/Types.hs @@ -10,6 +10,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) #ifdef MIN_VERSION_crypton_x509 import Data.X509 #endif +import Foreign.ForeignPtr (ForeignPtr) import Network.Socket (SockAddr) import Network.Socket.BufferPool import System.Posix.Types (Fd) @@ -95,6 +96,10 @@ type SendFile = FileId -> Integer -> Integer -> IO () -> [ByteString] -> IO () -- containing bytes and a way to free the buffer. data WriteBuffer = WriteBuffer { bufBuffer :: Buffer + , bufFPtr :: ForeignPtr Word8 + -- ^ A finalizer-free 'ForeignPtr' wrapping 'bufBuffer', cached so that + -- flushing does not allocate a fresh wrapper on every call. The buffer + -- is freed via 'bufFree', never via this 'ForeignPtr'. , bufSize :: !BufSize -- ^ The size of the write buffer. , bufFree :: IO ()