Commit568a3a9bRecorded21 Jul 2026Repositorysigil-wire
Add sigil-wire: typed binary codec for Sigil values
Message
A length-prefixed, typed binary serialization of the Sigil value model, decoded in one O(n) forward pass with string/bytevector bodies memcpy'd. The transport-neutral wire format for bulk structured payloads (binary sibling to sigil-json).
- Encode/decode for every value type: #f, #t, exact ints (incl. bignum), doubles, string, bytevector, keyword, symbol, char, list, dict, vector (#()) and array (#[]). Non-representable values are encode errors.
- Header MAGIC/VERSION/FLAGS; per-value tag + LEB128 varint lengths. Int = single zigzag-LEB128 for all magnitudes. Float = 8-byte IEEE-754 LE (inf/NaN bit-exact) derived via pure float arithmetic.
- Security: the decoder is a trust boundary. Every length is checked against the remaining buffer before allocating; configurable caps (body length, collection count, nesting depth, total size, int magnitude); bounds-checked cursor; endless/lying frames error cleanly.
- 113 tests: round-trip every type + edge cases, plus a hostile-input fuzz suite (truncation, lying lengths, cap violations, unknown tag/version, varint abuse). README + docs/wire.md specify the format.
Varint and float-bit paths use integer arithmetic (quotient/remainder/*) rather than bitwise/shift, which corrupt fixnum<->bignum boundary values.
Changed
.gitignore | 2 +
LICENSE | 28 +++++++++
README.md | 148 +++++++++++++++++++++++++++++++++++++++++++++
dev-redirects.sgl | 6 ++
docs/wire.md | 169 ++++++++++++++++++++++++++++++++++++++++++++++++++++
manifest.scm | 10 ++++
package.sgl | 18 ++++++
sigil.lock | 9 +++
src/sigil/wire.sgl | 568 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-wire.sgl | 309 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
10 files changed, 1267 insertions(+)Diff
.gitignoreadded
@@ -0,0 +1,2 @@
+1
build/+2
.sigil/LICENSEadded
@@ -0,0 +1,28 @@
+1
BSD 3-Clause License+2
+3
Copyright (c) 2025 David Wilson+4
+5
Redistribution and use in source and binary forms, with or without+6
modification, are permitted provided that the following conditions are met:+7
+8
1. Redistributions of source code must retain the above copyright notice, this+9
list of conditions and the following disclaimer.+10
+11
2. Redistributions in binary form must reproduce the above copyright notice,+12
this list of conditions and the following disclaimer in the documentation+13
and/or other materials provided with the distribution.+14
+15
3. Neither the name of the copyright holder nor the names of its+16
contributors may be used to endorse or promote products derived from+17
this software without specific prior written permission.+18
+19
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+20
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+21
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+22
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+23
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+24
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+25
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+26
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+27
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+28
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.README.mdadded
@@ -0,0 +1,148 @@
+1
# sigil-wire+2
+3
A typed, length-prefixed **binary codec** for the [Sigil](https://codeberg.org/sigil/sigil)+4
value model. The binary sibling to+5
[sigil-json](https://codeberg.org/sigil/sigil-json): where JSON is the+6
human-readable format for small control messages, sigil-wire is the compact,+7
fast format for **bulk structured payloads**.+8
+9
Values decode in a single O(n) forward pass, and string/bytevector bodies are+10
copied wholesale (`memcpy`), avoiding the per-character O(n²) work that JSON+11
encoding of Sigil values incurs. It is the transport-neutral wire format used by+12
the Slate/Lantern bulk channel and inherited by Familiar over Enclave.+13
+14
## Usage+15
+16
```scheme+17
(import (sigil wire))+18
+19
;; Encode any Sigil value to a self-describing bytevector.+20
(define bytes (wire-encode #{ name: "Alice" scores: #[10 20 30] }))+21
+22
;; Decode it back.+23
(wire-decode bytes)+24
; => #{ name: "Alice" scores: #[10 20 30] }+25
```+26
+27
The decoder is a **trust boundary**: bytes may be attacker-influenced (over+28
Enclave). Pass a caps record to bound the work a hostile frame can trigger:+29
+30
```scheme+31
(wire-decode bytes (make-wire-caps max-depth: 32 max-count: 1000))+32
```+33
+34
## API+35
+36
| Procedure | Purpose |+37
|-----------|---------|+38
| `(wire-encode value)` → bytevector | Serialize a Sigil value. |+39
| `(wire-decode bytevector [caps])` → value | Deserialize, bounded by `caps`. |+40
| `(make-wire-caps [keys])` → caps | Build a decode-limits record. |+41
| `default-wire-caps` | The default caps used when none is passed. |+42
+43
### Caps (decoder limits)+44
+45
`make-wire-caps` accepts keyword arguments; any omitted field takes its default:+46
+47
| Field | Default | Meaning |+48
|-------|---------|---------|+49
| `max-bytes-len:` | 64 MiB | Largest single string / bytevector body. |+50
| `max-count:` | 16 M | Largest collection (list/vector/array length, dict pairs). |+51
| `max-depth:` | 256 | Deepest nesting of collections. |+52
| `max-total:` | 256 MiB | Total body bytes allocated across the whole message. |+53
| `max-int-bytes:` | 1024 | Largest integer payload in varint bytes (bounds bignum size). |+54
+55
## Supported value types+56
+57
Every value the seam carries: `#f`, `#t`, exact integers (including bignums),+58
doubles, strings, bytevectors, keywords, symbols, characters, lists, dicts,+59
vectors (R7RS `#(...)`) and arrays (Sigil `#[...]`).+60
+61
A value that **cannot** be represented — a procedure, a port, a record without a+62
registered codec, an improper (dotted) list, or a non-real number — is an+63
**encode error**, never a silent drop. (Registered-tag record extensions are out+64
of scope for v1.)+65
+66
## Wire format+67
+68
A message is a fixed 4-byte header followed by exactly one root value:+69
+70
```+71
message : MAGIC(2) VERSION(1) FLAGS(1) <value>+72
0x53 0x57 0x01 0x00+73
+74
value : TAG(1) <payload>+75
```+76
+77
Decoders reject an unknown MAGIC or an unknown major VERSION. `FLAGS` is reserved+78
(0). Trailing bytes after the root value are a decode error.+79
+80
Lengths and counts are unsigned **LEB128** varints (little-endian base-128; the+81
high bit of each byte flags continuation). Small collections stay a single byte.+82
+83
### Tag table+84
+85
| TAG | Type | Payload |+86
|------|------------|---------|+87
| 0x00 | `#f` / nil | (none) |+88
| 0x01 | `#t` | (none) |+89
| 0x02 | int | zigzag LEB128 varint (bignum-safe, single format) |+90
| 0x03 | float | 8 bytes, IEEE-754 double, little-endian |+91
| 0x04 | string | varint N, then N UTF-8 bytes (memcpy) |+92
| 0x05 | bytevector | varint N, then N raw bytes (memcpy) |+93
| 0x06 | keyword | varint N, then N UTF-8 bytes |+94
| 0x07 | symbol | varint N, then N UTF-8 bytes |+95
| 0x08 | char | varint Unicode codepoint |+96
| 0x09 | list | varint K, then K values |+97
| 0x0A | dict | varint K, then K (key value) pairs |+98
| 0x0B | vector | varint K, then K values (R7RS `#(...)`) |+99
| 0x0C | array | varint K, then K values (Sigil `#[...]`) |+100
+101
Any tag outside this table is a **hard decode error** (never skip-and-continue —+102
a misparsed length would cascade).+103
+104
### Integers+105
+106
A single **zigzag LEB128** varint encodes every integer, from small values up to+107
arbitrary-precision bignums — there is no separate bignum form. Zigzag maps+108
signed to unsigned so small negatives stay short: `n >= 0 → 2n`, `n < 0 →+109
2|n| - 1`. The varint then encodes that non-negative value.+110
+111
### Floats+112
+113
Doubles are stored as their raw 64-bit IEEE-754 bit pattern, little-endian.+114
`+inf`, `-inf` and `NaN` round-trip bit-exactly. Note that Sigil cannot+115
distinguish `-0.0` from `+0.0` (they compare equal under every predicate and+116
print identically), so a negative zero encodes as `+0.0`.+117
+118
## Security+119
+120
The decoder never trusts a length it reads:+121
+122
- Every length prefix is checked against the remaining buffer **before** any+123
allocation or copy — it never pre-allocates N bytes from an untrusted varint.+124
- All caps (body length, collection count, nesting depth, total decoded size,+125
integer magnitude) are enforced, rejecting **before** allocating.+126
- A bounds-checked cursor means a truncated or lying frame errors cleanly and+127
never reads out of bounds; an endless varint is rejected rather than spun on.+128
+129
The test suite includes a hostile-input fuzz battery (truncated frames, lying+130
length prefixes, cap violations, unknown tags, unknown version, varint abuse)+131
asserting each errors cleanly.+132
+133
## Build+134
+135
```sh+136
sigil deps install+137
sigil build+138
```+139
+140
## Testing+141
+142
```sh+143
sigil test+144
```+145
+146
## License+147
+148
BSD-3-Clause. See [LICENSE](LICENSE).dev-redirects.sgladded
@@ -0,0 +1,6 @@
+1
;; Development redirects — point dependencies at local Sigil checkout+2
(redirects+3
repos: (list+4
(for-repo+5
url: "codeberg:sigil/sigil"+6
use: (from-path dir: "../sigil"))))docs/wire.mdadded
@@ -0,0 +1,169 @@
+1
# The sigil-wire format (v1)+2
+3
This is the normative, byte-level specification of the sigil-wire binary format,+4
for anyone implementing an encoder or decoder in another language. The reference+5
implementation is `src/sigil/wire.sgl`.+6
+7
All multi-byte integers are little-endian. Lengths and counts are unsigned+8
LEB128 varints. The format carries no schema: every value is self-describing via+9
a leading tag byte.+10
+11
## Message framing+12
+13
```+14
message : header value+15
header : MAGIC(2) VERSION(1) FLAGS(1)+16
```+17
+18
| Field | Bytes | Value | Notes |+19
|-------|-------|-------|-------|+20
| MAGIC | 2 | `0x53 0x57` (`"SW"`) | Rejected if it does not match. |+21
| VERSION | 1 | `0x01` | Decoders reject an unknown major version. |+22
| FLAGS | 1 | `0x00` | Reserved; currently ignored on decode. |+23
+24
Exactly one root `value` follows the header. Any bytes remaining after the root+25
value has been fully decoded are an error (a frame carries one value).+26
+27
## Varints (unsigned LEB128)+28
+29
A non-negative integer is encoded as a sequence of 7-bit groups, least+30
significant first. Each byte holds 7 payload bits in its low bits; the high bit+31
(`0x80`) is set on every byte except the last.+32
+33
```+34
encode(u):+35
loop:+36
byte = u mod 128+37
u = u div 128+38
if u == 0: emit(byte); break+39
else: emit(byte | 0x80)+40
+41
decode:+42
result = 0; mult = 1+43
loop:+44
b = next_byte()+45
result += (b mod 128) * mult+46
if b < 0x80: break+47
mult *= 128+48
```+49
+50
Examples: `0 → 00`, `1 → 01`, `127 → 7F`, `128 → 80 01`, `300 → AC 02`.+51
+52
> Implementation note: the reference decoder accumulates with integer+53
> multiply/add rather than shift/or. This is deliberate — Sigil's bitwise-shift+54
> primitives corrupt values crossing the fixnum/bignum boundary. Other languages+55
> may use shift/or freely.+56
+57
A decoder MUST cap varint length. The reference caps length/count varints at 10+58
bytes and integer-payload varints at `max-int-bytes` bytes, and additionally+59
range-checks decoded lengths/counts against the remaining buffer before use.+60
+61
## Values+62
+63
Each value begins with a 1-byte tag.+64
+65
| TAG | Type | Payload |+66
|-----|------|---------|+67
| `0x00` | `#f` / nil | none |+68
| `0x01` | `#t` | none |+69
| `0x02` | int | zigzag varint |+70
| `0x03` | float | 8 bytes IEEE-754 LE |+71
| `0x04` | string | varint N + N UTF-8 bytes |+72
| `0x05` | bytevector | varint N + N raw bytes |+73
| `0x06` | keyword | varint N + N UTF-8 bytes |+74
| `0x07` | symbol | varint N + N UTF-8 bytes |+75
| `0x08` | char | varint codepoint |+76
| `0x09` | list | varint K + K values |+77
| `0x0A` | dict | varint K + K (key value) pairs |+78
| `0x0B` | vector | varint K + K values |+79
| `0x0C` | array | varint K + K values |+80
+81
A tag not in this table is a hard error. Decoders MUST NOT attempt to skip an+82
unknown tag: without a length the parser cannot know how many bytes to skip, and+83
guessing cascades into misparsing the rest of the frame.+84
+85
### 0x02 int — zigzag varint+86
+87
A single format covers all integers, including arbitrary-precision bignums.+88
Zigzag maps signed to unsigned so small-magnitude negatives stay short:+89
+90
```+91
zigzag(n) = 2n if n >= 0+92
2|n| - 1 if n < 0+93
unzigzag(u) = u/2 if u even+94
-(u/2) - 1 if u odd (integer division)+95
```+96
+97
The zigzagged value is then written as an unsigned varint.+98
+99
Examples: `0 → 02 00`, `-1 → 02 01`, `1 → 02 02`, `-2 → 02 03`, `63 → 02 7E`.+100
+101
### 0x03 float — IEEE-754 double+102
+103
Eight bytes holding the raw IEEE-754 binary64 bit pattern, little-endian. Sign in+104
the top bit of the last (most significant) byte.+105
+106
- `+inf` = `7FF0000000000000`, `-inf` = `FFF0000000000000`.+107
- `NaN` is written canonically as `7FF8000000000000` (any incoming NaN+108
normalizes to this on encode); on decode any payload with exponent field all-1+109
and non-zero fraction is a NaN.+110
- `-0.0` is not represented distinctly by the reference implementation (Sigil+111
cannot distinguish it from `+0.0`); it encodes as `+0.0` = `0000000000000000`.+112
A decoder that receives `8000000000000000` should still produce `-0.0` where+113
the host supports it.+114
+115
Example: `3.14 → 03 1F 85 EB 51 B8 1E 09 40` (bytes are `0x40091EB851EB851F` LE).+116
+117
### 0x04 string / 0x05 bytevector / 0x06 keyword / 0x07 symbol+118
+119
A varint byte-count `N` followed by `N` bytes copied verbatim. Strings, keywords+120
and symbols carry UTF-8; bytevectors carry raw bytes. The decoder checks `N`+121
against the remaining buffer before allocating, then copies the body in one+122
`memcpy`. Keywords and symbols are interned from their UTF-8 name on decode.+123
+124
Example: `"hi" → 04 02 68 69`.+125
+126
### 0x08 char — codepoint varint+127
+128
A varint Unicode scalar value. Decoders should reject values above `0x10FFFF`.+129
+130
Example: `#\A → 08 41`.+131
+132
### 0x09 list / 0x0B vector / 0x0C array — counted sequences+133
+134
A varint element-count `K` followed by `K` encoded values in order. Lists, R7RS+135
vectors (`#(...)`) and Sigil arrays (`#[...]`) share this shape but use distinct+136
tags so their type is preserved across a round-trip.+137
+138
Example: `(1 2 3) → 09 03 02 02 02 04 02 06`.+139
+140
### 0x0A dict — counted key/value pairs+141
+142
A varint pair-count `K` followed by `2K` encoded values: `key`, `value`, `key`,+143
`value`, … Keys are ordinary values (usually keywords) and are encoded with their+144
own tag. Dict equality is order-independent, so the reference implementation does+145
not commit to a key order.+146
+147
Example: `#{ a: 1 } → 0A 01 06 01 61 02 02` (keyword `a`, then int `1`).+148
+149
## Decoder safety requirements+150
+151
An implementation reading untrusted bytes MUST:+152
+153
1. Validate MAGIC and VERSION before anything else.+154
2. Read every length/count into a bounded varint, then range-check it against the+155
remaining buffer **before** allocating or copying.+156
3. Enforce configurable limits: maximum single-body length, maximum collection+157
count, maximum nesting depth, maximum total decoded size, maximum integer+158
magnitude — rejecting **before** allocation.+159
4. Use a bounds-checked cursor so a truncated or lying frame errors cleanly and+160
never reads out of bounds.+161
5. Treat an unknown tag, unknown version, or trailing bytes as hard errors.+162
+163
## Versioning+164
+165
The 1-byte VERSION is the format's major version. A decoder rejects a version it+166
does not implement rather than guessing. New tags or payload shapes that are not+167
backward-compatible bump the version; a capability handshake at connect time (for+168
Familiar/Enclave) negotiates it so a new client and an old node degrade+169
gracefully.manifest.scmadded
@@ -0,0 +1,10 @@
+1
;; sigil-wire Development Environment+2
;; Use with: guix shell -m manifest.scm+3
;;+4
;; sigil-wire is pure Scheme with no vendored C, so the environment+5
;; only needs the common Sigil build toolchain.+6
+7
(specifications->manifest+8
'("gcc-toolchain"+9
"make"+10
"pkg-config"))package.sgladded
@@ -0,0 +1,18 @@
+1
;;; sigil-wire - Typed binary codec for Sigil values+2
;;;+3
;;; A length-prefixed, typed binary serialization of the Sigil value model,+4
;;; decoded in one O(n) forward pass with string/bytevector bodies memcpy'd.+5
;;; The transport-neutral wire format for bulk structured payloads: the binary+6
;;; sibling to sigil-json.+7
+8
(package+9
name: "sigil-wire"+10
version: "0.1.0"+11
sigil: "^0.17"+12
description: "Typed binary codec for Sigil values"+13
url: "https://codeberg.org/sigil/sigil-wire"+14
license: "BSD-3-Clause"+15
authors: (list "David Wilson <david@daviwil.com>")+16
+17
dependencies: (list+18
(from-git url: "codeberg:sigil/sigil" package: "sigil-stdlib" version: "^0.17")))sigil.lockadded
@@ -0,0 +1,9 @@
+1
;; Auto-generated by sigil deps install. Do not edit.+2
(lock+3
(package name: "sigil-stdlib"+4
url: "codeberg:sigil/sigil"+5
ref: "^0.17"+6
sha: "61809566520a392d08c8308ec6217e1ae719eedd"+7
package-selector: "sigil-stdlib"+8
version: "0.17.18")+9
)src/sigil/wire.sgladded
@@ -0,0 +1,568 @@
+1
;;; (sigil wire) - Typed binary codec for the Sigil value model+2
;;;+3
;;; A length-prefixed, typed serialization of Sigil values, decoded in one+4
;;; O(n) forward pass with string/bytevector bodies memcpy'd (no per-char+5
;;; work). This is the transport-neutral wire format for bulk structured+6
;;; payloads: the binary sibling to (sigil json).+7
;;;+8
;;; ## Why this exists+9
;;;+10
;;; JSON encoding of Sigil values is O(n^2) on the bulk path because+11
;;; `string-ref` is O(index) over UTF-8 and the encoder walks per-char. This+12
;;; codec keeps the "don't parse, just rehydrate" property that the base64+13
;;; bulk lane already proves: a tag byte says what follows, a varint says how+14
;;; long, and string/bytevector bodies are copied wholesale.+15
;;;+16
;;; JSON stays for tiny CONTROL messages (opens, acks, credits); this codec is+17
;;; for BULK structured payloads.+18
;;;+19
;;; ## Wire format+20
;;;+21
;;; ```+22
;;; message: MAGIC(2)=0x53 0x57 VERSION(1)=1 FLAGS(1)=0 <value>+23
;;; value: TAG(1) <payload>+24
;;; ```+25
;;;+26
;;; Lengths and counts are unsigned LEB128 varints (small collections stay one+27
;;; byte). Value tags:+28
;;;+29
;;; | TAG | type | payload |+30
;;; |------|------------|----------------------------------------------------|+31
;;; | 0x00 | #f / nil | (none) |+32
;;; | 0x01 | #t | (none) |+33
;;; | 0x02 | int | zigzag LEB128 varint (bignum-safe, single format) |+34
;;; | 0x03 | float | 8 bytes IEEE-754 double, little-endian |+35
;;; | 0x04 | string | uvarint N, then N UTF-8 bytes (memcpy) |+36
;;; | 0x05 | bytevector | uvarint N, then N raw bytes (memcpy) |+37
;;; | 0x06 | keyword | uvarint N, then N UTF-8 bytes |+38
;;; | 0x07 | symbol | uvarint N, then N UTF-8 bytes |+39
;;; | 0x08 | char | uvarint Unicode codepoint |+40
;;; | 0x09 | list | uvarint K, then K values |+41
;;; | 0x0A | dict | uvarint K, then K (key value) pairs |+42
;;; | 0x0B | vector | uvarint K, then K values (R7RS #(...)) |+43
;;; | 0x0C | array | uvarint K, then K values (Sigil #[...]) |+44
;;;+45
;;; ## Basic usage+46
;;;+47
;;; ```scheme+48
;;; (import (sigil wire))+49
;;;+50
;;; (define bytes (wire-encode #{ name: "Alice" scores: #[10 20 30] }))+51
;;; (wire-decode bytes)+52
;;; ; => #{ name: "Alice" scores: #[10 20 30] }+53
;;; ```+54
;;;+55
;;; ## Security: the decoder is a trust boundary+56
;;;+57
;;; Bytes handed to `wire-decode` may be attacker-influenced. The decoder:+58
;;; - checks every length prefix against the remaining buffer BEFORE allocating+59
;;; or copying (never pre-allocates N from an untrusted varint);+60
;;; - enforces configurable caps (max body length, collection count, nesting+61
;;; depth, total decoded size) and rejects — without allocating — on+62
;;; violation;+63
;;; - uses a bounds-checked cursor, so a truncated or lying frame errors+64
;;; cleanly and never reads out of bounds.+65
;;;+66
;;; Pass a caps record from `make-wire-caps` to tune the limits:+67
;;;+68
;;; ```scheme+69
;;; (wire-decode bytes (make-wire-caps max-depth: 32 max-count: 1000))+70
;;; ```+71
+72
(define-library (sigil wire)+73
(import (sigil core)+74
(sigil io)+75
(sigil math))+76
(export+77
;; Codec+78
wire-encode+79
wire-decode+80
+81
;; Security caps+82
make-wire-caps+83
default-wire-caps)+84
+85
(begin+86
+87
;; ========== Constants ==========+88
+89
(define MAGIC-0 #x53) ; 'S'+90
(define MAGIC-1 #x57) ; 'W'+91
(define WIRE-VERSION 1)+92
(define WIRE-FLAGS 0)+93
+94
(define TAG-FALSE #x00)+95
(define TAG-TRUE #x01)+96
(define TAG-INT #x02)+97
(define TAG-FLOAT #x03)+98
(define TAG-STRING #x04)+99
(define TAG-BYTEVECTOR #x05)+100
(define TAG-KEYWORD #x06)+101
(define TAG-SYMBOL #x07)+102
(define TAG-CHAR #x08)+103
(define TAG-LIST #x09)+104
(define TAG-DICT #x0A)+105
(define TAG-VECTOR #x0B)+106
(define TAG-ARRAY #x0C)+107
+108
;; A length/count varint indexes into the buffer, so it can never+109
;; legitimately need more than a handful of bytes. Cap it hard to bound+110
;; decode CPU regardless of the value it claims (which is then range-checked+111
;; against the remaining buffer anyway).+112
(define LEN-VARINT-MAX-BYTES 10)+113
+114
;; ========== Security caps ==========+115
+116
;;; Build a caps record controlling decode limits. Any omitted field takes+117
;;; the default from `default-wire-caps`.+118
;;;+119
;;; - `max-bytes-len` — largest single string/bytevector body (bytes)+120
;;; - `max-count` — largest collection (list/vector length, dict pairs)+121
;;; - `max-depth` — deepest nesting of collections+122
;;; - `max-total` — total body bytes allocated across the whole message+123
;;; - `max-int-bytes` — largest int payload (zigzag varint bytes), bounds+124
;;; bignum size+125
(define (make-wire-caps (keys: (max-bytes-len 67108864) ; 64 MiB+126
(max-count 16777216) ; 16 M+127
(max-depth 256)+128
(max-total 268435456) ; 256 MiB+129
(max-int-bytes 1024))) ; ~8192-bit+130
#{ max-bytes-len: max-bytes-len+131
max-count: max-count+132
max-depth: max-depth+133
max-total: max-total+134
max-int-bytes: max-int-bytes })+135
+136
(define default-wire-caps (make-wire-caps))+137
+138
;; ========== Varint (unsigned LEB128) ==========+139
+140
;; NOTE: the varint and float-bit paths use only arithmetic (quotient /+141
;; remainder / * / +), never bitwise-and / bitwise-ior / arithmetic-shift.+142
;; Sigil's bitwise/shift primitives mis-handle values straddling the+143
;; fixnum<->bignum boundary (e.g. round-tripping 2^62 or 7^500 through+144
;; shift+ior corrupts the value), whereas plain integer arithmetic is+145
;; correct for arbitrary-precision integers. See the wire-format topic note.+146
+147
;; Write a non-negative integer as unsigned LEB128 to a port.+148
(define (write-uvarint u port)+149
(let loop ((u u))+150
(let ((b (remainder u 128))+151
(rest (quotient u 128)))+152
(if (= rest 0)+153
(write-u8 b port)+154
(begin+155
(write-u8 (+ b 128) port)+156
(loop rest))))))+157
+158
;; Zigzag-map a signed integer to a non-negative one (bignum-safe).+159
(define (zigzag n)+160
(if (>= n 0)+161
(* n 2)+162
(- (* (- n) 2) 1)))+163
+164
;; Inverse of `zigzag`.+165
(define (unzigzag u)+166
(if (= 0 (remainder u 2))+167
(quotient u 2)+168
(- (- (quotient u 2)) 1)))+169
+170
;; ========== Float <-> IEEE-754 bits ==========+171
;;+172
;; Sigil's numeric tower is exact integers (incl. bignums) and inexact+173
;; doubles — there are NO exact rationals — so `(exact <float>)` errors on a+174
;; non-integer. We therefore derive the 64-bit IEEE-754 representation with+175
;; float arithmetic + exact-integer ops, never touching a rational. Every+176
;; scaling factor stays within the representable double range (|exponent| <=+177
;; 1022 per step) so no intermediate overflows to infinity.+178
+179
(define POW2-52 (expt 2 52)) ; 4503599627370496+180
(define POW2-63 (expt 2 63)) ; sign-bit place value+181
+182
;; Sigil has no infinity/NaN literals, but doubles CAN be inf/NaN (e.g. from+183
;; overflow). Build them once, by arithmetic, to reconstruct on decode.+184
(define WIRE-POS-INF (expt 2.0 2000)) ; overflows to +inf+185
(define WIRE-NEG-INF (- (expt 2.0 2000))) ; -inf+186
(define WIRE-NAN (- WIRE-POS-INF WIRE-POS-INF)) ; inf - inf = NaN+187
+188
;; Assemble sign/biased-exponent/fraction into a 64-bit unsigned integer.+189
(define (pack-bits sign biased frac)+190
(+ (* sign POW2-63) (* biased POW2-52) frac))+191
+192
;; Encode a double as its unsigned 64-bit IEEE-754 bit pattern.+193
;; NaN is checked BEFORE zero: Sigil's `(= nan 0.0)` returns #t, so a+194
;; zero-first test would mis-encode NaN as +0.0.+195
(define (double->bits x)+196
(cond+197
;; NaN: canonical quiet NaN (0x7FF8000000000000); fraction = 2^51.+198
((nan? x) (pack-bits 0 2047 (quotient POW2-52 2)))+199
;; +/- infinity.+200
((not (finite? x))+201
(if (< x 0.0) (pack-bits 1 2047 0) (pack-bits 0 2047 0)))+202
;; Zero (positive and negative zero both encode as +0.0; Sigil does not+203
;; distinguish them under `=`, `eqv?`, `equal?`, or `number->string`).+204
((= x 0.0) 0)+205
(else+206
(let* ((neg (< x 0.0))+207
(sign (if neg 1 0))+208
(ax (abs x)))+209
(if (< ax (expt 2.0 -1022))+210
;; Subnormal: significand = round(ax * 2^1074), scaled in two+211
;; representable steps (2^1074 itself overflows a double).+212
(let ((frac (exact (round (* (* ax (expt 2.0 1022))+213
(expt 2.0 52))))))+214
(pack-bits sign 0 frac))+215
;; Normal: find unbiased exponent e with 2^e <= ax < 2^(e+1).+216
(let loop ((e (exact (floor (/ (log ax) (log 2.0))))))+217
(cond+218
((<= (expt 2.0 (+ e 1)) ax) (loop (+ e 1)))+219
((> (expt 2.0 e) ax) (loop (- e 1)))+220
(else+221
;; ax/2^e is exactly a double in [1,2); *2^52 is an exact+222
;; integer significand in [2^52, 2^53).+223
(let* ((sig (exact (round (* (/ ax (expt 2.0 e))+224
(expt 2.0 52)))))+225
(frac (- sig POW2-52))+226
(biased (+ e 1023)))+227
(pack-bits sign biased frac))))))))))+228
+229
;; Decode an unsigned 64-bit IEEE-754 bit pattern to a double.+230
(define (bits->double bits)+231
(let* ((sign (quotient bits POW2-63))+232
(rest (remainder bits POW2-63))+233
(biased (quotient rest POW2-52))+234
(frac (remainder rest POW2-52)))+235
(cond+236
;; Inf / NaN carry their own sign; return directly.+237
((= biased 2047)+238
(cond+239
((not (= frac 0)) WIRE-NAN)+240
((= sign 1) WIRE-NEG-INF)+241
(else WIRE-POS-INF)))+242
(else+243
(let ((mag (cond+244
;; Zero / subnormal.+245
((= biased 0)+246
(if (= frac 0)+247
0.0+248
(* frac (expt 2.0 -1074))))+249
;; Normal.+250
(else+251
(* (+ frac POW2-52)+252
(expt 2.0 (- biased 1075)))))))+253
(if (= sign 1) (- mag) mag))))))+254
+255
;; ========== Encoding ==========+256
+257
;;; Encode a Sigil value to a self-describing wire bytevector.+258
;;;+259
;;; Every value type the seam carries is supported: #f, #t, exact integers+260
;;; (incl. bignums), doubles, strings, bytevectors, keywords, symbols,+261
;;; chars, lists, dicts, vectors and arrays. A value that cannot be+262
;;; represented —+263
;;; a procedure, a port, a record without a registered codec, an improper+264
;;; (dotted) list, or a non-real number — is an ENCODE error, never a+265
;;; silent drop.+266
;;;+267
;;; ```scheme+268
;;; (wire-encode #{ id: 7 tags: #["a" "b"] })+269
;;; ; => #<bytevector ...>+270
;;; ```+271
(define (wire-encode value)+272
(: any? -> bytevector?)+273
(let ((port (open-output-bytevector)))+274
(write-u8 MAGIC-0 port)+275
(write-u8 MAGIC-1 port)+276
(write-u8 WIRE-VERSION port)+277
(write-u8 WIRE-FLAGS port)+278
(encode-value value port)+279
(get-output-bytevector port)))+280
+281
;; Write a length-prefixed UTF-8 / raw body (the memcpy path).+282
(define (encode-bytes tag bv port)+283
(write-u8 tag port)+284
(write-uvarint (bytevector-length bv) port)+285
(write-bytevector bv port))+286
+287
;; Encode one value (tag + payload) to the port.+288
(define (encode-value value port)+289
(cond+290
;; Booleans / nil. Order matters: check booleans before numbers so #f+291
;; and #t never fall through to another branch.+292
((eq? value #f) (write-u8 TAG-FALSE port))+293
((eq? value #t) (write-u8 TAG-TRUE port))+294
;; Exact integers (fixnum + bignum) -> zigzag LEB128.+295
((exact-integer? value)+296
(write-u8 TAG-INT port)+297
(write-uvarint (zigzag value) port))+298
;; Any other number is a double (Sigil has no exact rationals; complex+299
;; numbers, if present, are rejected below).+300
((and (number? value) (inexact? value))+301
(write-u8 TAG-FLOAT port)+302
(encode-float value port))+303
;; String / bytevector -> memcpy body.+304
((string? value)+305
(encode-bytes TAG-STRING (string->utf8 value) port))+306
((bytevector? value)+307
(encode-bytes TAG-BYTEVECTOR value port))+308
;; Keyword / symbol -> UTF-8 name.+309
((keyword? value)+310
(encode-bytes TAG-KEYWORD (string->utf8 (keyword->string value)) port))+311
((symbol? value)+312
(encode-bytes TAG-SYMBOL (string->utf8 (symbol->string value)) port))+313
;; Char -> codepoint varint.+314
((char? value)+315
(write-u8 TAG-CHAR port)+316
(write-uvarint (char->integer value) port))+317
;; Empty list and proper lists.+318
((null? value)+319
(write-u8 TAG-LIST port)+320
(write-uvarint 0 port))+321
((pair? value)+322
(encode-list value port))+323
;; Vector (R7RS #(...)).+324
((vector? value)+325
(encode-vector value port))+326
;; Array (Sigil #[...], the primary bulk sequence type).+327
((array? value)+328
(encode-array value port))+329
;; Dict.+330
((dict? value)+331
(encode-dict value port))+332
(else+333
(error "wire-encode: value is not representable on the wire" value))))+334
+335
(define (encode-float value port)+336
(let ((bits (double->bits value)))+337
;; 8 bytes, little-endian (arithmetic, not bitwise).+338
(let loop ((i 0))+339
(when (< i 8)+340
(write-u8 (remainder (quotient bits (expt 256 i)) 256) port)+341
(loop (+ i 1))))))+342
+343
(define (encode-list value port)+344
;; Walk once: verify the list is proper and count length, collecting the+345
;; elements. An improper (dotted) tail is an encode error.+346
(let loop ((v value) (items '()) (n 0))+347
(cond+348
((null? v)+349
(write-u8 TAG-LIST port)+350
(write-uvarint n port)+351
(for-each (lambda (x) (encode-value x port)) (reverse items)))+352
((pair? v)+353
(loop (cdr v) (cons (car v) items) (+ n 1)))+354
(else+355
(error "wire-encode: improper (dotted) list is not representable" value)))))+356
+357
(define (encode-vector value port)+358
(let ((len (vector-length value)))+359
(write-u8 TAG-VECTOR port)+360
(write-uvarint len port)+361
(let loop ((i 0))+362
(when (< i len)+363
(encode-value (vector-ref value i) port)+364
(loop (+ i 1))))))+365
+366
(define (encode-array value port)+367
(let ((len (array-length value)))+368
(write-u8 TAG-ARRAY port)+369
(write-uvarint len port)+370
(let loop ((i 0))+371
(when (< i len)+372
(encode-value (array-ref value i) port)+373
(loop (+ i 1))))))+374
+375
(define (encode-dict value port)+376
(let ((entries (dict-entries value)))+377
(write-u8 TAG-DICT port)+378
(write-uvarint (length entries) port)+379
(for-each+380
(lambda (pair)+381
(encode-value (car pair) port)+382
(encode-value (cdr pair) port))+383
entries)))+384
+385
;; ========== Decoding cursor (bounds-checked) ==========+386
;;+387
;; The cursor is a mutable vector #(bv len pos total) so a lying/truncated+388
;; frame errors cleanly instead of reading out of bounds. `total` tracks+389
;; body bytes allocated so far, checked against the max-total cap.+390
+391
(define (cur-make bv)+392
(vector bv (bytevector-length bv) 0 0))+393
+394
(define (cur-bv c) (vector-ref c 0))+395
(define (cur-len c) (vector-ref c 1))+396
(define (cur-pos c) (vector-ref c 2))+397
(define (cur-remaining c) (- (vector-ref c 1) (vector-ref c 2)))+398
+399
;; Error unless at least n bytes remain.+400
(define (cur-need! c n)+401
(when (> n (cur-remaining c))+402
(error "wire-decode: truncated frame (buffer underrun)")))+403
+404
;; Read one byte, advancing the cursor.+405
(define (cur-u8! c)+406
(cur-need! c 1)+407
(let ((b (bytevector-u8-ref (cur-bv c) (cur-pos c))))+408
(vector-set! c 2 (+ (cur-pos c) 1))+409
b))+410
+411
;; Copy and return the next n bytes (the memcpy path), advancing the cursor.+412
(define (cur-take! c n)+413
(cur-need! c n)+414
(let* ((start (cur-pos c))+415
(slice (bytevector-copy (cur-bv c) start (+ start n))))+416
(vector-set! c 2 (+ start n))+417
slice))+418
+419
;; Account for n newly-allocated body bytes against the max-total cap.+420
(define (cur-add-total! c n caps)+421
(let ((total (+ (vector-ref c 3) n)))+422
(when (> total (dict-ref caps 'max-total:))+423
(error "wire-decode: total decoded size exceeds cap"))+424
(vector-set! c 3 total)))+425
+426
;; Read an unsigned LEB128 varint, rejecting one longer than max-bytes.+427
;; Arithmetic accumulation (result + low7 * mult) keeps bignums correct.+428
(define (read-uvarint c max-bytes)+429
(let loop ((result 0) (mult 1) (count 0))+430
(let ((b (cur-u8! c))+431
(count (+ count 1)))+432
(when (> count max-bytes)+433
(error "wire-decode: varint too long"))+434
(let ((result (+ result (* (remainder b 128) mult))))+435
(if (< b 128)+436
result+437
(loop result (* mult 128) count))))))+438
+439
;; Read a length/count varint (small cap) and range-check it against the+440
;; remaining buffer BEFORE it is used to allocate. `min-per` is the minimum+441
;; bytes each counted element consumes (1 for collections), so a count that+442
;; could not possibly fit in what remains is rejected without allocating.+443
(define (read-length c what min-per)+444
(let ((n (read-uvarint c LEN-VARINT-MAX-BYTES)))+445
(when (> (* n min-per) (cur-remaining c))+446
(error (string-append "wire-decode: " what " exceeds remaining buffer")))+447
n))+448
+449
;; ========== Decoding ==========+450
+451
;;; Decode a wire bytevector produced by `wire-encode` back into a Sigil+452
;;; value. The optional caps record (default `default-wire-caps`) bounds the+453
;;; work an untrusted frame can trigger.+454
;;;+455
;;; Raises a clean error on any malformed input: bad magic, unknown major+456
;;; version, unknown tag, truncated body, a length prefix that overruns the+457
;;; buffer, or a cap violation. It never reads out of bounds.+458
;;;+459
;;; ```scheme+460
;;; (wire-decode (wire-encode #[1 2 3]))+461
;;; ; => #[1 2 3]+462
;;; ```+463
(define (wire-decode bv . rest)+464
(: bytevector? any? ... -> any?)+465
(let ((caps (if (null? rest) default-wire-caps (car rest)))+466
(c (cur-make bv)))+467
;; Header.+468
(unless (and (= (cur-u8! c) MAGIC-0) (= (cur-u8! c) MAGIC-1))+469
(error "wire-decode: bad magic (not a sigil-wire frame)"))+470
(let ((version (cur-u8! c)))+471
(unless (= version WIRE-VERSION)+472
(error "wire-decode: unsupported wire version" version)))+473
(cur-u8! c) ; FLAGS (reserved, ignored)+474
(let ((value (decode-value c caps 0)))+475
;; Trailing bytes after a complete root value are malformed.+476
(when (> (cur-remaining c) 0)+477
(error "wire-decode: trailing bytes after root value"))+478
value)))+479
+480
;; Decode one value at the current cursor. `depth` is the current nesting+481
;; level, checked against max-depth on every collection.+482
(define (decode-value c caps depth)+483
(let ((tag (cur-u8! c)))+484
(cond+485
((= tag TAG-FALSE) #f)+486
((= tag TAG-TRUE) #t)+487
((= tag TAG-INT)+488
(unzigzag (read-uvarint c (dict-ref caps 'max-int-bytes:))))+489
((= tag TAG-FLOAT) (decode-float c))+490
((= tag TAG-STRING) (utf8->string (decode-body c caps)))+491
((= tag TAG-BYTEVECTOR) (decode-body c caps))+492
((= tag TAG-KEYWORD) (string->keyword (utf8->string (decode-body c caps))))+493
((= tag TAG-SYMBOL) (string->symbol (utf8->string (decode-body c caps))))+494
((= tag TAG-CHAR) (decode-char c))+495
((= tag TAG-LIST) (decode-list c caps depth))+496
((= tag TAG-DICT) (decode-dict c caps depth))+497
((= tag TAG-VECTOR) (decode-vector c caps depth))+498
((= tag TAG-ARRAY) (decode-array c caps depth))+499
(elseShowing the first 500 of 569 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.
test/test-wire.sgladded
@@ -0,0 +1,309 @@
+1
;;; Test suite for (sigil wire)+2
;;;+3
;;; Two halves:+4
;;; 1. Round-trip coverage for every value type + edge cases.+5
;;; 2. Hostile-input fuzzing of the decoder (the trust boundary): truncated+6
;;; frames, lying lengths, cap violations, unknown tags/versions. Each must+7
;;; error CLEANLY — no OOB read, no OOM, no spin.+8
+9
(import (sigil test)+10
(sigil wire)+11
(sigil core)+12
(sigil math))+13
+14
;; ---------- helpers ----------+15
+16
;; Round-trip: encode then decode.+17
(define (rt v)+18
(wire-decode (wire-encode v)))+19
+20
;; Does the thunk raise? (Clean-error probe for hostile inputs.)+21
(define (raises? thunk)+22
(guard (e (#t #t))+23
(thunk)+24
#f))+25
+26
;; Header bytes for a valid frame: MAGIC "SW", VERSION 1, FLAGS 0.+27
(define wire-header (list #x53 #x57 1 0))+28
+29
;; Build a bytevector from a list of bytes.+30
(define (bytes->bv lst)+31
(apply bytevector lst))+32
+33
;; A valid frame carrying the given raw payload bytes.+34
(define (frame . payload-bytes)+35
(bytes->bv (append wire-header payload-bytes)))+36
+37
;; ============================================================+38
;; Round-trip: primitives+39
;; ============================================================+40
+41
(test-group "round-trip - booleans and nil"+42
(test "false" (assert-equal #f (rt #f)))+43
(test "true" (assert-equal #t (rt #t)))+44
(test "empty list is nil-ish" (assert-equal '() (rt '()))))+45
+46
(test-group "round-trip - integers"+47
(test "zero" (assert-equal 0 (rt 0)))+48
(test "one" (assert-equal 1 (rt 1)))+49
(test "small positive" (assert-equal 42 (rt 42)))+50
(test "small negative" (assert-equal -1 (rt -1)))+51
(test "negative" (assert-equal -12345 (rt -12345)))+52
(test "127 boundary" (assert-equal 127 (rt 127)))+53
(test "128 boundary" (assert-equal 128 (rt 128)))+54
(test "large positive bignum" (assert-equal (expt 2 200) (rt (expt 2 200))))+55
(test "large negative bignum" (assert-equal (- (expt 2 200)) (rt (- (expt 2 200)))))+56
(test "huge bignum" (assert-equal (expt 7 500) (rt (expt 7 500))))+57
(test "negative huge bignum" (assert-equal (- (expt 7 500)) (rt (- (expt 7 500))))))+58
+59
(test-group "round-trip - floats"+60
(test "pi-ish" (assert-equal 3.14 (rt 3.14)))+61
(test "negative" (assert-equal -2.5 (rt -2.5)))+62
(test "zero" (assert-equal 0.0 (rt 0.0)))+63
(test "one" (assert-equal 1.0 (rt 1.0)))+64
(test "tenth" (assert-equal 0.1 (rt 0.1)))+65
(test "max double" (assert-equal 1.7976931348623157e308 (rt 1.7976931348623157e308)))+66
(test "large" (assert-equal 1e308 (rt 1e308)))+67
(test "small normal" (assert-equal 2.2250738585072014e-308 (rt 2.2250738585072014e-308)))+68
(test "subnormal" (assert-equal 1e-308 (rt 1e-308)))+69
(test "smallest subnormal" (assert-equal 5e-324 (rt 5e-324)))+70
(test "negative small" (assert-equal -0.001 (rt -0.001))))+71
+72
(test-group "round-trip - float special values"+73
;; Sigil has no inf/NaN literals but doubles can be inf/NaN (overflow etc.);+74
;; the codec must round-trip them bit-exactly.+75
(test "+inf" (assert-equal (expt 2.0 2000) (rt (expt 2.0 2000))))+76
(test "-inf" (assert-equal (- (expt 2.0 2000)) (rt (- (expt 2.0 2000)))))+77
(test "+inf stays infinite" (assert-true (infinite? (rt (expt 2.0 2000)))))+78
(test "-inf stays negative" (assert-true (< (rt (- (expt 2.0 2000))) 0.0)))+79
(test "NaN stays NaN"+80
(assert-true (nan? (rt (- (expt 2.0 2000) (expt 2.0 2000)))))))+81
+82
(test-group "round-trip - strings"+83
(test "empty" (assert-equal "" (rt "")))+84
(test "ascii" (assert-equal "hello" (rt "hello")))+85
(test "spaces and punct" (assert-equal "a, b. c!" (rt "a, b. c!")))+86
(test "2-byte utf8" (assert-equal "héllo" (rt "héllo")))+87
(test "3-byte utf8" (assert-equal "日本語" (rt "日本語")))+88
(test "4-byte utf8 emoji" (assert-equal "🚀🔥" (rt "🚀🔥")))+89
(test "mixed" (assert-equal "λ = π · r² 日 🚀" (rt "λ = π · r² 日 🚀")))+90
(test "embedded null"+91
(let ((s (string #\a (integer->char 0) #\b)))+92
(assert-equal s (rt s)))))+93
+94
(test-group "round-trip - bytevectors"+95
(test "empty" (assert-equal (bytevector) (rt (bytevector))))+96
(test "bytes" (assert-equal (bytevector 0 1 2 255) (rt (bytevector 0 1 2 255))))+97
(test "all-zero" (assert-equal (make-bytevector 10 0) (rt (make-bytevector 10 0)))))+98
+99
(test-group "round-trip - keywords and symbols"+100
(test "keyword" (assert-equal 'name: (rt 'name:)))+101
(test "keyword unicode" (assert-equal (string->keyword "café") (rt (string->keyword "café"))))+102
(test "symbol" (assert-equal 'foo-bar (rt 'foo-bar)))+103
(test "symbol unicode" (assert-equal (string->symbol "λ-fn") (rt (string->symbol "λ-fn")))))+104
+105
(test-group "round-trip - chars"+106
;; Non-ASCII char literals are built via integer->char (Sigil's reader does+107
;; not accept multi-byte #\<char> literals).+108
(test "ascii" (assert-equal #\a (rt #\a)))+109
(test "space" (assert-equal #\space (rt #\space)))+110
(test "newline" (assert-equal #\newline (rt #\newline)))+111
(test "greek lambda (955)" (assert-equal (integer->char 955) (rt (integer->char 955))))+112
(test "cjk (26085)" (assert-equal (integer->char 26085) (rt (integer->char 26085))))+113
(test "emoji codepoint (128640)"+114
(assert-equal (integer->char 128640) (rt (integer->char 128640))))+115
(test "null char" (assert-equal (integer->char 0) (rt (integer->char 0))))+116
(test "max codepoint" (assert-equal (integer->char #x10FFFF) (rt (integer->char #x10FFFF)))))+117
+118
;; ============================================================+119
;; Round-trip: collections+120
;; ============================================================+121
+122
(test-group "round-trip - lists"+123
(test "empty" (assert-equal '() (rt '())))+124
(test "ints" (assert-equal '(1 2 3) (rt '(1 2 3))))+125
(test "mixed" (assert-equal (list 1 "two" 3.0 #\4 'five:) (rt (list 1 "two" 3.0 #\4 'five:))))+126
(test "nested" (assert-equal '(1 (2 (3 (4)))) (rt '(1 (2 (3 (4)))))))+127
(test "list of strings" (assert-equal '("a" "bb" "ccc") (rt '("a" "bb" "ccc")))))+128
+129
(test-group "round-trip - vectors (R7RS #())"+130
(test "empty" (assert-equal (vector) (rt (vector))))+131
(test "ints" (assert-equal #(1 2 3) (rt #(1 2 3))))+132
(test "mixed" (assert-equal (vector 1 "two" 3.0 #t) (rt (vector 1 "two" 3.0 #t))))+133
(test "nested" (assert-equal #(#(1 2) #(3 4)) (rt #(#(1 2) #(3 4)))))+134
(test "stays a vector, not an array"+135
(assert-true (vector? (rt #(1 2 3))))))+136
+137
(test-group "round-trip - arrays (Sigil #[])"+138
(test "empty" (assert-equal #[] (rt #[])))+139
(test "ints" (assert-equal #[1 2 3] (rt #[1 2 3])))+140
(test "mixed" (assert-equal #[1 "two" 3.0 #t] (rt #[1 "two" 3.0 #t])))+141
(test "nested" (assert-equal #[#[1 2] #[3 4]] (rt #[#[1 2] #[3 4]])))+142
(test "stays an array, not a vector"+143
(assert-true (array? (rt #[1 2 3]))))+144
(test "array and vector are distinct on the wire"+145
(assert-false (equal? (wire-encode #[1 2 3]) (wire-encode #(1 2 3))))))+146
+147
(test-group "round-trip - dicts"+148
(test "empty" (assert-equal #{} (rt #{})))+149
(test "simple" (assert-equal #{ a: 1 } (rt #{ a: 1 })))+150
(test "multi" (assert-equal #{ name: "Alice" age: 30 } (rt #{ name: "Alice" age: 30 })))+151
(test "nested dict" (assert-equal #{ outer: #{ inner: 42 } } (rt #{ outer: #{ inner: 42 } })))+152
(test "dict with collections"+153
(assert-equal #{ items: #[1 2 3] tags: (list "x" "y") }+154
(rt #{ items: #[1 2 3] tags: (list "x" "y") }))))+155
+156
(test-group "round-trip - deeply nested mixed"+157
(test "structure like a directory listing"+158
(let ((v #{ entries: #[ #{ name: "a.txt" size: 100 dir: #f }+159
#{ name: "sub" size: 0 dir: #t } ]+160
total: 2 }))+161
(assert-equal v (rt v))))+162
(test "list/dict/vector interleaved"+163
(let ((v (list #{ k: #[1 (list 2 3) #{ deep: "yes" }] }+164
'sym+165
#\x+166
(bytevector 9 8 7))))+167
(assert-equal v (rt v)))))+168
+169
;; ============================================================+170
;; Encode errors: non-representable values+171
;; ============================================================+172
+173
(test-group "encode - non-representable is an error, not a drop"+174
(test "procedure" (assert-true (raises? (lambda () (wire-encode car)))))+175
(test "improper list" (assert-true (raises? (lambda () (wire-encode (cons 1 2))))))+176
(test "procedure nested in a list"+177
(assert-true (raises? (lambda () (wire-encode (list 1 2 car))))))+178
(test "procedure nested in a dict value"+179
(assert-true (raises? (lambda () (wire-encode #{ f: car }))))))+180
+181
;; ============================================================+182
;; Hostile-input fuzzing of the decoder (trust boundary)+183
;; ============================================================+184
+185
(test-group "decode - malformed header"+186
(test "empty buffer" (assert-true (raises? (lambda () (wire-decode (bytevector))))))+187
(test "too short for header"+188
(assert-true (raises? (lambda () (wire-decode (bytevector #x53))))))+189
(test "bad magic byte 0"+190
(assert-true (raises? (lambda () (wire-decode (bytes->bv (list #x00 #x57 1 0 #x00)))))))+191
(test "bad magic byte 1"+192
(assert-true (raises? (lambda () (wire-decode (bytes->bv (list #x53 #x00 1 0 #x00)))))))+193
(test "unknown version"+194
(assert-true (raises? (lambda () (wire-decode (bytes->bv (list #x53 #x57 99 0 #x00))))))))+195
+196
(test-group "decode - unknown tags"+197
(test "unknown tag 0x7F" (assert-true (raises? (lambda () (wire-decode (frame #x7F))))))+198
(test "unknown tag 0xFF" (assert-true (raises? (lambda () (wire-decode (frame #xFF))))))+199
(test "just past known range" (assert-true (raises? (lambda () (wire-decode (frame #x0C)))))))+200
+201
(test-group "decode - truncated frames"+202
(test "tag but no payload (int)"+203
(assert-true (raises? (lambda () (wire-decode (frame #x02))))))+204
(test "string claims 5 bytes, gives 2"+205
(assert-true (raises? (lambda () (wire-decode (frame #x04 5 #x61 #x62))))))+206
(test "bytevector claims 10, gives 0"+207
(assert-true (raises? (lambda () (wire-decode (frame #x05 10))))))+208
(test "float with only 4 of 8 bytes"+209
(assert-true (raises? (lambda () (wire-decode (frame #x03 0 0 0 0))))))+210
(test "char varint truncated (continuation then EOF)"+211
(assert-true (raises? (lambda () (wire-decode (frame #x08 #x80))))))+212
(test "list claims 3 elements, gives 1"+213
(assert-true (raises? (lambda () (wire-decode (frame #x09 3 #x01))))))+214
(test "dict claims 2 pairs, gives nothing"+215
(assert-true (raises? (lambda () (wire-decode (frame #x0A 2)))))))+216
+217
(test-group "decode - lying length prefixes (claim huge, provide few)"+218
(test "string claims ~2 billion bytes"+219
;; varint for 0xF0F0F0F0: bytes 0xF0 0xE1 0xC3 0x87 0x0F+220
(assert-true (raises? (lambda ()+221
(wire-decode (frame #x04 #xF0 #xE1 #xC3 #x87 #x0F #x61))))))+222
(test "list claims ~2 billion elements"+223
(assert-true (raises? (lambda ()+224
(wire-decode (frame #x09 #xF0 #xE1 #xC3 #x87 #x0F))))))+225
(test "dict claims huge pair count"+226
(assert-true (raises? (lambda ()+227
(wire-decode (frame #x0A #xFF #xFF #xFF #xFF #x0F)))))))+228
+229
(test-group "decode - varint abuse"+230
(test "int with endless continuation bytes errors (does not spin/OOM)"+231
;; 1030 continuation bytes with no terminator, past default max-int-bytes.+232
(assert-true (raises? (lambda ()+233
(wire-decode (bytes->bv (append wire-header (list #x02)+234
(make-continuation-bytes 1030))))))))+235
(test "length varint too long"+236
;; 12 continuation bytes for a body length; exceeds LEN-VARINT-MAX-BYTES.+237
(assert-true (raises? (lambda ()+238
(wire-decode (bytes->bv (append wire-header (list #x04)+239
(make-continuation-bytes 12)))))))))+240
+241
(test-group "decode - trailing garbage"+242
(test "extra byte after a complete value"+243
(assert-true (raises? (lambda () (wire-decode (frame #x01 #x99))))))+244
(test "second value after root"+245
(assert-true (raises? (lambda () (wire-decode (frame #x00 #x01)))))))+246
+247
;; ============================================================+248
;; Cap enforcement+249
;; ============================================================+250
+251
(test-group "caps - body length"+252
(test "oversized string rejected by tiny cap"+253
(let ((bytes (wire-encode "this string is definitely longer than eight bytes")))+254
(assert-true (raises? (lambda ()+255
(wire-decode bytes (make-wire-caps max-bytes-len: 8)))))))+256
(test "within cap decodes fine"+257
(let ((bytes (wire-encode "short")))+258
(assert-equal "short" (wire-decode bytes (make-wire-caps max-bytes-len: 100))))))+259
+260
(test-group "caps - collection count"+261
(test "too many list elements rejected"+262
(let ((bytes (wire-encode '(1 2 3 4 5 6 7 8 9 10))))+263
(assert-true (raises? (lambda ()+264
(wire-decode bytes (make-wire-caps max-count: 3)))))))+265
(test "too many dict pairs rejected"+266
(let ((bytes (wire-encode #{ a: 1 b: 2 c: 3 })))+267
(assert-true (raises? (lambda ()+268
(wire-decode bytes (make-wire-caps max-count: 2)))))))+269
(test "within count cap decodes"+270
(let ((bytes (wire-encode '(1 2 3))))+271
(assert-equal '(1 2 3) (wire-decode bytes (make-wire-caps max-count: 10))))))+272
+273
(test-group "caps - nesting depth"+274
(test "too-deep nesting rejected"+275
(let ((deep (build-nested-list 300)))+276
(assert-true (raises? (lambda ()+277
(wire-decode (wire-encode deep) (make-wire-caps max-depth: 64)))))))+278
(test "shallow nesting within cap decodes"+279
(let ((shallow (build-nested-list 10)))+280
(assert-equal shallow+281
(wire-decode (wire-encode shallow) (make-wire-caps max-depth: 64))))))+282
+283
(test-group "caps - total decoded size"+284
(test "total body bytes over cap rejected"+285
(let ((bytes (wire-encode (list "aaaa" "bbbb" "cccc" "dddd"))))+286
(assert-true (raises? (lambda ()+287
(wire-decode bytes (make-wire-caps max-total: 8)))))))+288
(test "generous total cap decodes"+289
(let ((v (list "aaaa" "bbbb")))+290
(assert-equal v (wire-decode (wire-encode v) (make-wire-caps max-total: 1000))))))+291
+292
(test-group "caps - int magnitude"+293
(test "bignum over max-int-bytes rejected"+294
(let ((bytes (wire-encode (expt 2 4000))))+295
(assert-true (raises? (lambda ()+296
(wire-decode bytes (make-wire-caps max-int-bytes: 4)))))))+297
(test "bignum within cap decodes"+298
(let ((n (expt 2 200)))+299
(assert-equal n (wire-decode (wire-encode n) (make-wire-caps max-int-bytes: 1024))))))+300
+301
;; ---------- helpers used above (defined after; Sigil hoists defines) ----------+302
+303
(define (make-continuation-bytes n)+304
(let loop ((i 0) (acc '()))+305
(if (= i n) acc (loop (+ i 1) (cons #x80 acc)))))+306
+307
(define (build-nested-list depth)+308
(let loop ((n depth) (v '()))+309
(if (= n 0) v (loop (- n 1) (list v)))))