AtlatestRepositoryslate

slate / tree / packages / slate-cli / testtest-sid.sgl

1;;; Durable session ids: minting, the charset, and the scraper — with the
2;;; NEGATIVE fixtures, which are the point.
3;;;
4;;; Fable's three constraints on this, verbatim in intent:
5;;; 1. constrain the sid charset AT MINT, since we mint them, so every
6;;; downstream scraper is trivially safe;
7;;; 2. a malformed sid is `bad-args` and NEVER a fallback to a new session —
8;;; ABSENT and MALFORMED are different answers;
9;;; 3. negative fixtures for the scraper.
10;;;
11;;; (3) is why most of this file is refusals. A scraper tested only on input it
12;;; handles is a scraper whose failure modes are unknown.
14(import (sigil test)
15 (slate-cli wire))
17(test-group "sid minting and charset"
18 (test "a minted sid satisfies its own validator"
19 (assert-true (valid-sid? (mint-sid!))))
21 (test "minted sids are fixed-length and prefixed"
22 (let ((s (mint-sid!)))
23 (assert-equal 18 (string-length s))
24 (assert-equal "s-" (substring s 0 2))))
26 (test "minting is not a counter — successive sids differ"
27 ;; A per-process counter is worthless across a restart and collides
28 ;; between holders, which is the whole reason sids became durable.
29 (let ((a (mint-sid!)) (b (mint-sid!)) (c (mint-sid!)))
30 (assert-false (string=? a b))
31 (assert-false (string=? b c))
32 (assert-false (string=? a c))))
34 (test "the charset is lowercase hex only — nothing that could escape an envelope"
35 ;; This is what makes the scraper safe by construction: a valid sid cannot
36 ;; contain a quote, brace, comma, backslash, newline or control character,
37 ;; so it can never break out of any envelope it is later embedded in.
38 (let loop ((n 0))
39 (when (< n 50)
40 (let ((s (mint-sid!)))
41 (let scan ((i 2))
42 (when (< i 18)
43 (let ((c (string-ref s i)))
44 (assert-true (or (and (char>=? c #\0) (char<=? c #\9))
45 (and (char>=? c #\a) (char<=? c #\f)))))
46 (scan (+ i 1)))))
47 (loop (+ n 1))))))
49(test-group "valid-sid? refuses everything that is not exactly a sid"
50 (test "wrong length"
51 (assert-false (valid-sid? "s-0123456789abcde")) ; one short
52 (assert-false (valid-sid? "s-0123456789abcdef0"))) ; one long
53 (test "wrong prefix"
54 (assert-false (valid-sid? "x-0123456789abcdef"))
55 (assert-false (valid-sid? "ss0123456789abcdef")))
56 (test "UPPERCASE hex is refused — the grammar is lowercase, exactly"
57 (assert-false (valid-sid? "s-0123456789ABCDEF")))
58 (test "non-hex characters"
59 (assert-false (valid-sid? "s-0123456789abcdeg"))
60 (assert-false (valid-sid? "s-0123456789abcde-")))
61 (test "characters that could break an envelope"
62 (assert-false (valid-sid? "s-0123456789abcd\"e"))
63 (assert-false (valid-sid? "s-0123456789abc}de"))
64 (assert-false (valid-sid? "s-0123456789ab,cde"))
65 (assert-false (valid-sid? "s-0123456789ab\nde")))
66 (test "non-strings and empty"
67 (assert-false (valid-sid? ""))
68 (assert-false (valid-sid? 12345))
69 (assert-false (valid-sid? #f))))
71(test-group "scrape-sid — ABSENT and MALFORMED must not share a value"
72 ;; The load-bearing distinction. #f means "no sid key at all" => open a NEW
73 ;; session. A non-#f result that fails valid-sid? means the caller sent
74 ;; something and got it wrong => bad-args. Collapsing these is the duplicate-
75 ;; session defect R3b exists to prevent: a garbled attach would silently
76 ;; become a second session instead of an error.
78 (test "ABSENT: no sid key at all yields #f"
79 (assert-false (scrape-sid "{\"id\":7,\"args\":{}}"))
80 (assert-false (scrape-sid "{}"))
81 (assert-false (scrape-sid "")))
83 (test "PRESENT and well-formed: the sid comes back"
84 (assert-equal "s-0123456789abcdef"
85 (scrape-sid "{\"id\":7,\"args\":{\"sid\":\"s-0123456789abcdef\"}}")))
87 (test "PRESENT with whitespace around the colon"
88 (assert-equal "s-0123456789abcdef"
89 (scrape-sid "{\"sid\" : \"s-0123456789abcdef\"}")))
91 (test "MALFORMED must be non-#f so the caller can refuse it"
92 ;; Each of these is a caller that MEANT to name a session and failed. The
93 ;; scraper must report something, and the caller must then refuse via
94 ;; valid-sid? -- it must NOT read as absent.
95 (let ((numeric (scrape-sid "{\"sid\":7}"))
96 (nulled (scrape-sid "{\"sid\":null}"))
97 (empty (scrape-sid "{\"sid\":\"\"}"))
98 (garbage (scrape-sid "{\"sid\":\"not-a-sid\"}")))
99 (assert-true (and numeric #t))
100 (assert-false (valid-sid? numeric))
101 (assert-true (and nulled #t))
102 (assert-false (valid-sid? nulled))
103 ;; an empty string is present-but-wrong, not absent
104 (assert-equal "" empty)
105 (assert-false (valid-sid? empty))
106 (assert-equal "not-a-sid" garbage)
107 (assert-false (valid-sid? garbage))))
109 ;; TWO PROPERTIES, TWO ASSERTIONS. The old single assertion was named for
110 ;; termination -- a real concern -- but pinned the RETURN VALUE, and a
111 ;; non-#f sentinel also does not run off the end. So it fixed the wrong
112 ;; half of its own intent and locked in the absent/malformed collapse.
113 (test "an unterminated string TERMINATES rather than running off the end"
114 ;; If this ever loops or raises, the suite hangs or errors rather than
115 ;; failing -- which is the property the original name cared about.
116 ;; The property is that it RETURNS, and returns one of the three legal
117 ;; answers -- not which one. A hang or a raise fails this by never
118 ;; reaching the assertion at all, which is the shape the original name
119 ;; cared about and the only half it should ever have pinned.
120 (let ((r (scrape-sid "{\"sid\":\"s-0123456789abcdef")))
121 (assert-true (or (string? r) (eq? r #f) (eq? r (quote malformed))))))
123 (test "an unterminated string is MALFORMED, not ABSENT"
124 ;; #f means "no sid key at all" => open a NEW session. A truncated value
125 ;; is a caller error and must reach bad-args instead.
126 (let ((r (scrape-sid "{\"sid\":\"s-0123456789abcdef")))
127 (assert-equal 'malformed r)
128 (assert-false (valid-sid? r))))
130 (test "a TRUNCATED value that happens to be well-formed is still refused"
131 ;; The trap this pair exists for: the fixture above is 18 characters of
132 ;; valid hex, so returning the partial text would PASS valid-sid? and name
133 ;; a session -- possibly the wrong one, because the real value may have
134 ;; continued past the truncation. Not-absent is not enough; it must also
135 ;; be un-validatable.
136 (assert-false (valid-sid? (scrape-sid "{\"sid\":\"s-0123456789abcdef"))))
138 (test "a key with NO value at all is also malformed, not absent"
139 (let ((r (scrape-sid "{\"sid\":")))
140 (assert-equal 'malformed r)
141 (assert-false (valid-sid? r))))
143 (test "a key merely CONTAINING sid is not the sid key"
144 ;; "resid" / "sids" must not match. The scraper keys on the quoted token.
145 (assert-false (scrape-sid "{\"resid\":\"s-0123456789abcdef\"}"))
146 (assert-false (scrape-sid "{\"sids\":\"s-0123456789abcdef\"}")))
148 (test "the scraper never invokes the JSON reader — proven by input it CANNOT parse"
149 ;; This is the reason the scraper exists at all: enclave-remote.sgl:61-69
150 ;; records that the native JSON reader corrupts its walk at this boundary
151 ;; on this toolchain. So the scraper must work on a payload that is not
152 ;; valid JSON at all.
153 (assert-equal "s-0123456789abcdef"
154 (scrape-sid "GARBAGE ][ \"sid\":\"s-0123456789abcdef\" }{ trailing"))))
156(run-tests)