packages feed

wireform-core 0.2.0.1 → 0.3.0.0

raw patch · 26 files changed

+1453/−490 lines, 26 filesdep +hedgehogdep +sydtest-hedgehogdep ~basedep ~containersdep ~ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: hedgehog, sydtest-hedgehog

Dependency ranges changed: base, containers, ghc-prim, template-haskell

API changes (from Hackage documentation)

- Wireform.Builder.FastBuilder: instance Data.String.IsString Wireform.Builder.FastBuilder.Builder
- Wireform.Builder.FastBuilder: instance GHC.Base.Applicative Wireform.Builder.FastBuilder.BuildM
- Wireform.Builder.FastBuilder: instance GHC.Base.Functor Wireform.Builder.FastBuilder.BuildM
- Wireform.Builder.FastBuilder: instance GHC.Base.Monad Wireform.Builder.FastBuilder.BuildM
- Wireform.Builder.FastBuilder: instance GHC.Base.Monoid Wireform.Builder.FastBuilder.Builder
- Wireform.Builder.FastBuilder: instance GHC.Base.Monoid Wireform.Builder.FastBuilder.Write
- Wireform.Builder.FastBuilder: instance GHC.Base.Semigroup Wireform.Builder.FastBuilder.Builder
- Wireform.Builder.FastBuilder: instance GHC.Base.Semigroup Wireform.Builder.FastBuilder.Write
- Wireform.Builder.FastBuilder: instance GHC.Exception.Type.Exception Wireform.Builder.FastBuilder.ChunkOverflowException
- Wireform.Builder.FastBuilder: instance GHC.Exception.Type.Exception Wireform.Builder.FastBuilder.SuspendBuilderException
- Wireform.Builder.FastBuilder: instance GHC.Show.Show Wireform.Builder.FastBuilder.ChunkOverflowException
- Wireform.Builder.FastBuilder: instance GHC.Show.Show Wireform.Builder.FastBuilder.Response
- Wireform.Builder.FastBuilder: instance GHC.Show.Show Wireform.Builder.FastBuilder.SuspendBuilderException
- Wireform.Hash: instance GHC.Show.Show Wireform.Hash.RoaringContainerKind
- Wireform.Parser.Adapter: instance GHC.Show.Show Wireform.Parser.Adapter.ChunkMode
- Wireform.Parser.Adapter: instance GHC.Show.Show Wireform.Parser.Adapter.ChunkParseError
- Wireform.Parser.Driver: instance GHC.Show.Show Wireform.Parser.Driver.LoopControl
- Wireform.Parser.Error: instance GHC.Base.Functor Wireform.Parser.Error.ParseError
- Wireform.Parser.Error: instance GHC.Exception.Type.Exception Wireform.Parser.Error.CleanEof
- Wireform.Parser.Error: instance GHC.Show.Show Wireform.Parser.Error.CleanEof
- Wireform.Parser.Error: instance GHC.Show.Show e => GHC.Show.Show (Wireform.Parser.Error.ParseError e)
- Wireform.Parser.Internal: instance Control.Monad.Fail.MonadFail (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance GHC.Base.Applicative (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance GHC.Base.Functor (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance GHC.Base.Monad (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance Wireform.Parser.Internal.ParserMode m => GHC.Base.Alternative (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Internal: instance Wireform.Parser.Internal.ParserMode m => GHC.Base.MonadPlus (Wireform.Parser.Internal.Parser m e)
- Wireform.Parser.Mark: instance GHC.Show.Show Wireform.Parser.Mark.Mark
- Wireform.Parser.Position: instance GHC.Num.Num Wireform.Parser.Position.Pos
- Wireform.Parser.Position: instance GHC.Show.Show Wireform.Parser.Position.Pos
- Wireform.Parser.Position: instance GHC.Show.Show Wireform.Parser.Position.Span
- Wireform.Parser.Stateful: instance GHC.Base.Applicative (Wireform.Parser.Stateful.ParserS r s e)
- Wireform.Parser.Stateful: instance GHC.Base.Functor (Wireform.Parser.Stateful.ParserS r s e)
- Wireform.Parser.Stateful: instance GHC.Base.Monad (Wireform.Parser.Stateful.ParserS r s e)
- Wireform.Ring.Internal: instance Foreign.Storable.Storable Wireform.Ring.Internal.CRing
- Wireform.Ring.Internal: instance GHC.Exception.Type.Exception Wireform.Ring.Internal.MagicRingException
- Wireform.Ring.Internal: instance GHC.Show.Show Wireform.Ring.Internal.MagicRingException
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.CoreTopology
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.IOUringFeatures
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.NumaNodeInfo
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.Placement
- Wireform.Transport.Capabilities: instance GHC.Show.Show Wireform.Transport.Capabilities.SystemCapabilities
- Wireform.Transport.Config: instance GHC.Enum.Bounded Wireform.Transport.Config.CapabilityAction
- Wireform.Transport.Config: instance GHC.Enum.Bounded Wireform.Transport.Config.Profile
- Wireform.Transport.Config: instance GHC.Enum.Enum Wireform.Transport.Config.CapabilityAction
- Wireform.Transport.Config: instance GHC.Enum.Enum Wireform.Transport.Config.Profile
- Wireform.Transport.Config: instance GHC.Read.Read Wireform.Transport.Config.CapabilityAction
- Wireform.Transport.Config: instance GHC.Read.Read Wireform.Transport.Config.Profile
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.CapabilityAction
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.CompletionWaitMode
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.IOUringConfig
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.NumaPolicy
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.PagePolicy
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.PinningPolicy
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.Profile
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.SQPollPolicy
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.SpinBudget
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.TransportConfig
- Wireform.Transport.Config: instance GHC.Show.Show Wireform.Transport.Config.WaitPolicy
- Wireform.Transport.Receive: instance GHC.Show.Show Wireform.Transport.Receive.ReceiveWait
- Wireform.Transport.Send: instance GHC.Exception.Type.Exception Wireform.Transport.Send.SendReservationTooLarge
- Wireform.Transport.Send: instance GHC.Exception.Type.Exception Wireform.Transport.Send.SendRingFull
- Wireform.Transport.Send: instance GHC.Show.Show Wireform.Transport.Send.SendReservationTooLarge
- Wireform.Transport.Send: instance GHC.Show.Show Wireform.Transport.Send.SendRingFull
- Wireform.Transport.Send: instance GHC.Show.Show Wireform.Transport.Send.SendWait
+ Wireform.Builder.FastBuilder: FixedBufferOverflow :: !Int -> !Int -> FixedBufferOverflow
+ Wireform.Builder.FastBuilder: NoSpill :: RingSpill
+ Wireform.Builder.FastBuilder: SpillActive :: {-# UNPACK #-} !SpillBuf -> RingSpill
+ Wireform.Builder.FastBuilder: SpillBuf :: !ForeignPtr Word8 -> {-# UNPACK #-} !Int -> SpillBuf
+ Wireform.Builder.FastBuilder: SpillIdle :: {-# UNPACK #-} !SpillBuf -> RingSpill
+ Wireform.Builder.FastBuilder: [fixedBufferAvailable] :: FixedBufferOverflow -> !Int
+ Wireform.Builder.FastBuilder: [fixedBufferRequested] :: FixedBufferOverflow -> !Int
+ Wireform.Builder.FastBuilder: [rsSpill] :: RingSinkState -> !RingSpill
+ Wireform.Builder.FastBuilder: data FixedBufferOverflow
+ Wireform.Builder.FastBuilder: data RingSpill
+ Wireform.Builder.FastBuilder: data SpillBuf
+ Wireform.Builder.FastBuilder: instance GHC.Classes.Eq Wireform.Builder.FastBuilder.FixedBufferOverflow
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Applicative Wireform.Builder.FastBuilder.BuildM
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Functor Wireform.Builder.FastBuilder.BuildM
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Monad Wireform.Builder.FastBuilder.BuildM
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Monoid Wireform.Builder.FastBuilder.Builder
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Monoid Wireform.Builder.FastBuilder.Write
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Semigroup Wireform.Builder.FastBuilder.Builder
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Base.Semigroup Wireform.Builder.FastBuilder.Write
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Data.String.IsString Wireform.Builder.FastBuilder.Builder
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Exception.Type.Exception Wireform.Builder.FastBuilder.ChunkOverflowException
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Exception.Type.Exception Wireform.Builder.FastBuilder.FixedBufferOverflow
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Exception.Type.Exception Wireform.Builder.FastBuilder.SuspendBuilderException
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Show.Show Wireform.Builder.FastBuilder.ChunkOverflowException
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Show.Show Wireform.Builder.FastBuilder.FixedBufferOverflow
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Show.Show Wireform.Builder.FastBuilder.Response
+ Wireform.Builder.FastBuilder: instance GHC.Internal.Show.Show Wireform.Builder.FastBuilder.SuspendBuilderException
+ Wireform.Hash: instance GHC.Internal.Show.Show Wireform.Hash.RoaringContainerKind
+ Wireform.Hash: xxh64IO :: Word64 -> ByteString -> IO Word64
+ Wireform.Parser.Adapter: instance GHC.Internal.Show.Show Wireform.Parser.Adapter.ChunkMode
+ Wireform.Parser.Adapter: instance GHC.Internal.Show.Show Wireform.Parser.Adapter.ChunkParseError
+ Wireform.Parser.Driver: instance GHC.Internal.Show.Show Wireform.Parser.Driver.LoopControl
+ Wireform.Parser.Error: instance GHC.Internal.Base.Functor Wireform.Parser.Error.ParseError
+ Wireform.Parser.Error: instance GHC.Internal.Exception.Type.Exception Wireform.Parser.Error.CleanEof
+ Wireform.Parser.Error: instance GHC.Internal.Show.Show Wireform.Parser.Error.CleanEof
+ Wireform.Parser.Error: instance GHC.Internal.Show.Show e => GHC.Internal.Show.Show (Wireform.Parser.Error.ParseError e)
+ Wireform.Parser.Internal: instance GHC.Internal.Base.Applicative (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance GHC.Internal.Base.Functor (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance GHC.Internal.Base.Monad (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance GHC.Internal.Control.Monad.Fail.MonadFail (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance Wireform.Parser.Internal.ParserMode m => GHC.Internal.Base.Alternative (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Internal: instance Wireform.Parser.Internal.ParserMode m => GHC.Internal.Base.MonadPlus (Wireform.Parser.Internal.Parser m e)
+ Wireform.Parser.Mark: instance GHC.Internal.Show.Show Wireform.Parser.Mark.Mark
+ Wireform.Parser.Position: instance GHC.Internal.Num.Num Wireform.Parser.Position.Pos
+ Wireform.Parser.Position: instance GHC.Internal.Show.Show Wireform.Parser.Position.Pos
+ Wireform.Parser.Position: instance GHC.Internal.Show.Show Wireform.Parser.Position.Span
+ Wireform.Parser.Stateful: instance GHC.Internal.Base.Applicative (Wireform.Parser.Stateful.ParserS r s e)
+ Wireform.Parser.Stateful: instance GHC.Internal.Base.Functor (Wireform.Parser.Stateful.ParserS r s e)
+ Wireform.Parser.Stateful: instance GHC.Internal.Base.Monad (Wireform.Parser.Stateful.ParserS r s e)
+ Wireform.Ring.Internal: instance GHC.Internal.Exception.Type.Exception Wireform.Ring.Internal.MagicRingException
+ Wireform.Ring.Internal: instance GHC.Internal.Foreign.Storable.Storable Wireform.Ring.Internal.CRing
+ Wireform.Ring.Internal: instance GHC.Internal.Show.Show Wireform.Ring.Internal.MagicRingException
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.CoreTopology
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.IOUringFeatures
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.NumaNodeInfo
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.Placement
+ Wireform.Transport.Capabilities: instance GHC.Internal.Show.Show Wireform.Transport.Capabilities.SystemCapabilities
+ Wireform.Transport.Config: instance GHC.Internal.Enum.Bounded Wireform.Transport.Config.CapabilityAction
+ Wireform.Transport.Config: instance GHC.Internal.Enum.Bounded Wireform.Transport.Config.Profile
+ Wireform.Transport.Config: instance GHC.Internal.Enum.Enum Wireform.Transport.Config.CapabilityAction
+ Wireform.Transport.Config: instance GHC.Internal.Enum.Enum Wireform.Transport.Config.Profile
+ Wireform.Transport.Config: instance GHC.Internal.Read.Read Wireform.Transport.Config.CapabilityAction
+ Wireform.Transport.Config: instance GHC.Internal.Read.Read Wireform.Transport.Config.Profile
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.CapabilityAction
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.CompletionWaitMode
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.IOUringConfig
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.NumaPolicy
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.PagePolicy
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.PinningPolicy
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.Profile
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.SQPollPolicy
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.SpinBudget
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.TransportConfig
+ Wireform.Transport.Config: instance GHC.Internal.Show.Show Wireform.Transport.Config.WaitPolicy
+ Wireform.Transport.Receive: instance GHC.Internal.Show.Show Wireform.Transport.Receive.ReceiveWait
+ Wireform.Transport.Send: instance GHC.Internal.Exception.Type.Exception Wireform.Transport.Send.SendReservationTooLarge
+ Wireform.Transport.Send: instance GHC.Internal.Exception.Type.Exception Wireform.Transport.Send.SendRingFull
+ Wireform.Transport.Send: instance GHC.Internal.Show.Show Wireform.Transport.Send.SendReservationTooLarge
+ Wireform.Transport.Send: instance GHC.Internal.Show.Show Wireform.Transport.Send.SendRingFull
+ Wireform.Transport.Send: instance GHC.Internal.Show.Show Wireform.Transport.Send.SendWait
- Wireform.Builder.FastBuilder: RingSinkState :: {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Ptr Word8 -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !Word64 -> IO () -> !Word64 -> IO () -> !IO Word64 -> RingSinkState
+ Wireform.Builder.FastBuilder: RingSinkState :: {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Ptr Word8 -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !Word64 -> IO () -> !Word64 -> IO () -> !IO Word64 -> !RingSpill -> RingSinkState

Files

CHANGELOG.md view
@@ -1,6 +1,24 @@ # Changelog for wireform-core  +## 0.3.0.0 -- unreleased++* Add `Wireform.Hash.xxh64IO` for callers that thread hashes through an IO+  loop without allocating a separate pure thunk per value.++* Breaking change: the exported `RingSinkState` record gains `rsSpill`.+  Custom ring sinks must initialise it with `NoSpill`. Requests larger+  than the ring now use reusable spill storage instead of failing.+* Export `RingSpill`, `SpillBuf` and `FixedBufferOverflow`. Exact-size+  builders reject writes that exceed the remaining buffer.+* Correct direct varint encoding for values at or above `2^21` and+  remove a per-copy continuation allocation from `dBytes`.+* Preserve full-width lengths and offsets at C FFI boundaries and include+  the accumulated buffer-boundary, base64, hashing, parser, ring and+  transport fixes required by the new format packages.+* Support GHC 9.10 and newer.++ ## 0.2.0.1 -- 2026-07-16  * Make `Wireform.Transport.Send` ring-capacity tests portable across
README.md view
@@ -41,6 +41,18 @@ duplicating the `__attribute__((target(...)))` / `simde-features.h` plumbing. +## C kernels++Every kernel in `cbits/` is tested directly by+[`c-harness/`](../c-harness/README.md) — unit, boundary and differential+tests plus libFuzzer targets, under ASan+UBSan (and MSan, valgrind,+guard-page `-O3` builds and the clang static analyzer in `ci`) — not+just through the FFI wrappers. Measured by `make -C c-harness coverage`:+every kernel here sits at 100% line coverage, and every branch except+`fast_rng.c`'s kernel_random-failure arm — unreachable on Darwin, where+`arc4random_buf` cannot fail, and covered by the Linux+getrandom-failure tests in CI.+ ## License  BSD-3-Clause.  Vendored `simde` headers carry their own MIT license
cbits/base64.c view
@@ -27,12 +27,14 @@  * for big payloads via the proto3 JSON mapping -- stays SSSE3.  */ +#include <limits.h> #include <stdint.h> #include <string.h> #include <simde/x86/sse2.h> #include <simde/x86/ssse3.h> -static const char b64_alphabet[64] =+/* 64 symbols plus the literal's terminating NUL (never indexed). */+static const char b64_alphabet[65] =   "ABCDEFGHIJKLMNOPQRSTUVWXYZ"   "abcdefghijklmnopqrstuvwxyz"   "0123456789+/";@@ -82,11 +84,20 @@  * trailing '=' chars subtract one byte each.  The exact decoded  * length is reported by hs_base64_decode itself; this helper just  * sizes the output buffer.+ *+ * Both take and return int (the FFI uses CInt).  The largest input+ * whose padded encoding still fits in an int is 3 * (INT_MAX / 4);+ * for anything longer the encoded length is not representable, so+ * hs_base64_encoded_length returns -1 and hs_base64_encode refuses+ * to run (instead of overflowing its output index).  * ------------------------------------------------------------------ */ +#define B64_MAX_ENCODE_INPUT (3 * (INT_MAX / 4))+ int hs_base64_encoded_length(int in_len) {     if (in_len < 0) return 0;+    if (in_len > B64_MAX_ENCODE_INPUT) return -1;     return ((in_len + 2) / 3) * 4; } @@ -99,8 +110,10 @@ /* ------------------------------------------------------------------  * Encode  *- * Returns the number of bytes written to @out.  Always equals- * hs_base64_encoded_length(in_len) (padded form).+ * Returns the number of bytes written to @out, which must hold+ * hs_base64_encoded_length(in_len) bytes; always equals that length+ * (padded form).  in_len <= 0 writes nothing and returns 0;+ * in_len > 3 * (INT_MAX / 4) writes nothing and returns -1.  * ------------------------------------------------------------------ */  static inline simde__m128i enc_reshuffle(simde__m128i in)@@ -138,6 +151,8 @@ {     int i = 0, j = 0; +    if (in_len > B64_MAX_ENCODE_INPUT) return -1;+     /* SIMD: 12 in -> 16 out per iter.  Need 16 readable input bytes      * (we load 16 then mask out the upper 4) so guard accordingly. */     while (in_len - i >= 16) {@@ -255,39 +270,35 @@     }      /* Tail quartet: may contain '=' padding. */-    {-        uint8_t a = b64_dec_table[in[i+0]];-        uint8_t b = b64_dec_table[in[i+1]];-        if (a >= 64 || b >= 64) return -1;-        if (in[i+2] == (uint8_t)'=') {-            if (in[i+3] != (uint8_t)'=') return -1;-            uint32_t v = ((uint32_t)a << 18) | ((uint32_t)b << 12);-            out[j+0] = (uint8_t)(v >> 16);-            j += 1;-        } else if (in[i+3] == (uint8_t)'=') {-            uint8_t c = b64_dec_table[in[i+2]];-            if (c >= 64) return -1;-            uint32_t v = ((uint32_t)a << 18)-                       | ((uint32_t)b << 12)-                       | ((uint32_t)c <<  6);-            out[j+0] = (uint8_t)(v >> 16);-            out[j+1] = (uint8_t)(v >>  8);-            j += 2;-        } else {-            uint8_t c = b64_dec_table[in[i+2]];-            uint8_t d = b64_dec_table[in[i+3]];-            if (c >= 64 || d >= 64) return -1;-            uint32_t v = ((uint32_t)a << 18)-                       | ((uint32_t)b << 12)-                       | ((uint32_t)c <<  6)-                       |  (uint32_t)d;-            out[j+0] = (uint8_t)(v >> 16);-            out[j+1] = (uint8_t)(v >>  8);-            out[j+2] = (uint8_t) v;-            j += 3;-        }-        i += 4;+    uint8_t a = b64_dec_table[in[i+0]];+    uint8_t b = b64_dec_table[in[i+1]];+    if (a >= 64 || b >= 64) return -1;+    if (in[i+2] == (uint8_t)'=') {+        if (in[i+3] != (uint8_t)'=') return -1;+        uint32_t v = ((uint32_t)a << 18) | ((uint32_t)b << 12);+        out[j+0] = (uint8_t)(v >> 16);+        j += 1;+    } else if (in[i+3] == (uint8_t)'=') {+        uint8_t c = b64_dec_table[in[i+2]];+        if (c >= 64) return -1;+        uint32_t v = ((uint32_t)a << 18)+                   | ((uint32_t)b << 12)+                   | ((uint32_t)c <<  6);+        out[j+0] = (uint8_t)(v >> 16);+        out[j+1] = (uint8_t)(v >>  8);+        j += 2;+    } else {+        uint8_t c = b64_dec_table[in[i+2]];+        uint8_t d = b64_dec_table[in[i+3]];+        if (c >= 64 || d >= 64) return -1;+        uint32_t v = ((uint32_t)a << 18)+                   | ((uint32_t)b << 12)+                   | ((uint32_t)c <<  6)+                   |  (uint32_t)d;+        out[j+0] = (uint8_t)(v >> 16);+        out[j+1] = (uint8_t)(v >>  8);+        out[j+2] = (uint8_t) v;+        j += 3;     }-    (void)i;     return j; }
cbits/fast_decode.c view
@@ -6,8 +6,18 @@  * - Branchless byte-level parallelism for common varint sizes  * - Prefetch hints for sequential buffer access  * - Unrolled loops for fixed-width fields+ *+ * Widths, applied per value (see the module docs in Wireform.FFI):+ * positions into a buffer (and every scanner result, which can return a+ * miss or an end index) are ptrdiff_t; pure byte counts, capacities and+ * the counts these kernels report are size_t. Nothing a Haskell caller+ * passes narrows to CInt, so a ByteString over 2 GiB is not truncated.+ * The functions below that still take int are the ones with no Haskell+ * caller (the scalar varint / fixed-width helpers); they are reached+ * only from C with buffer-sized indices.  */ +#include <stddef.h> #include <stdint.h> #include <string.h> #include <simde/x86/sse2.h>@@ -28,6 +38,9 @@     int offset,     uint64_t *out) {+    /* Requires 0 <= offset. Bounds are tested as len - offset, which+     * cannot overflow once offset < len (offset + k could for len near+     * INT_MAX). */     if (offset >= len) return 0;      /* Fast path: single byte (extremely common for tags and small values) */@@ -37,14 +50,14 @@         return 1;     } -    if (offset + 1 >= len) return 0;+    if (len - offset <= 1) return 0;     uint8_t b1 = buf[offset + 1];     if (b1 < 0x80) {         *out = (uint64_t)(b0 & 0x7F) | ((uint64_t)b1 << 7);         return 2;     } -    if (offset + 2 >= len) return 0;+    if (len - offset <= 2) return 0;     uint8_t b2 = buf[offset + 2];     if (b2 < 0x80) {         *out = (uint64_t)(b0 & 0x7F)@@ -57,7 +70,7 @@      * SWAR technique for 4+ byte varints:      * Load remaining bytes and process with parallel bit extraction.      */-    if (offset + 3 >= len) return 0;+    if (len - offset <= 3) return 0;     uint8_t b3 = buf[offset + 3];     if (b3 < 0x80) {         *out = (uint64_t)(b0 & 0x7F)@@ -67,7 +80,7 @@         return 4;     } -    if (offset + 4 >= len) return 0;+    if (len - offset <= 4) return 0;     uint8_t b4 = buf[offset + 4];     if (b4 < 0x80) {         *out = (uint64_t)(b0 & 0x7F)@@ -129,18 +142,24 @@  * bytes, and strips the remaining sign bits.  *  * REQUIRES: at least 8 readable bytes starting at buf+offset.- * The caller must ensure this (via page boundary relocation or bounds check).+ * The caller must ensure this (Proto.Dynamic checks off + 8 <= length).  *- * Returns bytes consumed (1-10), or 0 on overflow (>10 byte varint).- * Result is written to *out.+ * `offset` is a position into `buf` (ptrdiff_t: a ByteString over 2 GiB+ * must not truncate it). Returns bytes consumed (1-8), a genuinely small+ * value, or 0 if none of the 8 bytes terminates the varint (9- and+ * 10-byte varints, or malformed input); the caller then falls back to+ * its byte-at-a-time decoder. Result is written to *out.  */ int hs_proto_decode_varint_swar(     const uint8_t *buf,-    int offset,+    ptrdiff_t offset,     uint64_t *out) {     uint64_t word;     memcpy(&word, buf + offset, 8);+#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__+    word = __builtin_bswap64(word); /* byte 0 must be the low byte */+#endif      /* Fast path: single byte (most common for tags) */     if ((word & 0x80) == 0) {@@ -186,13 +205,13 @@      /* Now compact the 7-bit groups. Each byte has 7 useful bits in [6:0]. */     uint64_t result = (stripped & 0x7F)-        | ((stripped >> 1) & (0x7FUL << 7))-        | ((stripped >> 2) & (0x7FUL << 14))-        | ((stripped >> 3) & (0x7FUL << 21))-        | ((stripped >> 4) & (0x7FUL << 28))-        | ((stripped >> 5) & (0x7FUL << 35))-        | ((stripped >> 6) & (0x7FUL << 42))-        | ((stripped >> 7) & (0x7FUL << 49));+        | ((stripped >> 1) & (0x7FULL << 7))+        | ((stripped >> 2) & (0x7FULL << 14))+        | ((stripped >> 3) & (0x7FULL << 21))+        | ((stripped >> 4) & (0x7FULL << 28))+        | ((stripped >> 5) & (0x7FULL << 35))+        | ((stripped >> 6) & (0x7FULL << 42))+        | ((stripped >> 7) & (0x7FULL << 49));      *out = result;     return (int)(tag_bits / 8) + 1;@@ -206,14 +225,20 @@  * bytes of padding. The padding bytes are zero, which look like varint  * terminators (byte < 0x80).  *+ * `len` and `out_len` are byte counts, not positions: `len` bytes of the+ * original buffer are copied, and `out_len` is the capacity of the+ * destination, so both are size_t (a capacity can never be negative; a+ * ByteString over 2 GiB needs len + 7 to be representable).+ *  * Returns 1 if a copy was made (caller should use out_buf), 0 if the- * original buffer is safe (no copy needed).+ * original buffer is safe (no copy needed) or len == 0, -1 if a copy is+ * needed but out_len < len + 7.  */ int hs_proto_relocate_page_boundary(     const uint8_t *buf,-    int len,+    size_t len,     uint8_t *out_buf,-    int out_len)+    size_t out_len) {     if (len == 0) return 0; @@ -224,7 +249,8 @@      if (page_end - end_addr < 8) {         /* Too close to page boundary; need to copy. */-        if (out_len < len + 7) return -1; /* buffer too small */+        /* buffer too small; written so that len + 7 cannot overflow */+        if (out_len < 7 || out_len - 7 < len) return -1;         memcpy(out_buf, buf, len);         memset(out_buf + len, 0, 7); /* Zero padding acts as varint terminators */         return 1;@@ -234,30 +260,19 @@  /*  * Skip a varint without decoding its value.- * Returns bytes consumed, or 0 on error.- *- * Uses SWAR: load up to 8 bytes and find the first byte < 0x80- * using bit manipulation.+ * Returns bytes consumed (1-10), or 0 if it is unterminated within len+ * or longer than 10 bytes. Requires 0 <= offset.  */ int hs_proto_skip_varint(     const uint8_t *buf,     int len,     int offset) {-    int pos = offset;-    /* Unrolled: most varints are 1-3 bytes */-    if (pos < len && buf[pos] < 0x80) return 1;-    pos++;-    if (pos < len && buf[pos] < 0x80) return 2;-    pos++;-    if (pos < len && buf[pos] < 0x80) return 3;-    pos++;--    /* Slow path for longer varints */-    while (pos < len) {-        if (buf[pos] < 0x80) return pos - offset + 1;-        pos++;-        if (pos - offset > 10) return 0; /* varint too long */+    /* A varint is at most 10 bytes; the compiler unrolls this. */+    int avail = offset < len ? len - offset : 0;+    if (avail > 10) avail = 10;+    for (int k = 0; k < avail; k++) {+        if (buf[offset + k] < 0x80) return k + 1;     }     return 0; }@@ -290,33 +305,38 @@  * Count the number of varints in a packed buffer.  * Uses SWAR to process 8 bytes at a time: each byte with its high bit  * clear terminates a varint, so we popcount the inverted high-bit mask.+ *+ * `len` is a byte count and the result a varint count, both size_t: a+ * packed run can be larger than 2 GiB, and its count can exceed INT_MAX+ * (which the old int count would have reported wrapped). Uses len - i+ * for the trip counts, never i + N <= len, so the bound cannot wrap.  */-int hs_proto_count_packed_varints(+size_t hs_proto_count_packed_varints(     const uint8_t *buf,-    int len)+    size_t len) {-    int count = 0;-    int i = 0;+    size_t count = 0;+    size_t i = 0;      {         simde__m128i high_bit = simde_mm_set1_epi8((char)0x80);-        for (; i + 16 <= len; i += 16) {+        for (; len - i >= 16; i += 16) {             simde__m128i chunk = simde_mm_loadu_si128(                 (const simde__m128i *)(buf + i));             simde__m128i has_high = simde_mm_and_si128(chunk, high_bit);             simde__m128i is_term = simde_mm_cmpeq_epi8(has_high,                 simde_mm_setzero_si128());             int mask = simde_mm_movemask_epi8(is_term);-            count += __builtin_popcount(mask);+            count += (size_t)__builtin_popcount(mask);         }     }  #if defined(__x86_64__) || defined(__aarch64__)-    for (; i + 8 <= len; i += 8) {+    for (; len - i >= 8; i += 8) {         uint64_t word;         memcpy(&word, buf + i, 8);         uint64_t term_mask = ~word & 0x8080808080808080ULL;-        count += __builtin_popcountll(term_mask >> 7);+        count += (size_t)__builtin_popcountll(term_mask >> 7);     } #endif @@ -332,17 +352,18 @@  * just read the bytes directly as values without varint parsing.  *  * Uses SWAR: if no byte has its high bit set, the entire buffer is- * single-byte varints.  Returns 1 if all single-byte, 0 otherwise.+ * single-byte varints.  `len` is a byte count (size_t). Returns 1 if all+ * single-byte, 0 otherwise.  */ int hs_proto_packed_all_single_byte(     const uint8_t *buf,-    int len)+    size_t len) {-    int i = 0;+    size_t i = 0;      {         simde__m128i high_bit = simde_mm_set1_epi8((char)0x80);-        for (; i + 16 <= len; i += 16) {+        for (; len - i >= 16; i += 16) {             simde__m128i chunk = simde_mm_loadu_si128(                 (const simde__m128i *)(buf + i));             simde__m128i has_high = simde_mm_and_si128(chunk, high_bit);@@ -351,7 +372,7 @@     }  #if defined(__x86_64__) || defined(__aarch64__)-    for (; i + 8 <= len; i += 8) {+    for (; len - i >= 8; i += 8) {         uint64_t word;         memcpy(&word, buf + i, 8);         if (word & 0x8080808080808080ULL) return 0;@@ -378,9 +399,12 @@     int i = 0;  #if defined(__x86_64__) || defined(__aarch64__)-    for (; i + 8 <= len; i += 8) {+    for (; len - i >= 8; i += 8) {         uint64_t word;         memcpy(&word, buf + i, 8);+#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__+        word = __builtin_bswap64(word); /* out[i] is the first byte */+#endif         out[i]     = (word)       & 0xFF;         out[i + 1] = (word >> 8)  & 0xFF;         out[i + 2] = (word >> 16) & 0xFF;@@ -409,16 +433,19 @@  * For the ASCII-only case (the vast majority of protobuf string fields:  * URLs, identifiers, enum names, etc.) this is dramatically faster than  * calling into a full UTF-8 state machine.+ *+ * `len` is a byte count (size_t), so a string field over 2 GiB is+ * validated over its whole length rather than a truncated prefix.  */ int hs_proto_validate_utf8_fast(     const uint8_t *buf,-    int len)+    size_t len) {-    int i = 0;+    size_t i = 0;      {         simde__m128i high_bit = simde_mm_set1_epi8((char)0x80);-        for (; i + 16 <= len; i += 16) {+        for (; len - i >= 16; i += 16) {             simde__m128i chunk = simde_mm_loadu_si128(                 (const simde__m128i *)(buf + i));             simde__m128i has_high = simde_mm_and_si128(chunk, high_bit);@@ -429,7 +456,7 @@     }  #if defined(__x86_64__) || defined(__aarch64__)-    for (; i + 8 <= len; i += 8) {+    for (; len - i >= 8; i += 8) {         uint64_t word;         memcpy(&word, buf + i, 8);         if (word & 0x8080808080808080ULL) {@@ -469,7 +496,7 @@             return 0;         } -        if (i + count > len) return 0;+        if (len - i < (size_t)count) return 0;          for (int j = 1; j < count; j++) {             uint8_t cb = buf[i + j];@@ -494,10 +521,15 @@ /*  * Encode a varint into buf at the given offset.  * Returns the number of bytes written.+ *+ * `offset` is the write cursor into a direct-encode buffer (Encode.Direct+ * allocates one ByteString and fills it front to back), so it is a+ * non-negative index that can pass INT_MAX: size_t, like the count+ * written. The caller guarantees the space.  */-int hs_proto_encode_varint(+size_t hs_proto_encode_varint(     uint8_t *buf,-    int offset,+    size_t offset,     uint64_t value) {     uint8_t *p = buf + offset;@@ -531,7 +563,7 @@         p[4] = (uint8_t)(value >> 28);         return 5;     }-    int n = 0;+    size_t n = 0;     while (value >= 0x80) {         p[n++] = (uint8_t)((value & 0x7F) | 0x80);         value >>= 7;@@ -543,28 +575,36 @@ /*  * Encode a length-delimited field: tag_byte + varint(len) + memcpy(data, len).  * Returns bytes written. This is a single C call for the entire field.+ *+ * `offset` is the write cursor (size_t, see hs_proto_encode_varint) and+ * `len` the byte count of `data`: a single field over 2 GiB is encoded+ * in one call, and the result (1 + varint + len) exceeds INT_MAX for+ * one, so both the length and the return are size_t.  */-int hs_proto_encode_length_delimited(+size_t hs_proto_encode_length_delimited(     uint8_t *buf,-    int offset,+    size_t offset,     uint8_t tag,     const uint8_t *data,-    int len)+    size_t len) {-    uint8_t *p = buf + offset;-    p[0] = tag;-    int n = 1 + hs_proto_encode_varint(buf, offset + 1, (uint64_t)len);-    memcpy(buf + offset + n, data, len);+    buf[offset] = tag;+    size_t n = 1 + hs_proto_encode_varint(buf, offset + 1, (uint64_t)len);+    /* An empty ByteString / Text arrives as (NULL, 0); memcpy from NULL+     * is undefined even for zero bytes. */+    if (len > 0) memcpy(buf + offset + n, data, len);     return n + len; }  /*  * Encode a varint field: tag_byte + varint(value).  * Returns bytes written.+ *+ * `offset` is the write cursor (size_t, like the other encoders).  */-int hs_proto_encode_varint_field(+size_t hs_proto_encode_varint_field(     uint8_t *buf,-    int offset,+    size_t offset,     uint8_t tag,     uint64_t value) {@@ -575,10 +615,12 @@ /*  * Encode a bool field: tag_byte + 0x01/0x00.  * Returns 2 (always 2 bytes).+ *+ * `offset` is the write cursor (size_t, like the other encoders).  */-int hs_proto_encode_bool_field(+size_t hs_proto_encode_bool_field(     uint8_t *buf,-    int offset,+    size_t offset,     uint8_t tag,     int value) {@@ -617,6 +659,7 @@  * Scan for the next field tag in a message buffer.  * Skips the current field value based on wire type.  * Returns the new offset after skipping, or -1 on error.+ * Requires 0 <= offset <= len.  */ int hs_proto_skip_field(     const uint8_t *buf,@@ -631,18 +674,19 @@             return offset + consumed;         }         case 1: /* 64-bit */-            if (offset + 8 > len) return -1;+            if (len - offset < 8) return -1;             return offset + 8;         case 2: { /* length-delimited */             uint64_t field_len;             int consumed = hs_proto_decode_varint_fast(buf, len, offset, &field_len);             if (consumed == 0) return -1;-            int new_offset = offset + consumed + (int)field_len;-            if (new_offset > len) return -1;-            return new_offset;+            /* Compare in 64 bits: the declared length is untrusted and may+             * exceed INT_MAX (narrowing it to int could go negative). */+            if (field_len > (uint64_t)(len - offset - consumed)) return -1;+            return offset + consumed + (int)field_len;         }         case 5: /* 32-bit */-            if (offset + 4 > len) return -1;+            if (len - offset < 4) return -1;             return offset + 4;         default:             return -1;@@ -701,13 +745,20 @@  /* Find the offset of the first NUL byte starting at buf+offset.    Returns offset relative to buf, or -1 if not found within len bytes.-   16-byte SIMD fast path. */-int hs_proto_find_nul(const uint8_t *buf, int offset, int len)+   16-byte SIMD fast path.++   `offset` is the start position and `len` the buffer's length (also the+   exclusive end of the scan): both are indices into `buf`, so ptrdiff_t,+   which keeps a ByteString over 2 GiB from truncating and keeps the -1+   miss representable. Requires 0 <= offset; offset >= len returns -1+   without reading. */+ptrdiff_t hs_proto_find_nul(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len) {-    int i = offset;+    ptrdiff_t i = offset;     simde__m128i zero = simde_mm_setzero_si128(); -    for (; i + 16 <= len; i += 16) {+    /* len - i, not i + 16: i starts at the caller's offset */+    for (; len - i >= 16; i += 16) {         simde__m128i chunk = simde_mm_loadu_si128((const simde__m128i *)(buf + i));         simde__m128i cmp = simde_mm_cmpeq_epi8(chunk, zero);         int mask = simde_mm_movemask_epi8(cmp);@@ -722,14 +773,21 @@ }  /* Check if len bytes starting at buf+offset are all ASCII (< 0x80).-   Uses 16-byte SIMD. Returns 1 if all ASCII, 0 otherwise. */-int hs_proto_is_ascii(const uint8_t *buf, int offset, int len)+   Uses 16-byte SIMD. Returns 1 if all ASCII, 0 otherwise.++   `offset` is a position into `buf` and `len` a count of bytes from+   there (so the window is [offset, offset + len)): both ptrdiff_t, like+   the other scanners, so neither truncates for a ByteString over 2 GiB.+   len <= 0 returns 1 without touching memory. */+int hs_proto_is_ascii(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len) {-    int i = 0;+    /* An empty ByteString arrives as (NULL, 0, 0): do not form NULL + 0. */+    if (len <= 0) return 1;+    ptrdiff_t i = 0;     const uint8_t *p = buf + offset;     simde__m128i highbit = simde_mm_set1_epi8((char)0x80); -    for (; i + 16 <= len; i += 16) {+    for (; len - i >= 16; i += 16) {         simde__m128i chunk = simde_mm_loadu_si128((const simde__m128i *)(p + i));         simde__m128i test = simde_mm_and_si128(chunk, highbit);         if (simde_mm_movemask_epi8(test) != 0) return 0;@@ -794,15 +852,21 @@  * anything < 0x20, or '"', or '\\'.  * Returns the offset of the first such byte, or offset+len if none found.  * 16-byte SIMD fast path.+ *+ * `offset` is a position into `buf` and `len` a count of bytes from+ * there; the result is a position again, so all three are ptrdiff_t+ * (a miss of offset + len must be representable, and can pass INT_MAX).  */-int hs_proto_find_json_escape(const uint8_t *buf, int offset, int len)+ptrdiff_t hs_proto_find_json_escape(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len) {-    int i = 0;+    /* Do not form NULL + 0 for an empty input. */+    if (len <= 0) return offset + len;+    ptrdiff_t i = 0;     const uint8_t *p = buf + offset;     simde__m128i dquote = simde_mm_set1_epi8('"');     simde__m128i bslash = simde_mm_set1_epi8('\\'); -    for (; i + 16 <= len; i += 16) {+    for (; len - i >= 16; i += 16) {         simde__m128i chunk = simde_mm_loadu_si128((const simde__m128i *)(p + i));         int m1 = simde_mm_movemask_epi8(simde_mm_cmpeq_epi8(chunk, dquote));         int m2 = simde_mm_movemask_epi8(simde_mm_cmpeq_epi8(chunk, bslash));@@ -825,14 +889,19 @@  * Returns the offset of the first non-whitespace character.  * EDN treats commas as whitespace. Also skips ; comments to end of line.  * 16-byte SIMD fast path for the common whitespace chars.+ *+ * `offset` is the start position and `len` the buffer's length (the+ * exclusive end), and the result is a position, so all three are+ * ptrdiff_t like the other scanners. Requires 0 <= offset; offset >= len+ * returns offset unchanged without reading.  */-int hs_proto_skip_ws(const uint8_t *buf, int offset, int len)+ptrdiff_t hs_proto_skip_ws(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len) {-    int i = offset;+    ptrdiff_t i = offset;      while (i < len) {         /* SIMD fast path: skip blocks of 16 whitespace bytes */-        while (i + 16 <= len) {+        while (len - i >= 16) {             simde__m128i chunk = simde_mm_loadu_si128((const simde__m128i *)(buf + i));             /* Check each byte against whitespace chars */             simde__m128i eq_space = simde_mm_cmpeq_epi8(chunk, simde_mm_set1_epi8(' '));@@ -868,56 +937,70 @@ }  /*- * Compare a search value against N serialized LE int32 bounds.- * Returns a bitmask where bit i is set if bounds[i] <= search_val.- * Processes 4 bounds at a time using SSE2.- * count must be <= 32.+ * Compare a search value against N serialized bounds.+ * Returns a bitmask where bit i (i < 32) is set if bounds[i] <= search:+ * for width 4 as little-endian signed int32 (4 at a time with SSE2),+ * otherwise by memcmp. Bounds past the 32nd are ignored. The mask is+ * built unsigned (bit 31 is a valid result bit) and returned as an int.+ *+ * `count` is the number of bounds and `width` their size in bytes: both+ * are counts, so size_t (a caller that passes a negative Int would be a+ * bug: the value becomes huge, not empty). width == 0 means empty bounds,+ * which compare equal without touching `bounds`. The result is a 32-bit+ * bitmask, not a length, so it stays an int.  */ int hs_proto_compare_bounds(-    const uint8_t *bounds, int count, int width,+    const uint8_t *bounds, size_t count, size_t width,     const uint8_t *search) {+    size_t n = count < 32 ? count : 32;+     if (width != 4) {         /* Scalar fallback for non-int32 widths */-        int result = 0;-        for (int i = 0; i < count && i < 32; i++) {-            int cmp = memcmp(bounds + i * width, search, width);-            if (cmp <= 0) result |= (1 << i);+        uint32_t result = 0;+        for (size_t i = 0; i < n; i++) {+            /* width 0: every (empty) bound equals the search value; do+             * not form bounds + 0 when an empty ByteString passed NULL */+            int cmp = width != 0+                ? memcmp(bounds + i * width, search, width)+                : 0;+            if (cmp <= 0) result |= 1u << i;         }-        return result;+        return (int)result;     }      /* Fast path for 4-byte LE int32 bounds */     int32_t search_val;     memcpy(&search_val, search, 4); #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__-    search_val = __builtin_bswap32(search_val);+    search_val = (int32_t)__builtin_bswap32((uint32_t)search_val); #endif -    int result = 0;-    int i = 0;+    uint32_t result = 0;+    size_t i = 0;     simde__m128i sv = simde_mm_set1_epi32(search_val); -    for (; i + 4 <= count; i += 4) {+    /* n - i, not i + 4 <= n: the bound cannot wrap. */+    for (; n - i >= 4; i += 4) {         simde__m128i bv = simde_mm_loadu_si128((const simde__m128i *)(bounds + i * 4));         /* bounds[j] <= search_val  iff  NOT (search_val < bounds[j]) */         simde__m128i lt = simde_mm_cmplt_epi32(sv, bv);         /* lt has 0xFFFFFFFF where search < bound, 0 where search >= bound */         int mask = simde_mm_movemask_ps(simde_mm_castsi128_ps(lt));         /* Invert: we want bits set where search >= bound */-        result |= ((~mask) & 0xF) << i;+        result |= (uint32_t)(~mask & 0xF) << i;     }      /* Scalar tail */-    for (; i < count && i < 32; i++) {+    for (; i < n; i++) {         int32_t bval;         memcpy(&bval, bounds + i * 4, 4); #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__-        bval = __builtin_bswap32(bval);+        bval = (int32_t)__builtin_bswap32((uint32_t)bval); #endif-        if (bval <= search_val) result |= (1 << i);+        if (bval <= search_val) result |= 1u << i;     }-    return result;+    return (int)result; }  /*@@ -930,31 +1013,54 @@  *  * For the non-overlap check, we do a simple O(n) scan since buffers in  * Arrow IPC are typically in order. Returns 1 if valid, 0 if invalid.+ *+ * `count` is the number of (offset, length) pairs and `buf_pairs` holds+ * 2 * count int64s, so it is size_t (a negative Int would be a caller+ * bug: it becomes a huge count rather than an empty table).+ *+ * `body_length` is signed like the offsets it is compared against; a+ * negative one describes no body and is rejected outright, even with+ * zero buffers.  */+#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__+/* The two int64 sign bits in a movemask_epi8 result over one 16-byte+ * pair: bit 7 of each lane's most-significant byte, which is lane byte+ * 0 on big-endian. */+#define WF_PAIR_SIGN_MASK 0x0101+#else+/* Lane byte 7 on little-endian (movemask bits 7 and 15). */+#define WF_PAIR_SIGN_MASK 0x8080+#endif+ int hs_proto_validate_arrow_buffers(-    const int64_t *buf_pairs, int count, int64_t body_length)+    const int64_t *buf_pairs, size_t count, int64_t body_length) {+    if (body_length < 0) return 0;     if (count == 0) return 1;      int64_t prev_end = 0;-    int i = 0;+    size_t i = 0; -    /* SSE2 path: validate 2 buffers (4 int64s) at a time for non-negative */-    for (; i + 1 < count; i += 2) {-        simde__m128i pair0 = simde_mm_loadu_si128(-            (const simde__m128i *)(buf_pairs + i * 2));-        simde__m128i pair1 = simde_mm_loadu_si128(-            (const simde__m128i *)(buf_pairs + i * 2 + 2));-        /* Check all 4 values are non-negative (high bit clear) */+    /* SSE2 path: validate 2 buffers (4 int64s) at a time for non-negative.+     * count - i >= 2: no wrap for a count near SIZE_MAX. */+    for (; count - i >= 2; i += 2) {+        /* size_t index: i * 2 must not overflow */+        const int64_t *pp = buf_pairs + i * 2;+        simde__m128i pair0 = simde_mm_loadu_si128((const simde__m128i *)pp);+        simde__m128i pair1 = simde_mm_loadu_si128((const simde__m128i *)(pp + 2));+        /* Check all 4 values are non-negative: each int64's sign bit+         * is bit 7 of its most-significant byte (see WF_PAIR_SIGN_MASK,+         * which names the movemask bits that byte lands in for the+         * platform's byte order). */         simde__m128i combined = simde_mm_or_si128(pair0, pair1);-        if (simde_mm_movemask_epi8(combined) & 0x8888) return 0;+        if (simde_mm_movemask_epi8(combined) & WF_PAIR_SIGN_MASK) return 0;          /* Scalar bounds + overlap checks */         for (int j = 0; j < 2; j++) {-            int idx = i + j;-            int64_t off = buf_pairs[idx * 2];-            int64_t len = buf_pairs[idx * 2 + 1];-            if (off + len > body_length) return 0;+            int64_t off = pp[j * 2];+            int64_t len = pp[j * 2 + 1];+            /* off, len >= 0, so this cannot overflow (off + len could). */+            if (len > body_length || off > body_length - len) return 0;             if (off < prev_end && len > 0) return 0;             int64_t end = off + len;             if (end > prev_end) prev_end = end;@@ -966,7 +1072,7 @@         int64_t off = buf_pairs[i * 2];         int64_t len = buf_pairs[i * 2 + 1];         if (off < 0 || len < 0) return 0;-        if (off + len > body_length) return 0;+        if (len > body_length || off > body_length - len) return 0;         if (off < prev_end && len > 0) return 0;         int64_t end = off + len;         if (end > prev_end) prev_end = end;
cbits/fast_rng.c view
@@ -8,8 +8,9 @@  *  * One 256-bit state per pthread, stored in '__thread' storage so  * concurrent generation across many Haskell capabilities never- * touches a shared cache line.  Seeded on first use from- * @getrandom(2)@.+ * touches a shared cache line.  Seeded on first use from the+ * platform CSPRNG and reseeded in a forked child (see+ * pthread_atfork below).  *  * Used by 'wireform-websocket' to roll per-frame masking keys  * without going through the global 'splitmix' MVar.  Exposed@@ -21,17 +22,53 @@ #include <stdint.h> #include <stddef.h> #include <string.h>-#include <unistd.h>+#include <time.h> -#if defined(__linux__)+#if defined(_WIN32) || defined(_WIN64)+#define WIN32_LEAN_AND_MEAN+#include <windows.h>+#include <bcrypt.h>+static int kernel_random(void *buf, size_t len)+{+    NTSTATUS status = BCryptGenRandom(+        NULL, (PUCHAR)buf, (ULONG)len, BCRYPT_USE_SYSTEM_PREFERRED_RNG);+    return BCRYPT_SUCCESS(status) ? 0 : -1;+}+#elif defined(__linux__)+#include <errno.h>+#include <unistd.h>+#include <pthread.h> #include <sys/syscall.h> #include <linux/random.h>+#if defined(__has_feature)+#  if __has_feature(memory_sanitizer)+#    include <sanitizer/msan_interface.h>+#    define WF_RNG_MSAN 1+#  endif+#endif+/* getrandom(2) through syscall(2), so libcs without the wrapper still+ * build.  Before the kernel pool is initialised the call blocks and a+ * signal can interrupt it (EINTR); a short count is allowed by the+ * interface too.  Retry both rather than dropping to the weak fallback+ * seed.  MemorySanitizer cannot see writes made by a raw syscall, so+ * mark the bytes initialised in that build. */ static int kernel_random(void *buf, size_t len) {-    long r = syscall(SYS_getrandom, buf, len, 0);-    return r == (long)len ? 0 : -1;+    size_t off = 0;+    while (off < len) {+        long r = syscall(SYS_getrandom, (char *)buf + off, len - off, 0);+        if (r < 0 && errno == EINTR) continue;+        if (r <= 0 || (size_t)r > len - off) return -1;+        off += (size_t)r;+    }+#ifdef WF_RNG_MSAN+    __msan_unpoison(buf, len);+#endif+    return 0; } #elif defined(__APPLE__) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__)+#include <unistd.h>+#include <pthread.h> #include <stdlib.h> static int kernel_random(void *buf, size_t len) {@@ -40,6 +77,8 @@ } #else /* Fall back to /dev/urandom for portability. */+#include <unistd.h>+#include <pthread.h> #include <fcntl.h> static int kernel_random(void *buf, size_t len) {@@ -96,11 +135,8 @@     return (x << k) | (x >> (64 - k)); } -/* Recover from a degenerate all-zero seed (xoshiro256++ has a- * fixed point at 0).  Vigna's reference splitmix64 is the- * recommended way to expand a single 64-bit input into a 256-bit- * xoshiro seed.  We only invoke this when 'kernel_random'- * returns all-zero, which on a working kernel never happens. */+/* Vigna's splitmix64, the recommended way to expand one 64-bit value+ * into a 256-bit xoshiro seed.  Used only by the fallback below. */ static inline uint64_t splitmix64_step(uint64_t *x) {     *x += 0x9E3779B97F4A7C15ULL;@@ -110,14 +146,30 @@     return z ^ (z >> 31); } +/* Seed from the kernel.  If that fails (no getrandom, seccomp denial)+ * or returns the all-zero state (xoshiro256++'s fixed point), fall+ * back to splitmix64 over the state's TLS address mixed with the pid+ * and a monotonic timestamp.  The pid matters: after fork() the child+ * has the parent's TLS address, so an address-only seed would make a+ * reseeding child replay the parent's stream from its first draw.+ * Four consecutive splitmix64 outputs come from four distinct counter+ * values of a bijection, so at most one is zero and the fallback state+ * is never all-zero. */ static void xoshiro_seed(void) {     if (kernel_random(xoshiro_state, sizeof(xoshiro_state)) != 0         || (xoshiro_state[0] | xoshiro_state[1]           | xoshiro_state[2] | xoshiro_state[3]) == 0)     {-        /* Last-resort fallback: tid + nanotime through splitmix. */         uint64_t fallback = (uint64_t)(uintptr_t)&xoshiro_state;+#if !defined(_WIN32) && !defined(_WIN64)+        struct timespec ts;+        if (clock_gettime(CLOCK_MONOTONIC, &ts) == 0) {+            fallback ^= (uint64_t)ts.tv_sec * 1000000000ULL+                      + (uint64_t)ts.tv_nsec;+        }+        fallback = splitmix64_step(&fallback) ^ ((uint64_t)getpid() << 32);+#endif         for (int i = 0; i < 4; i++) {             xoshiro_state[i] = splitmix64_step(&fallback);         }@@ -145,10 +197,28 @@     return result; } -/* Force reseed.  Useful after fork() and for tests that want- * deterministic state — they can call this then immediately- * overwrite the seed via hs_xoshiro256pp_reseed. */+/* Discard the calling thread's state: its next draw reseeds from the+ * kernel.  Not imported by Haskell (fork safety goes through the+ * pthread_atfork handler below); kept for C callers and tests. */ void hs_xoshiro256pp_reseed(void) {     xoshiro_seeded = 0; }++/* Fork safety.  A forked child inherits the parent's TLS, so without+ * this the child would replay the parent's stream: two processes+ * emitting identical WebSocket masking keys.  The child handler runs+ * in the forking thread of the child (the only thread it has) and+ * forces a fresh kernel seed on its next draw. */+#if !defined(_WIN32) && !defined(_WIN64)+static void xoshiro_atfork_child(void)+{+    xoshiro_seeded = 0;+}++__attribute__((constructor))+static void xoshiro_register_atfork(void)+{+    pthread_atfork(NULL, NULL, xoshiro_atfork_child);+}+#endif
cbits/fast_scan.c view
@@ -12,21 +12,33 @@  *  * Uses SSE2 via simde for portable SIMD. Fallback to scalar  * loops on architectures without simde support.+ *+ * Widths (the same split as wireform-html and wireform-http1):+ * positions into a buffer are ptrdiff_t, so a ByteString or scan+ * range over 2 GiB is not truncated and a miss can be reported as+ * len (never -1 here); pure byte counts are size_t. Neither type+ * narrows to CInt on the Haskell side.  */ +#include <stddef.h> #include <stdint.h> #include <string.h> #include <simde/x86/sse2.h>  /*  * Scan buf[offset..len) for the first occurrence of target_byte.- * Returns the absolute position of the match, or len if no- * match was found. Used by CSV delimiter scanning, NDJSON- * newline scanning, XML structural scanning, etc.+ *+ * `offset` is the start position and `len` the buffer's length, which+ * doubles as the exclusive end of the scan, so both are indices into+ * `buf` and both must fit in ptrdiff_t (any real object does). Requires+ * 0 <= offset. Returns the absolute position of the match, or len if no+ * match was found (offset >= len is a miss that touches no memory).+ * Used by CSV delimiter scanning, NDJSON newline scanning, XML+ * structural scanning, etc.  */-int hs_find_byte(const uint8_t *buf, int offset, int len, uint8_t target_byte)+ptrdiff_t hs_find_byte(const uint8_t *buf, ptrdiff_t offset, ptrdiff_t len, uint8_t target_byte) {-    int i = offset;+    ptrdiff_t i = offset;     simde__m128i target = simde_mm_set1_epi8((char)target_byte);      /* Scalar prologue until 16-byte aligned. */@@ -35,8 +47,9 @@         i++;     } -    /* SIMD main loop: 16 bytes at a time. */-    for (; i + 16 <= len; i += 16) {+    /* SIMD main loop: 16 bytes at a time. The bound is len - i (never+     * i + 16 <= len) so a len near PTRDIFF_MAX cannot wrap it. */+    for (; len - i >= 16; i += 16) {         simde__m128i chunk = simde_mm_load_si128((const simde__m128i *)(buf + i));         int mask = simde_mm_movemask_epi8(simde_mm_cmpeq_epi8(chunk, target));         if (mask != 0) return i + __builtin_ctz(mask);@@ -56,6 +69,9 @@  * (both directions: the parser un-masks an inbound payload; the  * builder masks an outbound client payload).  *+ * `len` is a pure byte count (size_t): the kernel touches every+ * byte it is given, so it has no 2 GiB ceiling.+ *  * The mask repeats in 4-byte network-order chunks; for the SSE2  * inner loop we broadcast that 32-bit pattern into a 16-byte  * vector once and XOR 16 bytes per iteration.  Scalar prologue +@@ -65,7 +81,7 @@  * i.e. byte 0 of the mask in the high byte.  The same byte  * ordering the wire format uses.  */-void hs_ws_mask(uint8_t *buf, int len, uint32_t mask)+void hs_ws_mask(uint8_t *buf, size_t len, uint32_t mask) {     /* Build the byte ordering the loop needs: mask[0] at offset 0,      * mask[1] at offset 1, …  Easiest done by re-laying the bytes. */@@ -75,7 +91,7 @@     mb[2] = (uint8_t)(mask >>  8);     mb[3] = (uint8_t) mask; -    int i = 0;+    size_t i = 0;      /* Align the scalar prologue so the main loop can use 'movdqa'      * once we hit a 16-byte boundary.  The mask byte at offset i@@ -88,14 +104,15 @@     /* SSE2 main loop: 16 bytes per iteration.  The 4-byte mask      * tiled into a 16-byte vector once.  If i hit alignment at an      * offset where i & 3 != 0, the tile rotates accordingly. */-    if (i + 16 <= len) {-        int phase = i & 3;+    if (len - i >= 16) {+        unsigned phase = (unsigned)(i & 3);         uint8_t tile[16];         for (int k = 0; k < 16; k++) {-            tile[k] = mb[(phase + k) & 3];+            tile[k] = mb[(phase + (unsigned)k) & 3];         }         simde__m128i v = simde_mm_loadu_si128((const simde__m128i *)tile);-        for (; i + 16 <= len; i += 16) {+        /* len - i (not i + 16 <= len): no wrap for a len near SIZE_MAX. */+        for (; len - i >= 16; i += 16) {             simde__m128i chunk = simde_mm_load_si128((const simde__m128i *)(buf + i));             chunk = simde_mm_xor_si128(chunk, v);             simde_mm_store_si128((simde__m128i *)(buf + i), chunk);
cbits/magic_ring_linux.c view
@@ -4,20 +4,25 @@ #include <unistd.h> #include <string.h> #include <errno.h>+#include <stdatomic.h> #include <stdint.h> #include <stdlib.h> #include "magic_ring.h" -static long cached_page_size = 0;+/* Filled lazily. Several capabilities can call in at once, so the cache is+ * an atomic: every racer stores the same value, relaxed order suffices. */+static _Atomic long cached_page_size = 0;  long hs_page_size(void) {-    if (cached_page_size == 0) {-        cached_page_size = sysconf(_SC_PAGESIZE);+    long ps = atomic_load_explicit(&cached_page_size, memory_order_relaxed);+    if (ps == 0) {+        ps = sysconf(_SC_PAGESIZE);+        atomic_store_explicit(&cached_page_size, ps, memory_order_relaxed);     }-    return cached_page_size;+    return ps; } -/* Round up to the next power of two >= val, with val >= page_size. */+/* Round up to the next power of two >= val, for 1 <= val <= RING_MAX_SIZE. */ static size_t next_pow2(size_t val) {     val--;     val |= val >> 1;@@ -25,15 +30,35 @@     val |= val >> 4;     val |= val >> 8;     val |= val >> 16;+#if SIZE_MAX > 0xFFFFFFFFu     val |= val >> 32;+#endif     val++;     return val; } +/* Largest ring. A ring is mapped twice, so 2N has to fit the address+ * space, off_t and the Haskell Int that receives the size; 4 GiB (1 GiB+ * on a 32-bit target) is already far beyond any use, since these are+ * network buffers of KiB to MiB. Capping well below SIZE_MAX / 2 means+ * an absurd request (including what a negative Haskell Int converts to)+ * fails with ENOMEM before any mapping, rather than relying on mmap to+ * reject a multi-exabyte reservation. */+#define RING_MAX_SIZE ((size_t)1 << (sizeof(size_t) >= 8 ? 32 : 30))++/* Close fd on an error path without clobbering the errno being reported. */+static int fail_close(int fd) {+    int saved_errno = errno;+    close(fd);+    errno = saved_errno;+    return -1;+}+ /*  * Allocate a double-mapped ring of at least `requested` bytes.- * Returns 0 on success, -1 on failure (sets errno).- * On success, out->base and out->size are populated.+ * Returns 0 on success, -1 on failure (sets errno; ENOMEM for a request+ * above RING_MAX_SIZE). On success, out->base and out->size are populated;+ * on failure *out is left untouched.  */ int hs_ring_create(size_t requested, struct hs_ring *out) {     long ps = hs_page_size();@@ -41,6 +66,10 @@     int fd;     void *base, *m1, *m2; +    if (requested > RING_MAX_SIZE) {+        errno = ENOMEM;+        return -1;+    }     if (requested < (size_t)ps)         requested = (size_t)ps; @@ -52,34 +81,32 @@     if (fd < 0)         return -1; -    if (ftruncate(fd, (off_t)size) != 0) {-        close(fd);-        return -1;-    }+    if (ftruncate(fd, (off_t)size) != 0)+        return fail_close(fd);      /* Reserve 2N contiguous virtual addresses with no permissions */     base = mmap(NULL, size * 2, PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);-    if (base == MAP_FAILED) {-        close(fd);-        return -1;-    }+    if (base == MAP_FAILED)+        return fail_close(fd);      /* Map the first copy */     m1 = mmap(base, size, PROT_READ | PROT_WRITE,               MAP_SHARED | MAP_FIXED, fd, 0);     if (m1 == MAP_FAILED) {+        int saved_errno = errno;         munmap(base, size * 2);-        close(fd);-        return -1;+        errno = saved_errno;+        return fail_close(fd);     }      /* Map the second copy immediately after */     m2 = mmap((char *)base + size, size, PROT_READ | PROT_WRITE,               MAP_SHARED | MAP_FIXED, fd, 0);     if (m2 == MAP_FAILED) {+        int saved_errno = errno;         munmap(base, size * 2);-        close(fd);-        return -1;+        errno = saved_errno;+        return fail_close(fd);     }      close(fd); /* mappings keep the memfd alive */@@ -92,6 +119,8 @@     return 0; } +/* Idempotent for one struct: clears base/size, so a second call on the+ * same struct is a no-op. A copy of the struct is NOT protected. */ void hs_ring_destroy(struct hs_ring *ring) {     if (ring && ring->base) {         munmap(ring->base, ring->size * 2);
cbits/magic_ring_posix.c view
@@ -9,15 +9,20 @@ #include <stdatomic.h> #include "magic_ring.h" -static long cached_page_size = 0;+/* Filled lazily. Several capabilities can call in at once, so the cache is+ * an atomic: every racer stores the same value, relaxed order suffices. */+static _Atomic long cached_page_size = 0;  long hs_page_size(void) {-    if (cached_page_size == 0) {-        cached_page_size = sysconf(_SC_PAGESIZE);+    long ps = atomic_load_explicit(&cached_page_size, memory_order_relaxed);+    if (ps == 0) {+        ps = sysconf(_SC_PAGESIZE);+        atomic_store_explicit(&cached_page_size, ps, memory_order_relaxed);     }-    return cached_page_size;+    return ps; } +/* Round up to the next power of two >= val, for 1 <= val <= RING_MAX_SIZE. */ static size_t next_pow2(size_t val) {     val--;     val |= val >> 1;@@ -25,13 +30,53 @@     val |= val >> 4;     val |= val >> 8;     val |= val >> 16;+#if SIZE_MAX > 0xFFFFFFFFu     val |= val >> 32;+#endif     val++;     return val; } +/* Largest ring. A ring is mapped twice, so 2N has to fit the address+ * space, off_t and the Haskell Int that receives the size; 4 GiB (1 GiB+ * on a 32-bit target) is already far beyond any use, since these are+ * network buffers of KiB to MiB. Capping well below SIZE_MAX / 2 means+ * an absurd request (including what a negative Haskell Int converts to)+ * fails with ENOMEM before any mapping, rather than relying on mmap to+ * reject a multi-exabyte reservation. */+#if SIZE_MAX > 0xFFFFFFFFu+#define RING_MAX_SIZE ((size_t)1 << 32)+#else+#define RING_MAX_SIZE ((size_t)1 << 30)+#endif++/* Digits of v appended to p (at most 20); returns the count. */+static size_t wf_dec_u64(char *p, uint64_t v) {+    char tmp[20];+    size_t n = 0;+    do {+        tmp[n++] = (char)('0' + v % 10);+        v /= 10;+    } while (v);+    for (size_t k = 0; k < n; k++) p[k] = tmp[n - 1 - k];+    return n;+}++/* Close fd on an error path without clobbering the errno being reported. */+static int fail_close(int fd) {+    int saved_errno = errno;+    close(fd);+    errno = saved_errno;+    return -1;+}+ #if !defined(__FreeBSD__) || !defined(SHM_ANON) static _Atomic long shm_counter = 0;++/* A name left behind by a process that died between shm_open and+ * shm_unlink (and whose pid has been reused) makes O_EXCL fail with+ * EEXIST; move on to the next counter value rather than fail. */+#define SHM_OPEN_ATTEMPTS 16 #endif  int hs_ring_create(size_t requested, struct hs_ring *out) {@@ -41,6 +86,10 @@     void *base, *m1, *m2;     int saved_errno; +    if (requested > RING_MAX_SIZE) {+        errno = ENOMEM;+        return -1;+    }     if (requested < (size_t)ps)         requested = (size_t)ps; @@ -50,42 +99,44 @@ #if defined(__FreeBSD__) && defined(SHM_ANON)     fd = shm_open(SHM_ANON, O_RDWR, 0600); #else-    {+    for (int attempt = 0;; attempt++) {+        /* "/wfring.<pid>.<counter>" built directly: the shape is fixed,+         * and snprintf's fortified size check folds to a constant branch+         * that coverage cannot account for. */         char name[64];-        snprintf(name, sizeof(name), "/wfring.%d.%ld",-                 getpid(), atomic_fetch_add(&shm_counter, 1));+        size_t k = 8;+        memcpy(name, "/wfring.", 8);+        k += wf_dec_u64(name + k, (uint64_t)getpid());+        name[k++] = '.';+        k += wf_dec_u64(name + k, (uint64_t)atomic_fetch_add(&shm_counter, 1));+        name[k] = '\0';         fd = shm_open(name, O_RDWR | O_CREAT | O_EXCL, 0600);-        if (fd >= 0)+        if (fd >= 0) {             shm_unlink(name);+            break;+        }+        if (errno != EEXIST || attempt + 1 >= SHM_OPEN_ATTEMPTS)+            break;     } #endif      if (fd < 0)         return -1; -    if (ftruncate(fd, (off_t)size) != 0) {-        saved_errno = errno;-        close(fd);-        errno = saved_errno;-        return -1;-    }+    if (ftruncate(fd, (off_t)size) != 0)+        return fail_close(fd);      base = mmap(NULL, size * 2, PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);-    if (base == MAP_FAILED) {-        saved_errno = errno;-        close(fd);-        errno = saved_errno;-        return -1;-    }+    if (base == MAP_FAILED)+        return fail_close(fd);      m1 = mmap(base, size, PROT_READ | PROT_WRITE,               MAP_SHARED | MAP_FIXED, fd, 0);     if (m1 == MAP_FAILED) {         saved_errno = errno;         munmap(base, size * 2);-        close(fd);         errno = saved_errno;-        return -1;+        return fail_close(fd);     }      m2 = mmap((char *)base + size, size, PROT_READ | PROT_WRITE,@@ -93,9 +144,8 @@     if (m2 == MAP_FAILED) {         saved_errno = errno;         munmap(base, size * 2);-        close(fd);         errno = saved_errno;-        return -1;+        return fail_close(fd);     }      close(fd);@@ -106,6 +156,8 @@     return 0; } +/* Idempotent for one struct: clears base/size, so a second call on the+ * same struct is a no-op. A copy of the struct is NOT protected. */ void hs_ring_destroy(struct hs_ring *ring) {     if (ring && ring->base) {         munmap(ring->base, ring->size * 2);
cbits/magic_ring_windows.c view
@@ -2,65 +2,75 @@  #include <windows.h> #include <memoryapi.h>+#include <errno.h> #include <stdint.h>+#include <string.h> #include "magic_ring.h" -static long cached_page_size = 0;+/* Filled lazily; every racer stores the same value. */+static volatile LONG cached_page_size = 0;  long hs_page_size(void) {-    if (cached_page_size == 0) {+    LONG ps = InterlockedCompareExchange(&cached_page_size, 0, 0);+    if (ps == 0) {         SYSTEM_INFO si;         GetSystemInfo(&si);-        cached_page_size = (long)si.dwAllocationGranularity;+        ps = (LONG)si.dwAllocationGranularity;+        InterlockedExchange(&cached_page_size, ps);     }-    return cached_page_size;+    return (long)ps; } +/* Largest ring. A ring is mapped twice, so 2N has to fit the address+ * space; 4 GiB (1 GiB on a 32-bit target) is already far beyond any use,+ * since these are network buffers of KiB to MiB. Capping well below+ * SIZE_MAX / 2 means an absurd request fails with ENOMEM before any+ * mapping (and before the size arithmetic below could wrap). */+#define RING_MAX_SIZE ((size_t)1 << (sizeof(size_t) >= 8 ? 32 : 30))++/* Round up to the next power of two >= val, for 1 <= val <= RING_MAX_SIZE. */ static size_t next_pow2(size_t val) {     val--;-    val |= val >> 1;-    val |= val >> 2;-    val |= val >> 4;-    val |= val >> 8;-    val |= val >> 16;-#if defined(_WIN64)-    val |= val >> 32;-#endif-    val++;-    return val;+    for (unsigned s = 1; s < sizeof(size_t) * 8; s <<= 1)+        val |= val >> s;+    return val + 1; }  int hs_ring_create(size_t requested, struct hs_ring *out) {-    long ps = hs_page_size();+    size_t ps = (size_t)hs_page_size();     size_t size;     PVOID placeholder = NULL;     HANDLE section = NULL;     PVOID view1 = NULL, view2 = NULL; -    if (requested < (size_t)ps)-        requested = (size_t)ps;+    if (requested > RING_MAX_SIZE) {+        errno = ENOMEM;+        return -1;+    }+    if (requested < ps)+        requested = ps; -    size = (requested + (size_t)ps - 1) & ~((size_t)ps - 1);+    size = (requested + ps - 1) & ~(ps - 1);     size = next_pow2(size);      placeholder = VirtualAlloc2(NULL, NULL, size * 2,         MEM_RESERVE | MEM_RESERVE_PLACEHOLDER, PAGE_NOACCESS, NULL, 0);-    if (!placeholder)+    if (!placeholder) {+        errno = ENOMEM;         return -1;+    }      /* Split the placeholder into two halves */     if (!VirtualFree(placeholder, size, MEM_RELEASE | MEM_PRESERVE_PLACEHOLDER)) {         VirtualFree(placeholder, 0, MEM_RELEASE);+        errno = ENOMEM;         return -1;     }      section = CreateFileMappingW(INVALID_HANDLE_VALUE, NULL, PAGE_READWRITE,-        (DWORD)(size >> 32), (DWORD)(size & 0xFFFFFFFF), NULL);-    if (!section) {-        VirtualFree(placeholder, 0, MEM_RELEASE);-        VirtualFree((char *)placeholder + size, 0, MEM_RELEASE);-        return -1;-    }+        (DWORD)((unsigned long long)size >> 32), (DWORD)(size & 0xFFFFFFFF), NULL);+    if (!section)+        goto fail;      view1 = MapViewOfFile3(section, NULL, placeholder, 0, size,         MEM_REPLACE_PLACEHOLDER, PAGE_READWRITE, NULL, 0);@@ -74,18 +84,24 @@         goto fail;     } +    /* The two views keep the section alive; the handle is no longer needed+     * (and struct hs_ring has no room for it: the Haskell side allocates+     * exactly base + size). */+    CloseHandle(section);+     /* Pre-fault */     memset(view1, 0, size);      out->base = view1;     out->size = size;-    out->section = section;     return 0;  fail:-    CloseHandle(section);+    if (section)+        CloseHandle(section);     VirtualFree(placeholder, 0, MEM_RELEASE);     VirtualFree((char *)placeholder + size, 0, MEM_RELEASE);+    errno = ENOMEM;     return -1; } @@ -93,10 +109,8 @@     if (ring && ring->base) {         UnmapViewOfFile(ring->base);         UnmapViewOfFile((char *)ring->base + ring->size);-        CloseHandle(ring->section);         ring->base = NULL;         ring->size = 0;-        ring->section = NULL;     } } 
cbits/wireform_hash_simd.c view
@@ -7,7 +7,7 @@  *  * Hot loops are written to use SIMDe (`simde/x86/sse2.h`, `simde/x86/sse4.1.h`)  * so they compile to AVX2/SSE4 on x86, NEON on ARM, and scalar everywhere- * else. The Haskell side is in Iceberg.SIMD.{Murmur3,XXH64,Roaring}.+ * else. The Haskell side is Wireform.Hash (wireform-core).  *  * Style mirrors wireform-columnar/cbits/columnar_simd.c.  */@@ -54,17 +54,28 @@     return (x << r) | (x >> ((32 - r) & 31)); } -int32_t hs_wf_murmur3_32(const uint8_t *buf, int32_t len)+/* Murmur3 x86_32, seed 0, of buf[0, len).+ *+ * len is a byte count (size_t), so a ByteString over 2 GiB is hashed in+ * full; it is never narrowed. buf may be NULL when len == 0 (an empty+ * ByteString). Reads exactly buf[0, len). i is a byte position with+ * 0 <= i <= len, and the bounds are written as len - i, which is exact+ * and cannot wrap for any size_t length. The length also enters the+ * finalizer as a uint32, as the reference algorithm specifies, so two+ * lengths that differ by a multiple of 2^32 produce the same digest. */+int32_t hs_wf_murmur3_32(const uint8_t *buf, size_t len) {     const uint32_t c1 = MURMUR_C1;     const uint32_t c2 = MURMUR_C2;     uint32_t h = 0;-    int32_t i = 0;+    size_t i = 0;      /* Body: 4-byte blocks. We unroll 4 lanes at a time (16 bytes per iter)      * because the kernel is dominated by integer multiplies and rotates,-     * which run independently on the typical CPU pipeline. */-    for (; i + 16 <= len; i += 16) {+     * which run independently on the typical CPU pipeline. The bounds are+     * written as len - i (0 <= i <= len) so they are exact at any length,+     * including the old INT32_MAX overflow point and above it. */+    for (; len - i >= 16; i += 16) {         uint32_t k0 = hs_load_le32(buf + i);         uint32_t k1 = hs_load_le32(buf + i + 4);         uint32_t k2 = hs_load_le32(buf + i + 8);@@ -78,7 +89,7 @@         k3 = (hs_rotl32(k3 * c1, 15)) * c2;         h  = (hs_rotl32(h ^ k3, 13)) * 5 + 0xe6546b64u;     }-    for (; i + 4 <= len; i += 4) {+    for (; len - i >= 4; i += 4) {         uint32_t k = hs_load_le32(buf + i);         k = (hs_rotl32(k * c1, 15)) * c2;         h = (hs_rotl32(h ^ k, 13)) * 5 + 0xe6546b64u;@@ -86,7 +97,7 @@      /* Tail */     uint32_t k1 = 0;-    int32_t tail = len - i;+    size_t tail = len - i;     if (tail == 3) {         k1 = (uint32_t)buf[i] |              ((uint32_t)buf[i + 1] << 8) |@@ -101,7 +112,8 @@         h ^= k1;     } -    /* Finalize */+    /* Finalize. The reference algorithm folds in the length as a uint32,+     * so this cast is the specification, not a truncation bug. */     h ^= (uint32_t)len;     h ^= h >> 16;     h *= 0x85ebca6bu;@@ -111,9 +123,16 @@     return (int32_t)h; } -/* Inline 8-byte (long) bucket: avoid a tiny memcpy + function call. */+/* Inline 8-byte (long) bucket: avoid a tiny memcpy + function call.+ *+ * `buckets` stays int32_t on purpose. It is Iceberg's bucket[N] count from+ * table metadata, a small transform parameter rather than a buffer size;+ * the Haskell wrapper narrows N to Int32 (documented there), so a count+ * >= 2^31 arrives here as 0 or negative and returns 0 rather than dividing+ * by zero. Widening it would buy nothing a real table can reach. */ int32_t hs_wf_bucket_long(int64_t value, int32_t buckets) {+    if (buckets <= 0) return 0;     uint8_t buf[8];     uint64_t u = (uint64_t)value;     buf[0] = (uint8_t)(u);@@ -160,25 +179,30 @@     return acc; } -uint64_t hs_wf_xxh64(const uint8_t *buf, int64_t len, uint64_t seed)+/* len is a byte count (size_t) and is neither narrowed nor sign-checked;+ * the caller passes a ByteString length, which cannot be negative. buf+ * may be NULL when len == 0 (an empty ByteString) and hashes the empty+ * input. Reads exactly buf[0, len). Offsets are tracked as indices so no+ * pointer is formed past buf + len (or from NULL). */+uint64_t hs_wf_xxh64(const uint8_t *buf, size_t len, uint64_t seed) {-    const uint8_t *p   = buf;-    const uint8_t *end = buf + len;+    const size_t n = len;+    size_t i = 0;     uint64_t h64; -    if (len >= 32) {-        const uint8_t *limit = end - 32;+    if (n >= 32) {         uint64_t v1 = seed + XXH_PRIME64_1 + XXH_PRIME64_2;         uint64_t v2 = seed + XXH_PRIME64_2;         uint64_t v3 = seed + 0;         uint64_t v4 = seed - XXH_PRIME64_1;          do {-            v1 = xxh_round(v1, hs_load_le64(p));      p += 8;-            v2 = xxh_round(v2, hs_load_le64(p));      p += 8;-            v3 = xxh_round(v3, hs_load_le64(p));      p += 8;-            v4 = xxh_round(v4, hs_load_le64(p));      p += 8;-        } while (p <= limit);+            v1 = xxh_round(v1, hs_load_le64(buf + i));+            v2 = xxh_round(v2, hs_load_le64(buf + i + 8));+            v3 = xxh_round(v3, hs_load_le64(buf + i + 16));+            v4 = xxh_round(v4, hs_load_le64(buf + i + 24));+            i += 32;+        } while (n - i >= 32);          h64 = xxh_rotl64(v1, 1) + xxh_rotl64(v2, 7)             + xxh_rotl64(v3, 12) + xxh_rotl64(v4, 18);@@ -190,23 +214,23 @@         h64 = seed + XXH_PRIME64_5;     } -    h64 += (uint64_t)len;+    h64 += (uint64_t)n; -    while (p + 8 <= end) {-        uint64_t k1 = xxh_round(0, hs_load_le64(p));+    while (n - i >= 8) {+        uint64_t k1 = xxh_round(0, hs_load_le64(buf + i));         h64 ^= k1;         h64  = xxh_rotl64(h64, 27) * XXH_PRIME64_1 + XXH_PRIME64_4;-        p += 8;+        i += 8;     }-    while (p + 4 <= end) {-        h64 ^= (uint64_t)hs_load_le32(p) * XXH_PRIME64_1;+    if (n - i >= 4) {+        h64 ^= (uint64_t)hs_load_le32(buf + i) * XXH_PRIME64_1;         h64  = xxh_rotl64(h64, 23) * XXH_PRIME64_2 + XXH_PRIME64_3;-        p += 4;+        i += 4;     }-    while (p < end) {-        h64 ^= (uint64_t)(*p) * XXH_PRIME64_5;+    while (i < n) {+        h64 ^= (uint64_t)buf[i] * XXH_PRIME64_5;         h64  = xxh_rotl64(h64, 11) * XXH_PRIME64_1;-        p++;+        i++;     }      h64 ^= h64 >> 33;@@ -232,22 +256,35 @@  * The Haskell side produces only ARRAY containers when packing deletion  * vectors, so this kernel is fast-pathed for them. BITSET containers are  * decoded with a SIMDe popcount-for-bit-extraction loop.+ *+ * Widths: the kernel below has no byte length parameters, only element+ * counts (`cardinality`). Those stay int32_t deliberately. A container is+ * bounded by the format (ARRAY holds at most 4096 distinct 16-bit lows,+ * BITSET at most 65536), so a count that needs more than 31 bits cannot+ * arise from a real container, and the Haskell wrappers additionally+ * clamp untrusted counts to the payload size. Widening them would change+ * the Haskell vector signatures without removing a reachable truncation.  * ============================================================ */  /* Decode an ARRAY container of @cardinality@ uint16 values starting at  * @src@ and write them, OR'd with @hi << 16@, into @dst[0..cardinality)@.- * Returns the number of bytes consumed (always cardinality * 2). */+ * Contract: src holds 2 * cardinality bytes, dst holds cardinality int32+ * (the Haskell wrapper clamps cardinality to the payload length).+ * cardinality <= 0 touches nothing. Returns the number of bytes consumed,+ * cardinality * 2 (computed modulo 2^32). */ int32_t hs_wf_roaring_decode_array(     const uint8_t *src,     int32_t cardinality,     uint32_t hi,     int32_t *dst) {-    int32_t i = 0;+    const size_t n = cardinality > 0 ? (size_t)cardinality : 0;+    const uint32_t base = hi << 16;+    size_t i = 0;     /* SIMDe path: load 8 uint16 lanes, expand to 8 uint32, OR with hi.      * 16 bytes in -> 32 bytes out per iteration. */-    simde__m128i hiv = simde_mm_set1_epi32((int32_t)hi);-    for (; i + 8 <= cardinality; i += 8) {+    simde__m128i hiv = simde_mm_set1_epi32((int32_t)base);+    for (; n - i >= 8; i += 8) {         simde__m128i lows = simde_mm_loadu_si128((const simde__m128i *)(src + i * 2));          /* Expand low half to 32-bit lanes */@@ -260,12 +297,12 @@         simde_mm_storeu_si128((simde__m128i *)(dst + i),     out0);         simde_mm_storeu_si128((simde__m128i *)(dst + i + 4), out1);     }-    for (; i < cardinality; i++) {+    for (; i < n; i++) {         uint16_t lo;         memcpy(&lo, src + i * 2, 2);-        dst[i] = (int32_t)(((uint32_t)lo) | hi);+        dst[i] = (int32_t)(((uint32_t)lo) | base);     }-    return cardinality * 2;+    return (int32_t)(2u * (uint32_t)cardinality); }  /* Decode a BITSET container (8192 bytes = 65536 bits) into the destination@@ -282,12 +319,13 @@     uint32_t hi,     int32_t *dst) {+    const uint32_t base = hi << 16;     int32_t out = 0;     for (int word = 0; word < 1024; word++) {         uint64_t w = hs_load_le64(src + word * 8);         while (w) {             int bit = __builtin_ctzll(w);-            dst[out++] = (int32_t)((hi & 0xffff0000u) | ((uint32_t)(word * 64 + bit)));+            dst[out++] = (int32_t)(base | ((uint32_t)(word * 64 + bit)));             w &= w - 1;         }     }@@ -298,8 +336,11 @@  * We accept a single container at a time so the Haskell caller decides which  * bucket (high16) to look up first.  *- * @kind = 0  -> ARRAY: src is a sorted vector of uint16 lows  * @kind = 1  -> BITSET: src is exactly 8192 bytes+ * @kind = anything else -> ARRAY: src is a sorted vector of @cardinality@+ *   uint16 lows (2 * cardinality bytes); cardinality <= 0 is empty.+ *   Unsorted input can yield a false negative, never a false positive or+ *   a read outside the 2 * cardinality bytes.  *  * @value16 is the 16-bit low half of the position to test. Returns 1 if  * present, 0 otherwise. */@@ -341,7 +382,7 @@     while (lo <= hi_) {         int32_t mid = lo + ((hi_ - lo) >> 1);         uint16_t v;-        memcpy(&v, src + mid * 2, 2);+        memcpy(&v, src + (size_t)mid * 2, 2);         if (v == value16) return 1;         if (v < value16) lo = mid + 1;         else             hi_ = mid - 1;@@ -351,15 +392,18 @@  /* Bulk encode a sorted uint16 vector into an ARRAY container. The caller  * already determined cardinality; we just unpack into the buffer. SIMDe- * memcpy lanes give it a small boost over scalar. Returns bytes written. */+ * memcpy lanes give it a small boost over scalar. Returns bytes written.+ * cardinality <= 0 writes nothing (and keeps a NULL src/dst away from+ * memcpy, which an empty Storable vector may hand over). */ int32_t hs_wf_roaring_encode_array(     const uint16_t *src,     int32_t cardinality,     uint8_t *dst) {+    if (cardinality <= 0) return 0;     /* aligned uint16 -> bytes is just memcpy. */     memcpy(dst, src, (size_t)cardinality * 2);-    return cardinality * 2;+    return (int32_t)(2u * (uint32_t)cardinality); }  /* Encode a sorted uint16 vector into a BITSET container (8192 bytes). */
include/magic_ring.h view
@@ -3,16 +3,39 @@  #include <stddef.h> +/*+ * A "magic" ring: `size` bytes of memory mapped twice, back to back, at+ * base[0, size) and base[size, 2*size), so byte i and byte i + size are+ * the same byte and any window of up to `size` bytes starting inside the+ * first copy is contiguous.+ */ struct hs_ring {     void   *base;     size_t  size;-#ifdef _WIN32-    void   *section; /* HANDLE */-#endif }; +/* System page size (the allocation granularity on Windows). Thread-safe. */ long hs_page_size(void);++/*+ * Map a ring of at least `requested` bytes. The size is rounded up to a+ * page multiple and then to a power of two (minimum one page), so+ * `size - 1` is an index mask. A ring is mapped twice, so 2 * size must+ * fit the address space; a request above 4 GiB (1 GiB on a 32-bit+ * target), which includes the huge values a negative Haskell Int+ * converts to, fails with ENOMEM before anything is mapped. Returns 0+ * and fills *out on success; returns -1 with errno set and leaves *out+ * untouched on failure. The memory starts zeroed. Thread-safe; leaks no+ * descriptors.+ */ int  hs_ring_create(size_t requested, struct hs_ring *out);++/*+ * Unmap both copies. NULL and a struct with base == NULL are no-ops; the+ * struct is cleared, so destroying the SAME struct twice is safe. Calling+ * it on a copy of an already destroyed struct unmaps whatever now lives at+ * that address: the caller must ensure each ring is destroyed once.+ */ void hs_ring_destroy(struct hs_ring *ring);  #endif
src/Wireform/Base64.hs view
@@ -72,18 +72,31 @@  {- | Number of base64 characters produced for an input of @n@ bytes (including @=@ padding).++The C kernel takes a 'CInt' length, so an input longer than+'maxEncodeInput' raises the same error 'encodeBase64' does rather than+silently returning a wrong length; @n < 0@ asks the kernel, which+returns 0. -} encodeBase64Length :: Int -> Int-encodeBase64Length = fromIntegral . c_base64_encoded_length . fromIntegral+encodeBase64Length n+  | n > maxEncodeInput = errorWithoutStackTrace encodeTooLong+  | otherwise = fromIntegral (c_base64_encoded_length (fromIntegral n)) {-# INLINE encodeBase64Length #-}   {- | Upper bound on the number of bytes produced when decoding @n@ input characters.  The actual decoded length is shorter by the number of trailing @=@ characters.++Inputs longer than @maxBound :: CInt@ raise an error, like+'encodeBase64Length' does above 'maxEncodeInput'; 'decodeBase64'+returns 'Nothing' for such inputs instead. -} decodeBase64MaxLength :: Int -> Int-decodeBase64MaxLength = fromIntegral . c_base64_decoded_max_length . fromIntegral+decodeBase64MaxLength n+  | n > fromIntegral (maxBound :: CInt) = errorWithoutStackTrace decodeTooLong+  | otherwise = fromIntegral (c_base64_decoded_max_length (fromIntegral n)) {-# INLINE decodeBase64MaxLength #-}  @@ -94,18 +107,39 @@ {- | Encode a 'ByteString' to RFC 4648 \u00a74 base64 (with @=@ padding).  One allocation of the exact output length, one SIMD pass.++The C kernel works in 'CInt' lengths, so the input may be at most+@3 * (maxBound :: CInt) \`quot\` 4@ bytes (about 1.5 GiB); larger+inputs raise an error instead of being silently truncated. -} encodeBase64 :: ByteString -> ByteString-encodeBase64 bs = unsafePerformIO $ do-  let !inLen = BS.length bs-      !outLen = encodeBase64Length inLen-  BSI.create outLen $ \outPtr ->-    BSU.unsafeUseAsCStringLen bs $ \(inPtr, _) -> do-      _ <- c_base64_encode (castPtr inPtr) (fromIntegral inLen) outPtr-      pure ()+encodeBase64 bs+  | BS.length bs > maxEncodeInput = errorWithoutStackTrace encodeTooLong+  | otherwise = unsafePerformIO $ do+      let !inLen = BS.length bs+          !outLen = encodeBase64Length inLen+      BSI.create outLen $ \outPtr ->+        BSU.unsafeUseAsCStringLen bs $ \(inPtr, _) -> do+          _ <- c_base64_encode (castPtr inPtr) (fromIntegral inLen) outPtr+          pure () {-# NOINLINE encodeBase64 #-}  +-- | Largest input whose padded encoding length fits in a 'CInt'.+maxEncodeInput :: Int+maxEncodeInput = 3 * (fromIntegral (maxBound :: CInt) `quot` 4)+++encodeTooLong :: String+encodeTooLong =+  "Wireform.Base64: input longer than 3 * (2^31 - 1) / 4 bytes"+++decodeTooLong :: String+decodeTooLong =+  "Wireform.Base64: input longer than 2^31 - 1 bytes"++ ------------------------------------------------------------------------ -- Decode ------------------------------------------------------------------------@@ -117,11 +151,15 @@  Whitespace is /not/ tolerated; strip it before calling if your input is line-wrapped (PEM, MIME, etc.).++Inputs longer than @maxBound :: CInt@ characters (the C kernel's+length type) yield 'Nothing' rather than being silently truncated. -} decodeBase64 :: ByteString -> Maybe ByteString decodeBase64 bs   | BS.null bs = Just BS.empty   | (BS.length bs .&. 3) /= 0 = Nothing+  | BS.length bs > fromIntegral (maxBound :: CInt) = Nothing   | otherwise = unsafePerformIO $ do       let !inLen = BS.length bs           !maxOut = decodeBase64MaxLength inLen
src/Wireform/Builder/FastBuilder.hs view
@@ -48,8 +48,13 @@    -- * Ring-direct sink (zero-copy builder → send ring)   RingSinkState (..),+  RingSpill (..),+  SpillBuf (..),   finalizeRingSink, +  -- * Exceptions+  FixedBufferOverflow (..),+   -- * Basic builders   primBounded,   primFixed,@@ -176,8 +181,8 @@     HandleSink !IO.Handle !Int {-next buffer size-} !(IORef Queue)   | {- | The buffer has a known-exact size. No 'IORef', no growth.     Used by 'toStrictByteStringExact' when the output size is-    known in advance. If the builder overflows, behaviour is-    undefined (but in practice 'getBytes_' will 'error').+    known in advance. A request that does not fit in what is left+    throws 'FixedBufferOverflow'.     -}     FixedBuffer   | {- | Bytes are accumulated in a buffer, then fed to a streaming@@ -189,7 +194,9 @@     When the builder overflows, the already-written bytes are     published to the ring consumer and the builder continues     writing into newly-available ring space — no intermediate-    'S.ByteString' allocation or memcpy.+    'S.ByteString' allocation or memcpy.  A single request larger+    than the ring is served from a scratch buffer instead (see+    'RingSpill').     -}     RingSink !(IORef RingSinkState) @@ -271,9 +278,36 @@   {- ^ Read the consumer's current tail position.  Used to check   whether the ring has room without publishing first.   -}+  , rsSpill :: !RingSpill+  {- ^ Scratch buffer for requests larger than the ring.  While+  'SpillActive', the builder's region is the scratch buffer, not+  the ring, and 'rsHead' is the ring position its bytes go to.+  -}   }  +{- | A pinned scratch buffer and its capacity.  Kept across spills+within one builder run so repeated oversized requests reuse it.+-}+data SpillBuf = SpillBuf !(ForeignPtr Word8) {-# UNPACK #-} !Int+++{- | Spill state of a 'RingSink'.++A request for more contiguous bytes than the ring holds cannot be+served from the ring, so 'getBytes_' hands the builder a scratch+buffer instead and marks it active.  The next overflow, insert or+'finalizeRingSink' copies the scratch bytes into the ring in+ring-sized chunks and resumes writing into the ring.+-}+data RingSpill+  = NoSpill+  | -- | A scratch buffer from an earlier spill, free for reuse.+    SpillIdle {-# UNPACK #-} !SpillBuf+  | -- | The builder is currently writing into this buffer.+    SpillActive {-# UNPACK #-} !SpillBuf++ {- | Publish the final bytes written by a builder into the ring.  After 'runBuilder' returns a final cursor, call this to publish@@ -282,17 +316,104 @@ finalizeRingSink :: IORef RingSinkState -> Ptr Word8 -> IO Word64 finalizeRingSink rsRef finalCur = do   rs <- readIORef rsRef-  let !off = fromIntegral (rsHead rs) .&. rsMask rs-      !startPtr = rsBase rs `plusPtr` off-      !written = finalCur `minusPtr` startPtr-      !finalHead = rsHead rs + fromIntegral written-  -- Publish everything from the last-published position to-  -- the builder's final cursor in a single call.-  when (finalHead > rsPublished rs) $-    rsPublishHead rs finalHead-  pure finalHead+  case rsSpill rs of+    SpillActive _ -> do+      -- 'ringCopyIn' publishes as it goes, so nothing is left over.+      rs' <- settleRingSink rs finalCur+      writeIORef rsRef rs'+      pure (rsHead rs')+    _ -> do+      let !off = fromIntegral (rsHead rs) .&. rsMask rs+          !startPtr = rsBase rs `plusPtr` off+          !written = finalCur `minusPtr` startPtr+          !finalHead = rsHead rs + fromIntegral written+      -- Publish everything from the last-published position to+      -- the builder's final cursor in a single call.+      when (finalHead > rsPublished rs) $+        rsPublishHead rs finalHead+      pure finalHead  +{- | Fold the builder's cursor back into the ring state.  Afterwards+'rsHead' is the ring position just past everything the builder has+written, and no spill is active.  An active spill is copied into+the ring (publishing as it goes); otherwise this is pure cursor+arithmetic.+-}+settleRingSink :: RingSinkState -> Ptr Word8 -> IO RingSinkState+settleRingSink rs cur = case rsSpill rs of+  SpillActive buf@(SpillBuf fp _) -> do+    let !base = unsafeForeignPtrToPtr fp+    rs' <- ringCopyIn rs base (cur `minusPtr` base)+    touchForeignPtr fp+    pure rs' {rsSpill = SpillIdle buf}+  _ -> do+    let !off = fromIntegral (rsHead rs) .&. rsMask rs+        !written = cur `minusPtr` (rsBase rs `plusPtr` off)+    pure rs {rsHead = rsHead rs + fromIntegral written}+{-# INLINE settleRingSink #-}+++{- | Copy @len@ bytes from @src@ into the ring at 'rsHead' (which must+be settled).  Pending bytes are published first, then each+ring-sized chunk as it lands, so the consumer drains between chunks.+-}+ringCopyIn :: RingSinkState -> Ptr Word8 -> Int -> IO RingSinkState+ringCopyIn rs src len+  | len <= 0 = pure rs+  | otherwise = do+      when (rsHead rs > rsPublished rs) $+        rsPublishHead rs (rsHead rs)+      let !ringSz = rsRingSize rs+          loop !srcOff !hd+            | srcOff >= len = pure hd+            | otherwise = do+                let !chunk = min (len - srcOff) ringSz+                    !wh = hd + fromIntegral chunk+                rsEnsureRoom rs wh+                let !dst = rsBase rs `plusPtr` (fromIntegral hd .&. rsMask rs)+                copyBytes dst (src `plusPtr` srcOff) chunk+                rsPublishHead rs wh+                loop (srcOff + chunk) wh+      hd' <- loop 0 (rsHead rs)+      pure rs {rsHead = hd', rsPublished = hd'}+{-# NOINLINE ringCopyIn #-}+++{- | Make @sz@ contiguous bytes at the (settled) 'rsHead' available+to the builder.  Publishes pending bytes and waits only when the+consumer's tail says the ring lacks room.  Requires+@sz <= rsRingSize@.+-}+openRingRegion :: RingSinkState -> Int -> IO RingSinkState+openRingRegion rs sz = do+  let !wantHead = rsHead rs + fromIntegral sz+  tl <- rsLoadTail rs+  if wantHead - tl <= fromIntegral (rsRingSize rs)+    then pure rs+    else do+      when (rsHead rs > rsPublished rs) $+        rsPublishHead rs (rsHead rs)+      rsEnsureRoom rs wantHead+      pure rs {rsPublished = rsHead rs}+++-- | Ring address of the (settled) 'rsHead'.+ringHeadPtr :: RingSinkState -> Ptr Word8+ringHeadPtr rs = rsBase rs `plusPtr` (fromIntegral (rsHead rs) .&. rsMask rs)+{-# INLINE ringHeadPtr #-}+++{- | A scratch buffer of at least @n@ bytes, reusing the idle one+when it is large enough.+-}+acquireSpill :: RingSpill -> Int -> IO SpillBuf+acquireSpill (SpillIdle buf@(SpillBuf _ cap)) n | cap >= n = pure buf+acquireSpill _ n = do+  fp <- S.mallocByteString n+  pure (SpillBuf fp n)++ {- | A streaming byte transform — middleware that processes chunks as a 'Builder' produces them. Used for compression, encryption, checksumming, or any incremental byte transform.@@ -419,6 +540,22 @@ instance E.Exception SuspendBuilderException  +{- | A builder running into a fixed, exact-size buffer (see+'toStrictByteStringExact') asked for more room than was left,+i.e. the caller's size estimate was too small.+-}+data FixedBufferOverflow = FixedBufferOverflow+  { fixedBufferRequested :: !Int+  -- ^ Bytes the builder asked for.+  , fixedBufferAvailable :: !Int+  -- ^ Bytes left in the buffer at that point.+  }+  deriving stock (Show, Eq)+++instance E.Exception FixedBufferOverflow++ ---------------------------------------------------------------- -- Builder building blocks @@ -743,7 +880,8 @@  __Precondition:__ the builder must produce exactly @cap@ bytes. If it produces fewer, the trailing bytes are uninitialised.-If it produces more, behaviour is undefined.+If it asks for more room than is left, it throws+'FixedBufferOverflow'. -} toStrictByteStringExact :: Int -> Builder -> S.ByteString toStrictByteStringExact !sz builder = unsafePerformIO $ do@@ -976,11 +1114,36 @@ to the buffer, regardless of the size. -} byteStringCopy :: S.ByteString -> Builder-byteStringCopy !bstr =-  -- TODO: this is suboptimal; should keep using the same buffer size.-  ensureBytes (S.length bstr) <> byteStringCopyNoCheck bstr+byteStringCopy !bstr = mkBuilder $ do+  r <- remainingBytes+  if r >= S.length bstr+    then useBuilder $ byteStringCopyNoCheck bstr+    else useBuilder $ byteStringCopySlow_ bstr+{-# INLINE byteStringCopy #-}  +{- | Out-of-line overflow path for 'byteStringCopy'.++A 'RingSink' can offer at most @ringSize@ contiguous bytes, so a+copy larger than the ring goes through the insert path, which+copies straight into the ring in chunks.  'getBytes' would also+cope (via its spill buffer) but would copy the bytes twice.+-}+byteStringCopySlow_ :: S.ByteString -> Builder+byteStringCopySlow_ bstr = mkBuilder $ do+  sink <- getSink+  case sink of+    RingSink rsRef -> do+      rs <- io $ readIORef rsRef+      if S.length bstr > rsRingSize rs+        then useBuilder $ byteStringInsert_ bstr+        else useBuilder $ getBytes (S.length bstr) <> byteStringCopyNoCheck bstr+    _ ->+      -- TODO: this is suboptimal; should keep using the same buffer size.+      useBuilder $ getBytes (S.length bstr) <> byteStringCopyNoCheck bstr+{-# NOINLINE byteStringCopySlow_ #-}++ -- | Like 'byteStringCopy', but assumes that the current buffer is large enough. byteStringCopyNoCheck :: S.ByteString -> Builder byteStringCopyNoCheck !bstr = mkBuilder $ do@@ -1024,9 +1187,15 @@       when (r < S.length bstr) $         growBuffer bufRef (S.length bstr)       useBuilder $ byteStringCopyNoCheck bstr-    FixedBuffer ->-      -- FixedBuffer: buffer is exact-sized, so this large insert-      -- must still fit. Just copy it in.+    FixedBuffer -> do+      r <- remainingBytes+      when (r < S.length bstr) $+        io $+          E.throwIO+            FixedBufferOverflow+              { fixedBufferRequested = S.length bstr+              , fixedBufferAvailable = r+              }       useBuilder $ byteStringCopyNoCheck bstr     HandleSink h _nextCap queueRef -> do       cur <- getCur@@ -1047,46 +1216,18 @@       setCur (sqBase sq)     RingSink rsRef -> do       cur <- getCur-      rs <- io $ readIORef rsRef-      let !off = fromIntegral (rsHead rs) .&. rsMask rs-          !startPtr = rsBase rs `plusPtr` off-          !written = cur `minusPtr` startPtr-          !newHead = rsHead rs + fromIntegral written-          !bsLen = S.length bstr-          !ringSz = rsRingSize rs-      -- Publish accumulated builder bytes before the BS copy.-      when (written > 0) $ io $ do-        when (newHead > rsPublished rs) $-          rsPublishHead rs newHead-      -- Copy the BS into the ring, chunking at ringSize if-      -- the BS is larger than the ring can hold contiguously.-      io $ S.unsafeUseAsCString bstr $ \src -> do-        let loop !srcOff !hd !remaining-              | remaining <= 0 = pure hd-              | otherwise = do-                  let !chunk = min remaining ringSz-                      !wh = hd + fromIntegral chunk-                  rsEnsureRoom rs wh-                  let !dstOff = fromIntegral hd .&. rsMask rs-                      !dst = rsBase rs `plusPtr` dstOff-                  copyBytes dst (castPtr src `plusPtr` srcOff) chunk-                  rsPublishHead rs wh-                  loop (srcOff + chunk) wh (remaining - chunk)-        afterBs <- loop 0 newHead bsLen-        let !pub = afterBs-        writeIORef-          rsRef-          rs-            { rsHead = afterBs-            , rsPublished = pub-            }-      -- Set up a fresh region for subsequent builder writes.-      rs' <- io $ readIORef rsRef-      let !contChunk = min ringSz (rsChunkSize rs')-          !contWant = rsHead rs' + fromIntegral contChunk-      io $ rsEnsureRoom rs' contWant-      let !contOff = fromIntegral (rsHead rs') .&. rsMask rs'-          !contPtr = rsBase rs' `plusPtr` contOff+      -- Settle the builder's bytes (flushing any active spill),+      -- copy the BS in ring-sized chunks, then open a fresh+      -- region for subsequent builder writes.+      rs0 <- io $ readIORef rsRef+      let !contChunk = min (rsRingSize rs0) (rsChunkSize rs0)+      contPtr <- io $ do+        rs1 <- settleRingSink rs0 cur+        rs2 <- S.unsafeUseAsCString bstr $ \src ->+          ringCopyIn rs1 (castPtr src) (S.length bstr)+        rs3 <- openRingRegion rs2 contChunk+        writeIORef rsRef rs3+        pure (ringHeadPtr rs3)       setCur contPtr       setEnd (contPtr `plusPtr` contChunk) {-# NOINLINE byteStringInsert_ #-}@@ -1148,7 +1289,14 @@         BoundedGrowingBuffer fptr bound ->           growBufferBounded dRef fptr bound (I# n)     GrowingBuffer bufRef -> growBuffer bufRef (I# n)-    FixedBuffer -> error "Wireform.Builder: FixedBuffer overflow (size estimate too small)"+    FixedBuffer -> do+      r <- remainingBytes+      io $+        E.throwIO+          FixedBufferOverflow+            { fixedBufferRequested = I# n+            , fixedBufferAvailable = r+            }     HandleSink h nextCap queueRef -> do       cur <- getCur       io $ flushQueue h queueRef cur@@ -1184,53 +1332,24 @@           setEnd (newBase `plusPtr` I# n)     RingSink rsRef -> do       cur <- getCur-      rs <- io $ readIORef rsRef-      -- The ring provides at most ringSize contiguous bytes.-      -- ensureBytes requests larger than that are a programming-      -- error — use byteStringInsert (triggered automatically-      -- by byteString / byteStringThreshold) for large payloads.-      when (I# n > rsRingSize rs) $-        io $-          error $-            "Wireform.Builder: RingSink getBytes request ("-              ++ show (I# n)-              ++ ") exceeds ring size ("-              ++ show (rsRingSize rs)-              ++ "); use byteString/byteStringInsert for large payloads"-      let !off = fromIntegral (rsHead rs) .&. rsMask rs-          !startPtr = rsBase rs `plusPtr` off-          !written = cur `minusPtr` startPtr-          !newHead = rsHead rs + fromIntegral written-      -- Try to extend without publishing: the ring may already-      -- have room beyond what we initially reserved.-      let !chunkSz =-            min-              (rsRingSize rs)-              (max (I# n) (rsChunkSize rs))-          !wantHead = newHead + fromIntegral chunkSz-      tl <- io $ rsLoadTail rs-      let !ringCap = fromIntegral (rsRingSize rs) :: Word64-      published' <--        if wantHead - tl <= ringCap-          then-            io $ pure (rsPublished rs)-          else do-            io $ do-              when (newHead > rsPublished rs) $-                rsPublishHead rs newHead-              rsEnsureRoom rs wantHead-            io $ pure newHead-      let !newOff = fromIntegral newHead .&. rsMask rs-          !newPtr = rsBase rs `plusPtr` newOff-      io $-        writeIORef-          rsRef-          rs-            { rsHead = newHead-            , rsPublished = published'-            }-      setCur newPtr-      setEnd (newPtr `plusPtr` chunkSz)+      rs <- io $ readIORef rsRef >>= \rs0 -> settleRingSink rs0 cur+      if I# n > rsRingSize rs+        then do+          -- No ring region can hold this contiguously: spill into a+          -- scratch buffer; the next settle copies it into the ring.+          buf@(SpillBuf fp cap) <- io $ acquireSpill (rsSpill rs) (I# n)+          io $ writeIORef rsRef rs {rsSpill = SpillActive buf}+          let !base = unsafeForeignPtrToPtr fp+          setCur base+          setEnd (base `plusPtr` cap)+        else do+          -- Offer a full chunk; publish only if the ring lacks room.+          let !chunkSz = min (rsRingSize rs) (max (I# n) (rsChunkSize rs))+          rs' <- io $ openRingRegion rs chunkSz+          io $ writeIORef rsRef rs'+          let !newPtr = ringHeadPtr rs'+          setCur newPtr+          setEnd (newPtr `plusPtr` chunkSz) {-# NOINLINE getBytes_ #-}  
src/Wireform/Encode/Direct.hs view
@@ -117,16 +117,27 @@       pokeByteOff p (off + 1) (fromIntegral ((n `shiftR` 7) .&. 0x7F .|. 0x80) :: Word8)       pokeByteOff p (off + 2) (fromIntegral (n `shiftR` 14) :: Word8)       pure $! off + 3-  | otherwise = do-      n' <- encodeVarintFieldC p off 0 n-      pure $! off + n'+  | otherwise = go off n+  where+    -- Values of 2^21 and up are rare (lengths of 2 MiB+), so a plain loop.+    -- Not encodeVarintFieldC: that writes a field tag byte first.+    go !o !v+      | v < 0x80 = do+          pokeByteOff p o (fromIntegral v :: Word8)+          pure $! o + 1+      | otherwise = do+          pokeByteOff p o (fromIntegral (v .&. 0x7F .|. 0x80) :: Word8)+          go (o + 1) (v `shiftR` 7) {-# INLINE dVarint #-}   -- | Write raw bytes at offset (no length prefix). Returns new offset. dBytes :: Ptr Word8 -> Int -> ByteString -> IO Int dBytes !p !off (BSI.BS fp len) = do-  withForeignPtr fp $ \src ->+  -- This continuation only performs a bounded copy: it cannot loop or+  -- throw a Haskell exception. The touch-based lifetime wrapper therefore+  -- suffices and avoids a keepAlive# continuation allocation per string.+  BSI.unsafeWithForeignPtr fp $ \src ->     copyBytes (p `plusPtr` off) src len   pure $! off + len {-# INLINE dBytes #-}
src/Wireform/FFI.hs view
@@ -20,6 +20,14 @@ * 'compareBounds' \/ 'compareBoundsBS' — Iceberg partition bounds comparison * 'validateArrowBuffers' — Arrow IPC buffer offset validation * @read\/writeBE\/LE@ — endianness conversion helpers++Widths: every length and offset crosses the FFI at its full width, so a+'ByteString' or encode buffer over 2 GiB is not silently truncated. Byte+counts, capacities and reported counts are 'CSize' (\'size_t\'); positions+into a buffer, write cursors and scanner results are 'CPtrdiff'+(\'ptrdiff_t\'), which also carries the @-1@ / @len@ miss conventions.+Only genuinely small values (booleans, byte counts like bytes consumed,+the 32-bit bounds bitmask) stay 'CInt'. -} module Wireform.FFI (   -- * Packed varint helpers@@ -105,7 +113,7 @@ import Data.Text (Text) import Data.Text.Encoding qualified as TE import Data.Word (Word16, Word32, Word64, Word8, byteSwap16, byteSwap32, byteSwap64)-import Foreign.C.Types (CInt (..))+import Foreign.C.Types (CInt (..), CPtrdiff (..), CSize (..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Alloc qualified import Foreign.Marshal.Array qualified@@ -116,40 +124,52 @@ import Wireform.Builder qualified as B  +-- (byte count, varint count): both can exceed INT_MAX. foreign import ccall unsafe "hs_proto_count_packed_varints"-  c_count_packed_varints :: Ptr () -> CInt -> CInt+  c_count_packed_varints :: Ptr () -> CSize -> CSize  +-- (byte count), boolean result. foreign import ccall unsafe "hs_proto_packed_all_single_byte"-  c_packed_all_single_byte :: Ptr () -> CInt -> CInt+  c_packed_all_single_byte :: Ptr () -> CSize -> CInt  +-- (byte count), boolean result. foreign import ccall unsafe "hs_proto_validate_utf8_fast"-  c_validate_utf8_fast :: Ptr () -> CInt -> CInt+  c_validate_utf8_fast :: Ptr () -> CSize -> CInt  +-- (position), bytes consumed (1..8, or 0 on overflow). foreign import ccall unsafe "hs_proto_decode_varint_swar"-  c_decode_varint_swar :: Ptr () -> CInt -> Ptr Word64 -> CInt+  c_decode_varint_swar :: Ptr () -> CPtrdiff -> Ptr Word64 -> CInt  +-- (byte count, destination capacity), 1/0/-1 decision. foreign import ccall unsafe "hs_proto_relocate_page_boundary"-  c_relocate_page_boundary :: Ptr () -> CInt -> Ptr () -> CInt -> CInt+  c_relocate_page_boundary :: Ptr () -> CSize -> Ptr () -> CSize -> CInt  +-- (write cursor, byte count), bytes written. foreign import ccall unsafe "hs_proto_encode_length_delimited"-  c_encode_length_delimited :: Ptr () -> CInt -> Word8 -> Ptr () -> CInt -> CInt+  c_encode_length_delimited :: Ptr () -> CSize -> Word8 -> Ptr () -> CSize -> CSize  +-- (write cursor), bytes written. foreign import ccall unsafe "hs_proto_encode_varint_field"-  c_encode_varint_field :: Ptr () -> CInt -> Word8 -> Word64 -> CInt+  c_encode_varint_field :: Ptr () -> CSize -> Word8 -> Word64 -> CSize  +-- (write cursor), bytes written. foreign import ccall unsafe "hs_proto_encode_bool_field"-  c_encode_bool_field :: Ptr () -> CInt -> Word8 -> CInt -> CInt+  c_encode_bool_field :: Ptr () -> CSize -> Word8 -> CInt -> CSize   {- | Count the number of varints in a packed buffer using SWAR. Each byte with its high bit clear terminates one varint.++Both the length and the count cross the FFI at full width ('CSize'), so a+packed run over 2 GiB is counted whole, even when its count passes+'Prelude.maxBound' @::@ 'CInt'. -} countPackedVarints :: ByteString -> Int countPackedVarints bs = unsafePerformIO $@@ -168,7 +188,12 @@ {-# INLINE packedAllSingleByte #-}  --- | Encode a length-delimited field (tag + length varint + data) in one C call.+{- | Encode a length-delimited field (tag + length varint + data) in one C call.++@off@ is a non-negative write cursor and @dataLen@ a byte count; both are+passed as 'CSize' (the C @off@/return are \'size_t\'), so a direct-encode+buffer or a single field over 2 GiB is written whole.+-} encodeLengthDelimitedC :: Ptr Word8 -> Int -> Word8 -> Ptr Word8 -> Int -> IO Int encodeLengthDelimitedC buf off tag dataPtr dataLen =   pure $!@@ -251,7 +276,11 @@                 (castPtr outBuf)                 (fromIntegral outLen)         if result == 1-          then BS.packCStringLen (outBuf, len)+          then do+            -- packCStringLen copies; the scratch buffer is ours to free.+            copied <- BS.packCStringLen (outBuf, len)+            Foreign.Marshal.Alloc.free outBuf+            pure copied           else do             Foreign.Marshal.Alloc.free outBuf             pure bs@@ -262,8 +291,9 @@ -- SIMD NUL scanner ------------------------------------------------------------------------ +-- (start position, buffer length): both indices, so CPtrdiff; -1 on a miss. foreign import ccall unsafe "hs_proto_find_nul"-  c_find_nul :: Ptr () -> CInt -> CInt -> CInt+  c_find_nul :: Ptr () -> CPtrdiff -> CPtrdiff -> CPtrdiff   {- | Find the first NUL byte starting at the given offset within a raw pointer.@@ -291,13 +321,17 @@ absolute offset (0-based from the start of @buf@) of the first match, or @len@ if no match was found. +Both @offset@ and @len@ are indices into @buf@ and cross the FFI as+'CPtrdiff', so a 'ByteString' or scan range over 2 GiB is scanned whole+and a miss reports the real @len@ instead of a wrapped value.+ Callers that prefer @Maybe Int@ semantics should wrap the result; the @len@-on-miss convention matches the existing CSV / NDJSON / XML call sites that reused the primitive before it was lifted here. -} foreign import ccall unsafe "hs_find_byte"-  c_find_byte :: Ptr () -> CInt -> CInt -> Word8 -> CInt+  c_find_byte :: Ptr () -> CPtrdiff -> CPtrdiff -> Word8 -> CPtrdiff   findByte :: Ptr Word8 -> Int -> Int -> Word8 -> Int@@ -324,8 +358,9 @@ -- 4-byte repeating-key XOR (WebSocket masking) ------------------------------------------------------------------------ +-- (byte count), in place. foreign import ccall unsafe "hs_ws_mask"-  c_ws_mask :: Ptr Word8 -> CInt -> Word32 -> IO ()+  c_ws_mask :: Ptr Word8 -> CSize -> Word32 -> IO ()   {- | In-place XOR of the 4-byte repeating @key@ over @buf[0..len)@.@@ -369,8 +404,10 @@ OS thread's xoshiro256++ generator.  State is per-OS-thread (@__thread@), seeded from @getrandom(2)@-(@arc4random_buf@ on BSDs, @\/dev\/urandom@ everywhere else) on-first use.  Once seeded, each call is a handful of register-only+(@arc4random_buf@ on macOS and the BSDs, @BCryptGenRandom@ on+Windows, @\/dev\/urandom@ elsewhere) on first use, and reseeded in+the child after @fork@ so parent and child never share a stream.+Once seeded, each call is a handful of register-only arithmetic ops — typically ~1 ns including the FFI boundary, versus ~50 ns for the global @splitmix@ generator that takes an @MVar@ on every call.@@ -393,8 +430,9 @@ -- SIMD ASCII check ------------------------------------------------------------------------ +-- (position, byte count from there), boolean result. foreign import ccall unsafe "hs_proto_is_ascii"-  c_is_ascii :: Ptr () -> CInt -> CInt -> CInt+  c_is_ascii :: Ptr () -> CPtrdiff -> CPtrdiff -> CInt   -- | Check if @len@ bytes starting at @ptr+offset@ are all ASCII.@@ -429,8 +467,9 @@ -- SIMD JSON escape scanner ------------------------------------------------------------------------ +-- (position, byte count from there), position or offset+len: CPtrdiff. foreign import ccall unsafe "hs_proto_find_json_escape"-  c_find_json_escape :: Ptr () -> CInt -> CInt -> CInt+  c_find_json_escape :: Ptr () -> CPtrdiff -> CPtrdiff -> CPtrdiff   {- | Find the first byte that needs JSON escaping (control char < 0x20,@@ -506,8 +545,9 @@ -- SIMD EDN whitespace skipper ------------------------------------------------------------------------ +-- (start position, buffer length), position: CPtrdiff throughout. foreign import ccall unsafe "hs_proto_skip_ws"-  c_skip_ws :: Ptr () -> CInt -> CInt -> CInt+  c_skip_ws :: Ptr () -> CPtrdiff -> CPtrdiff -> CPtrdiff   {- | Skip EDN whitespace (space, tab, newline, CR, comma) and comments@@ -532,26 +572,44 @@ -- SIMD Iceberg bounds comparison ------------------------------------------------------------------------ +-- (count, width in bytes), 32-bit bitmask result. foreign import ccall unsafe "hs_proto_compare_bounds"-  c_compare_bounds :: Ptr () -> CInt -> CInt -> Ptr () -> CInt+  c_compare_bounds :: Ptr () -> CSize -> CSize -> Ptr () -> CInt   {- | Compare a search value against N serialized bounds (all same width). Returns a bitmask where bit i is set if @bounds[i] <= search@. For 4-byte LE int32 bounds, uses SSE2 to compare 4 at a time.++@count@ and @width@ are counts, not offsets, and must be non-negative:+they cross the FFI as 'CSize', so a negative value would become a huge+count; it is rejected here with an empty mask instead. @width == 0@+means empty bounds, which compare equal to the search value. -} compareBounds :: Ptr Word8 -> Int -> Int -> Ptr Word8 -> Int-compareBounds !boundsPtr !count !width !searchPtr =-  fromIntegral (c_compare_bounds (castPtr boundsPtr) (fromIntegral count) (fromIntegral width) (castPtr searchPtr))+compareBounds !boundsPtr !count !width !searchPtr+  | count < 0 || width < 0 = 0+  | otherwise =+      fromIntegral (c_compare_bounds (castPtr boundsPtr) (fromIntegral count) (fromIntegral width) (castPtr searchPtr)) {-# INLINE compareBounds #-}  --- | Compare bounds stored in a 'ByteString' against a search value 'ByteString'.+-- | Compare bounds stored in a 'ByteString' against a search value+-- 'ByteString'.+--+-- @count@ and @width@ are clamped to what the buffers actually hold, so a+-- caller that passes an inconsistent count cannot make the kernel read+-- past either buffer (the kernel trusts them: it compares @count*width@+-- bytes and reads @width@ from the search value). compareBoundsBS :: ByteString -> Int -> Int -> ByteString -> Int-compareBoundsBS boundsBs count width searchBs = unsafePerformIO $-  BSU.unsafeUseAsCStringLen boundsBs $ \(bPtr, _) ->-    BSU.unsafeUseAsCStringLen searchBs $ \(sPtr, _) ->-      pure $! compareBounds (castPtr bPtr) count width (castPtr sPtr)+compareBoundsBS boundsBs count width searchBs =+  let !w = max 0 (min width (BS.length searchBs))+      !fits = if w == 0 then 0 else BS.length boundsBs `quot` w+      !n = max 0 (min count fits)+  in unsafePerformIO $+       BSU.unsafeUseAsCStringLen boundsBs $ \(bPtr, _) ->+         BSU.unsafeUseAsCStringLen searchBs $ \(sPtr, _) ->+           pure $! compareBounds (castPtr bPtr) n w (castPtr sPtr) {-# INLINE compareBoundsBS #-}  @@ -560,17 +618,32 @@ ------------------------------------------------------------------------  foreign import ccall unsafe "hs_proto_validate_arrow_buffers"-  c_validate_arrow_buffers :: Ptr () -> CInt -> Int64 -> CInt+  c_validate_arrow_buffers :: Ptr () -> CSize -> Int64 -> CInt +foreign import ccall safe "hs_proto_validate_arrow_buffers"+  c_validate_arrow_buffers_safe :: Ptr () -> CSize -> Int64 -> CInt + {- | Validate Arrow IPC buffer offset/length pairs. Buffers are pairs of @(offset :: Int64, length :: Int64)@ packed contiguously. Returns 'True' if all offsets/lengths are non-negative, within body_length, and non-overlapping.++The kernel is one linear pass over the pairs (16 bytes each). Like the+"Columnar.SIMD" kernels it uses an @unsafe@ call for at most 64 KiB of+input (4096 buffers, far more than a record batch normally has) and a+@safe@ call above that, so a hostile buffer table cannot hold up the RTS.++@count@ is the number of pairs and crosses the FFI as 'CSize'; a negative+@count@ or body length is a caller bug that would otherwise widen into a+huge count, so both are rejected as invalid here instead of reaching the+kernel. -} validateArrowBuffers :: Ptr Int64 -> Int -> Int64 -> Bool-validateArrowBuffers !ptr !count !bodyLength =-  c_validate_arrow_buffers (castPtr ptr) (fromIntegral count) bodyLength /= 0+validateArrowBuffers !ptr !count !bodyLength+  | count < 0 || bodyLength < 0 = False+  | count <= 4096 = c_validate_arrow_buffers (castPtr ptr) (fromIntegral count) bodyLength /= 0+  | otherwise = c_validate_arrow_buffers_safe (castPtr ptr) (fromIntegral count) bodyLength /= 0 {-# INLINE validateArrowBuffers #-}  
src/Wireform/Hash.hs view
@@ -17,6 +17,12 @@ The implementations live in @cbits/wireform_hash_simd.c@. All entry points are 'unsafePerformIO' / 'unsafeDupablePerformIO' wrapped so callers don't think about IO.++Byte counts ('murmur3_32', 'xxh64') cross the FFI as 'CSize' (@size_t@),+so a 'BS.ByteString' of any length on a 64-bit platform is hashed in+full rather than truncated at 2^31. The Roaring kernels take element+counts instead, which the container format bounds far below 2^31 (see+'arrayCard'), so those stay 'Int32'. -} module Wireform.Hash (   -- * Murmur3 32-bit (Iceberg @BucketUtil@)@@ -26,6 +32,7 @@    -- * XXH64   xxh64,+  xxh64IO,    -- * Roaring 32-bit container   roaringDecodeArray,@@ -44,8 +51,10 @@ import Data.Vector.Storable qualified as VS import Data.Vector.Storable.Mutable qualified as VSM import Data.Word (Word16, Word32, Word64, Word8)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr, castPtr)+import Foreign.C.Types (CSize (..))+import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Foreign.Ptr (Ptr, castPtr, plusPtr) import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO)  @@ -53,8 +62,10 @@ -- C entry points -- ============================================================ +-- Byte counts cross the FFI as CSize (size_t): a ByteString over 2 GiB is+-- hashed in full, and the C kernels index with the same width. foreign import ccall unsafe "hs_wf_murmur3_32"-  c_murmur3_32 :: Ptr Word8 -> Int32 -> Int32+  c_murmur3_32 :: Ptr Word8 -> CSize -> Int32   foreign import ccall unsafe "hs_wf_bucket_long"@@ -62,7 +73,7 @@   foreign import ccall unsafe "hs_wf_xxh64"-  c_xxh64 :: Ptr Word8 -> Int64 -> Word64 -> Word64+  c_xxh64 :: Ptr Word8 -> CSize -> Word64 -> IO Word64   foreign import ccall unsafe "hs_wf_roaring_decode_array"@@ -89,7 +100,14 @@ -- Public wrappers -- ============================================================ --- | Murmur3 32-bit hash with seed 0, matching Iceberg's @BucketUtil.hash@.+{- | Murmur3 32-bit hash with seed 0, matching Iceberg's @BucketUtil.hash@.++The whole 'BS.ByteString' is hashed: its length is passed as 'CSize'+(@size_t@), so inputs above 2 GiB are not narrowed. Note that the+algorithm folds the length into the finalizer as a @uint32@, so two+lengths differing by a multiple of 2^32 hash alike; that is the+reference behaviour, not a truncation here.+-} murmur3_32 :: BS.ByteString -> Int32 murmur3_32 bs = unsafePerformIO $   unsafeUseAsCStringLen bs $ \(p, len) ->@@ -122,14 +140,30 @@ {-# INLINE bucketBytes #-}  --- | XXH64 with caller-supplied seed.+{- | XXH64 with caller-supplied seed. The byte length is a 'CSize'+(@size_t@), so a 'BS.ByteString' over 2 GiB is hashed in full.+-} xxh64 :: Word64 -> BS.ByteString -> Word64-xxh64 seed bs = unsafePerformIO $-  unsafeUseAsCStringLen bs $ \(p, len) ->-    pure $! c_xxh64 (castPtr p) (fromIntegral len) seed+xxh64 seed bs = unsafePerformIO (xxh64IO seed bs) {-# INLINE xxh64 #-}  +{- | The same XXH64 operation in IO. Streaming callers can thread its+result directly through their loop without allocating a pure thunk+and running a separate 'unsafePerformIO' boundary for each value.+-}+xxh64IO :: Word64 -> BS.ByteString -> IO Word64+xxh64IO seed bs = do+  let (fp, offset, len) = BSI.toForeignPtr bs+  hash <- c_xxh64 (unsafeForeignPtrToPtr fp `plusPtr` offset) (fromIntegral len) seed+  -- The stateful FFI call finishes before touchForeignPtr. Returning its+  -- result after this lifetime barrier lets callers keep it unboxed;+  -- withForeignPtr would return a boxed Word64 through keepAlive#.+  touchForeignPtr fp+  pure hash+{-# INLINE xxh64IO #-}++ -- ============================================================ -- Roaring containers -- ============================================================@@ -139,7 +173,10 @@   {- | Decode a Roaring ARRAY container payload into a vector of 32-bit-positions, OR'd with @hi << 16@.+positions, OR'd with @hi << 16@. Only the payload's whole little-endian+lows are read: a payload shorter than @cardinality * 2@ bytes (a+truncated blob) decodes to that many positions, and a negative+cardinality to none. -} roaringDecodeArray   :: BS.ByteString@@ -150,17 +187,19 @@   -- ^ High 32 bits to OR onto each position.   -> VS.Vector Int32 roaringDecodeArray bs card hi = unsafeDupablePerformIO $ do-  mv <- VSM.unsafeNew card+  let !n = arrayCard bs card+  mv <- VSM.unsafeNew n   VSM.unsafeWith mv $ \dst ->     unsafeUseAsCStringLen bs $ \(src, _) -> do-      _ <- pure $! c_roaring_decode_array (castPtr src) (fromIntegral card) hi dst+      _ <- pure $! c_roaring_decode_array (castPtr src) (fromIntegral n) hi dst       pure ()   VS.unsafeFreeze mv {-# INLINE roaringDecodeArray #-}   {- | Decode a Roaring BITSET container payload (exactly 8192 bytes) into-a vector of set positions, OR'd with @hi << 16@.+a vector of set positions, OR'd with @hi << 16@. A shorter payload reads+as if zero-padded to 8192 bytes. -} roaringDecodeBitset   :: BS.ByteString@@ -171,14 +210,16 @@ roaringDecodeBitset bs hi = unsafeDupablePerformIO $ do   mv <- VSM.unsafeNew 65536   written <- VSM.unsafeWith mv $ \dst ->-    unsafeUseAsCStringLen bs $ \(src, _) ->+    unsafeUseAsCStringLen (bitsetPayload bs) $ \(src, _) ->       pure $! c_roaring_decode_bitset (castPtr src) hi dst   let n = fromIntegral written   VS.unsafeFreeze (VSM.unsafeSlice 0 n mv) {-# INLINE roaringDecodeBitset #-}  --- | Test whether a 16-bit low value is present in a Roaring container.+{- | Test whether a 16-bit low value is present in a Roaring container.+The payload is bounded as in 'roaringDecodeArray' / 'roaringDecodeBitset'.+-} roaringContains   :: RoaringContainerKind   -> BS.ByteString@@ -187,10 +228,38 @@   -> Word16   -> Bool roaringContains kind bs card v = unsafePerformIO $-  unsafeUseAsCStringLen bs $ \(p, _) ->-    let !k = case kind of ArrayContainer -> 0; BitsetContainer -> 1-    in pure $! c_roaring_contains k (castPtr p) (fromIntegral card) v /= 0+  case kind of+    ArrayContainer ->+      unsafeUseAsCStringLen bs $ \(p, _) ->+        pure $! c_roaring_contains 0 (castPtr p) (fromIntegral (arrayCard bs card)) v /= 0+    BitsetContainer ->+      unsafeUseAsCStringLen (bitsetPayload bs) $ \(p, _) ->+        pure $! c_roaring_contains 1 (castPtr p) 0 v /= 0 {-# INLINE roaringContains #-}+++{- | The ARRAY cardinality the C kernels may read: the caller's count+clamped to the payload's whole uint16 lows and to the Int32 range. The C+side has no payload length, and Iceberg's @decodeDV@ passes a count taken+from untrusted blob bytes next to a payload that may be truncated.++The Int32 clamp is not a width compromise: a Roaring ARRAY container+holds at most 4096 distinct 16-bit lows (and a BITSET at most 65536), so+no valid container can ask for a count above 2^31. The clamp exists to+reject an untrusted count before any allocation.+-}+arrayCard :: BS.ByteString -> Int -> Int+arrayCard bs card =+  max 0 (min card (min (BS.length bs `quot` 2) (fromIntegral (maxBound :: Int32))))+{-# INLINE arrayCard #-}+++-- | A BITSET payload zero-padded to the 8192 bytes the C kernels read.+bitsetPayload :: BS.ByteString -> BS.ByteString+bitsetPayload bs+  | BS.length bs >= 8192 = bs+  | otherwise = bs <> BS.replicate (8192 - BS.length bs) 0+{-# INLINE bitsetPayload #-}   {- | Encode a sorted vector of 16-bit positions as a Roaring ARRAY
src/Wireform/Parser.hs view
@@ -150,6 +150,7 @@ import Data.ByteString.Internal qualified as BSI import Data.Int import Data.Word+import Foreign.C.Types (CSize (..)) import Foreign.Marshal.Utils (copyBytes) import GHC.Exts import GHC.Float (castWord32ToFloat, castWord64ToDouble)@@ -361,13 +362,17 @@   memcmpAddr# :: Addr# -> Addr# -> Int# -> Int#-memcmpAddr# a b n = case unsafeDupablePerformIO (c_memcmp (Ptr a) (Ptr b) (I# n)) of+memcmpAddr# a b n = case unsafeDupablePerformIO (c_memcmp (Ptr a) (Ptr b) (fromIntegral (I# n))) of   r -> if r == 0 then 0# else 1# {-# INLINE memcmpAddr# #-}  +-- memcmp's third parameter is size_t. n is the length of a literal+-- ByteString, which byteString has already compared against the bytes+-- remaining (`len# <=# ...`), so it is non-negative here and Int -> CSize+-- cannot narrow. foreign import ccall unsafe "memcmp"-  c_memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int+  c_memcmp :: Ptr Word8 -> Ptr Word8 -> CSize -> IO Int   ------------------------------------------------------------------------
src/Wireform/Parser/Switch.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-}@@ -166,13 +165,8 @@ -- TH code generation ------------------------------------------------------------------------ -#if MIN_VERSION_base(4,15,0) mkDoE :: [Stmt] -> Exp mkDoE = DoE Nothing-#else-mkDoE :: [Stmt] -> Exp-mkDoE = DoE-#endif   switch :: Q Exp -> Q Exp
src/Wireform/Ring/Internal.hs view
@@ -48,7 +48,7 @@ import Data.ByteString.Internal qualified as BSI import Data.Typeable (Typeable) import Data.Word (Word64, Word8)-import Foreign.C.Types (CInt (..), CLong (..), CSize (..))+import Foreign.C.Types (CInt (..), CSize (..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (Ptr, nullPtr, plusPtr)@@ -142,7 +142,12 @@           }  --- | Release the ring's virtual mappings.  Safe to call multiple times.+{- | Release the ring's virtual mappings.  Call it exactly once per ring:+each call passes a fresh copy of the base pointer to C, so a second call+unmaps whatever has been mapped at that address since (callers that may+close twice need their own once-guard, as+"Wireform.Network.Transport.Duplex" does).+-} destroyMagicRing :: MagicRing s -> IO () destroyMagicRing mr = alloca $ \p -> do   poke p (CRing (mrBase mr) (fromIntegral (mrSize mr)))
src/Wireform/Transport/Config.hs view
@@ -84,7 +84,9 @@ data TransportConfig = TransportConfig   { ringSizeHint :: !Int   {- ^ Requested ring size in bytes.  Rounded up to page-size multiple-  and power of two.  Default: 1 MiB.+  and power of two.  Default: 1 MiB.  The ring is mapped twice, so the+  ceiling is 4 GiB (1 GiB on a 32-bit target); a larger request fails+  with @ENOMEM@ instead of being silently clamped.   -}   , waitPolicy :: !WaitPolicy   , pinning :: !PinningPolicy
src/Wireform/Transport/Send.hs view
@@ -55,6 +55,7 @@ import Wireform.Builder.FastBuilder (   DataSink (RingSink),   RingSinkState (..),+  RingSpill (NoSpill),   finalizeRingSink,   runBuilder,  )@@ -343,6 +344,7 @@         , rsPublishHead = sendPublishHead t         , rsEnsureRoom = ensureRoom t         , rsLoadTail = sendLoadTail t+        , rsSpill = NoSpill         }   finalCur <- runBuilder b (RingSink rsRef) ptr (ptr `plusPtr` chunkSz)   _ <- finalizeRingSink rsRef finalCur
test/Spec.hs view
@@ -2,8 +2,10 @@  import Test.Syd import Wireform.Base64.Test qualified as Base64+import Wireform.FFI.Test qualified as FFI import Wireform.Parser.Test qualified as Parser import Wireform.Ring.Test qualified as Ring+import Wireform.Transport.SendBoundaryTest qualified as SendBoundary import Wireform.Transport.SendTest qualified as Send  @@ -12,4 +14,6 @@   Ring.spec   Parser.spec   Send.spec+  SendBoundary.spec   Base64.spec+  FFI.spec
+ test/Wireform/FFI/Test.hs view
@@ -0,0 +1,69 @@+module Wireform.FFI.Test (spec) where++import Data.ByteString qualified as BS+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Marshal.Array (peekArray)+import Foreign.Marshal.Utils (fillBytes)+import Foreign.Ptr (nullPtr)+import Test.Syd+import Wireform.Encode.Direct qualified as Direct+import Wireform.FFI (compareBounds, validateArrowBuffers)+import Wireform.Hash qualified as Hash+++{- | Negative counts and lengths must be rejected at the wrapper, not+widened: they cross the FFI as 'Data.Word.CSize'/'Int64', so a negative+'Int' would become a huge count and make the kernel read past the+caller's buffers.+-}+spec :: Spec+spec = describe "Wireform.FFI and direct encoding boundaries" $ do+  it "rejects a negative buffer count" $ do+    validateArrowBuffers nullPtr (-1) 8 `shouldBe` False++  it "rejects a negative body length" $ do+    validateArrowBuffers nullPtr 0 (-1) `shouldBe` False+    validateArrowBuffers nullPtr 1 (-1) `shouldBe` False++  it "rejects a negative bounds count with an empty mask" $ do+    compareBounds nullPtr (-1) 4 nullPtr `shouldBe` 0++  it "rejects a negative bound width with an empty mask" $ do+    compareBounds nullPtr 1 (-1) nullPtr `shouldBe` 0++  it "still accepts empty input" $ do+    validateArrowBuffers nullPtr 0 0 `shouldBe` True+    compareBounds nullPtr 0 0 nullPtr `shouldBe` 0++  it "keeps IO XXH64 byte-identical for empty, sliced, and block-boundary inputs" $ do+    empty <- Hash.xxh64IO 0 BS.empty+    empty `shouldBe` 0xef46db3751d8e999+    abc <- Hash.xxh64IO 0 (BS.pack [97, 98, 99])+    abc `shouldBe` 0x44bc2cf5ad770999+    mapM_+      ( \size -> do+          let payload = BS.pack (take size (cycle [0 .. 255]))+              sliced = BS.take size (BS.drop 3 (BS.replicate 3 0xa5 <> payload <> BS.replicate 7 0x5a))+          mapM_+            (\seed -> Hash.xxh64IO seed sliced >>= (`shouldBe` Hash.xxh64 seed payload))+            [0, 1, 0x123456789abcdef0, maxBound]+      )+      [0, 1, 7, 8, 15, 16, 31, 32, 33, 63, 64, 65, 257]++  it "writes raw varints across the 21-bit boundary without a field tag" $ do+    -- The published fallback used the field encoder with tag zero. That+    -- inserted an extra byte for values >= 2^21 (including 2 MiB lengths).+    let check value expected = allocaBytes 16 $ \ptr -> do+          fillBytes ptr 0xa5 16+          end <- Direct.dVarint ptr 3 value+          bytes <- peekArray 16 ptr+          end `shouldBe` (3 + length expected)+          bytes `shouldBe` (replicate 3 0xa5 ++ expected ++ replicate (13 - length expected) 0xa5)+    mapM_+      (uncurry check)+      [ (0x1fffff, [255, 255, 127])+      , (0x200000, [128, 128, 128, 1])+      , (0xfffffff, [255, 255, 255, 127])+      , (0x10000000, [128, 128, 128, 128, 1])+      , (maxBound, replicate 9 255 ++ [1])+      ]
+ test/Wireform/Transport/SendBoundaryTest.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE BangPatterns #-}++{- | Boundary properties for the ring-direct builder sink.++Which code path a builder primitive takes depends on how its+request compares with three sizes: the ring (a page multiple, so+host dependent), 'byteString''s copy/insert threshold+(@maximalCopySize@, ~8 KiB) and the sink's default chunk (32 KiB).+These properties cluster payload lengths at each of those and run+them against rings of 1x, 2x and 4x the page size, so every+crossing reachable on the host is exercised, whatever the page size.+-}+module Wireform.Transport.SendBoundaryTest (spec) where++import Control.Exception (evaluate, try)+import Data.ByteString qualified as BS+import Data.ByteString.Builder.Extra qualified as X+import Data.ByteString.Unsafe qualified as BSU+import Data.Word (Word8)+import Hedgehog (Gen, annotateShow, evalIO, forAll, property, (===))+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range+import Test.Syd+import Test.Syd.Hedgehog ()+import Wireform.Builder+import Wireform.Transport.Send+import Wireform.Transport.SendTest (readChunks, ringSizeAt, withTestTransport)+++-- | The builder primitives whose ring-sink paths differ.+data Prim+  = PByteString+  | PByteStringCopy+  | PByteStringInsert+  | PCStringLen+  | {- | @ensureBytes n@ then an unchecked write: the shape of+    every primitive that reserves its whole length up front (e.g.+    the proto string-field writer).+    -}+    PEnsureThenWrite+  deriving stock (Show, Eq, Enum, Bounded)+++-- | One primitive call, preceded by @itemLead@ single-byte writes.+data Item = Item+  { itemPrim :: !Prim+  , itemLead :: !Int+  , itemLen :: !Int+  }+  deriving stock (Show)+++spec :: Spec+spec = describe "SendTransport boundaries" $ do+  it "builder primitives round-trip at every ring/threshold/chunk boundary" $+    property $ do+      page <- evalIO (ringSizeAt 1)+      mult <- forAll (Gen.element [1, 2, 4])+      ringSz <- evalIO (ringSizeAt (mult * page))+      annotateShow ringSz+      items <- forAll (Gen.list (Range.linear 1 4) (genItem ringSz))+      corked <- forAll Gen.bool+      let payloads = zipWith itemPayload [0 ..] items+          expected =+            BS.concat+              (zipWith (\item p -> BS.replicate (itemLead item) leadByte <> p) items payloads)+      (bytes, _) <- evalIO $ withTestTransport ringSz $ \t ->+        withItems (zip items payloads) $ \b ->+          if corked+            then withSendCork t (`sendBuilderDirect` b)+            else sendBuilderDirect t b+      readChunks bytes === expected++  describe "FixedBuffer overflow" $ do+    it "getBytes past the end throws FixedBufferOverflow" $+      try (evaluate (toStrictByteStringExact 4 (word64BE 1)))+        `shouldReturn` Left (FixedBufferOverflow {fixedBufferRequested = 8, fixedBufferAvailable = 4})++    it "byteStringInsert past the end throws FixedBufferOverflow" $+      try (evaluate (toStrictByteStringExact 16 (byteStringInsert (BS.replicate 32 1))))+        `shouldReturn` Left (FixedBufferOverflow {fixedBufferRequested = 32, fixedBufferAvailable = 16})+++genItem :: Int -> Gen Item+genItem ringSz =+  Item+    <$> Gen.enumBounded+    <*> Gen.int (Range.linear 0 3)+    <*> Gen.frequency+      [ (3, Gen.element (boundaryLens ringSz))+      , (1, Gen.int (Range.linear 0 (4 * ringSz)))+      ]+++-- | Every interesting size, and one either side of it.+boundaryLens :: Int -> [Int]+boundaryLens ringSz =+  filter (>= 0) $+    concatMap+      (\b -> fmap (b +) [-1, 0, 1])+      [0, ringSz, 2 * ringSz, maximalCopySize, defaultDirectChunk]+  where+    -- 'byteString' copies below this and inserts at or above it.+    maximalCopySize = 2 * X.smallChunkSize+    -- 'sendBuilderDirect''s default region size.+    defaultDirectChunk = 32768+++-- | Distinct content per item so misordered chunks are caught.+itemPayload :: Int -> Item -> BS.ByteString+itemPayload i item = fst (BS.unfoldrN (itemLen item) step (i * 37))+  where+    step !k = Just (fromIntegral (k `rem` 251) :: Word8, k + 1)+++leadByte :: Word8+leadByte = 0xA5+++{- | Build all items into one 'Builder' and run the action with it.+'PCStringLen' borrows the payload's buffer, so the action runs+inside every 'BSU.unsafeUseAsCStringLen' scope.+-}+withItems :: [(Item, BS.ByteString)] -> (Builder -> IO a) -> IO a+withItems [] k = k mempty+withItems ((item, p) : rest) k =+  withPrim (itemPrim item) p $ \b ->+    withItems rest $ \bs ->+      k (mconcat (replicate (itemLead item) (word8 leadByte)) <> b <> bs)+++withPrim :: Prim -> BS.ByteString -> (Builder -> IO a) -> IO a+withPrim prim p k = case prim of+  PByteString -> k (byteString p)+  PByteStringCopy -> k (byteStringCopy p)+  PByteStringInsert -> k (byteStringInsert p)+  PCStringLen -> BSU.unsafeUseAsCStringLen p (k . unsafeCStringLen)+  PEnsureThenWrite -> k (ensureBytes (BS.length p) <> byteStringCopyNoCheck p)
test/Wireform/Transport/SendTest.hs view
@@ -1,8 +1,15 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} -module Wireform.Transport.SendTest (spec) where+module Wireform.Transport.SendTest (+  spec, +  -- * Shared with "Wireform.Transport.SendBoundaryTest"+  withTestTransport,+  readChunks,+  ringSizeAt,+) where+ import Control.Exception (catch) import Data.Bits ((.&.)) import Data.ByteString qualified as BS@@ -344,6 +351,33 @@           sendBuilderDirect corked (byteString payload)       readChunks bytes `shouldBe` payload       readIORef pubs >>= (`shouldSatisfy` (> 1))++    -- 'byteString' copies below ~8 KiB and inserts above it, while+    -- the ring size tracks the page size; pin both paths explicitly+    -- so the suite exercises each regardless of host page size.+    it "byteStringCopy > ring inside cork" $ do+      sz <- ringSizeAt 4096+      let payload = patternBytes (sz + 1)+      (bytes, pubs) <- withTestTransport 4096 $ \t ->+        withSendCork t $ \corked ->+          sendBuilderDirect corked (word8 0x7F <> byteStringCopy payload <> word8 0x7E)+      readChunks bytes `shouldBe` BS.concat [BS.singleton 0x7F, payload, BS.singleton 0x7E]+      readIORef pubs >>= (`shouldSatisfy` (> 1))++    it "byteStringCopy > ring uncorked" $ do+      sz <- ringSizeAt 4096+      let payload = patternBytes (sz * 3 + 7)+      (bytes, _) <- withTestTransport 4096 $ \t ->+        sendBuilderDirect t (byteStringCopy payload)+      readChunks bytes `shouldBe` payload++    it "byteStringInsert > ring inside cork" $ do+      sz <- ringSizeAt 4096+      let payload = patternBytes (sz + 1)+      (bytes, _) <- withTestTransport 4096 $ \t ->+        withSendCork t $ \corked ->+          sendBuilderDirect corked (byteStringInsert payload)+      readChunks bytes `shouldBe` payload      it "many small sends exceeding ring" $ do       sz <- ringSizeAt 4096
wireform-core.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: wireform-core-version: 0.2.0.1+version: 0.3.0.0 synopsis: Shared FFI primitives for wireform format packages description:   Cross-format SWAR / SIMD-accelerated primitives used by every@@ -28,7 +28,7 @@ copyright: 2026 Ian Duncan category: Data, Codec, FFI build-type: Simple-tested-with: GHC == 9.6.4, GHC == 9.8.4+tested-with: GHC == 9.10.3, GHC == 9.12.4, GHC == 9.14.1 extra-source-files:   cbits/*.c   include/**/*.h@@ -116,14 +116,14 @@     c-sources: cbits/magic_ring_posix.c   if os(windows)     c-sources: cbits/magic_ring_windows.c-    extra-libraries: kernel32+    extra-libraries: kernel32 bcrypt    build-depends:-    base >= 4.18 && < 5,+    base >= 4.20 && < 5,     bytestring >= 0.11 && < 0.13,-    containers,-    ghc-prim,-    template-haskell,+    containers >= 0.6 && < 0.9,+    ghc-prim >= 0.12 && < 0.14,+    template-haskell >= 2.22 && < 2.25,     text >= 2.0 && < 2.2,     vector >= 0.13 && < 0.14 @@ -136,12 +136,16 @@     Wireform.Ring.Test     Wireform.Parser.Test     Wireform.Transport.SendTest+    Wireform.Transport.SendBoundaryTest     Wireform.Base64.Test+    Wireform.FFI.Test   build-depends:     base,     bytestring,     wireform-core,     sydtest,+    sydtest-hedgehog,+    hedgehog >= 1.0 && < 1.8,     QuickCheck  benchmark parser-bench