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 <[email protected]>")
+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
(else

Showing 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)))))