AtlatestRepositoryapiary

apiary / tree / testtest-enclave.sgl

1(import (sigil test)
2 (sigil string)
3 (sigil process)
4 (sigil time)
5 (sigil async)
6 (sigil irc message)
7 (apiary enclave))
8
9;; ============================================================
10;; Config defaults + env loading
11;; ============================================================
13(test-group "enclave-config"
14 (test "defaults"
15 (let ((cfg (enclave-config)))
16 (assert-false (enclave-config-host cfg))
17 (assert-equal 6667 (enclave-config-port cfg))
18 (assert-false (enclave-config-tls? cfg))
19 (assert-false (enclave-config-user cfg))
20 (assert-false (enclave-config-token cfg))
21 (assert-equal "#hive" (enclave-config-channel cfg))))
23 (test "load-enclave-config reads APIARY_*"
24 (setenv! "APIARY_ENCLAVE_HOST" "irc.example.com")
25 (setenv! "APIARY_ENCLAVE_PORT" "6697")
26 (setenv! "APIARY_ENCLAVE_TLS" "yes")
27 (setenv! "APIARY_USER" "leader-bot")
28 (setenv! "APIARY_TOKEN" "abcd1234")
29 (setenv! "APIARY_CHANNEL" "#workers")
30 (let ((cfg (load-enclave-config)))
31 (assert-equal "irc.example.com" (enclave-config-host cfg))
32 (assert-equal 6697 (enclave-config-port cfg))
33 (assert-true (enclave-config-tls? cfg))
34 (assert-equal "leader-bot" (enclave-config-user cfg))
35 (assert-equal "abcd1234" (enclave-config-token cfg))
36 (assert-equal "#workers" (enclave-config-channel cfg))
37 (assert-true (enclave-config-ready? cfg)))
38 (setenv! "APIARY_ENCLAVE_HOST" "")
39 (setenv! "APIARY_ENCLAVE_PORT" "")
40 (setenv! "APIARY_ENCLAVE_TLS" "")
41 (setenv! "APIARY_USER" "")
42 (setenv! "APIARY_TOKEN" "")
43 (setenv! "APIARY_CHANNEL" ""))
45 (test "tls flag accepts truthy variants"
46 (for-each (lambda (v)
47 (setenv! "APIARY_ENCLAVE_TLS" v)
48 (let ((cfg (load-enclave-config)))
49 (assert-true (enclave-config-tls? cfg))))
50 '("1" "true" "TRUE" "yes" "Yes" "on"))
51 (for-each (lambda (v)
52 (setenv! "APIARY_ENCLAVE_TLS" v)
53 (let ((cfg (load-enclave-config)))
54 (assert-false (enclave-config-tls? cfg))))
55 '("0" "false" "no" "" "off"))
56 (setenv! "APIARY_ENCLAVE_TLS" ""))
58 (test "config-ready? requires host + user + token"
59 (assert-false (enclave-config-ready? (enclave-config)))
60 (assert-false (enclave-config-ready?
61 (enclave-config host: "h" user: "n")))
62 (assert-true (enclave-config-ready?
63 (enclave-config host: "h"
64 user: "n"
65 token: "t")))))
67;; ============================================================
68;; Token-prefix logging helper (privacy contract)
69;; ============================================================
71(test-group "safe-token-prefix"
72 (test "redacts full token"
73 (let ((s (safe-token-prefix
74 "a688b5c63a4d2e1f0e3d2b1c00ff11ee22dd33cc44bb55aa66996152abcdef00")))
75 (assert-true (string-prefix? "a688" s))
76 ;; Full token must NOT appear in the output.
77 (assert-false (string-find s "abcdef00"))))
79 (test "handles short or non-string inputs"
80 (assert-equal "<no-token>" (safe-token-prefix #f))
81 (assert-equal "<no-token>" (safe-token-prefix '()))
82 (assert-true (string-prefix? "<short:" (safe-token-prefix "abc")))))
84;; ============================================================
85;; +enclave/result.* tag parsing — drive a real parsed irc-message
86;; ============================================================
88(test-group "EnclaveServ wire format"
89 (test "result tags parse from a register-bot reply"
90 (let* ((line (string-append
91 "@+enclave/result.status=ok"
92 ";+enclave/result.bot-nick=worker-1"
93 ";+enclave/result.token=a688b5c63a4d2e1f"
94 ";+enclave/result.expires-at=2026-04-29T08:00:00Z"
95 ";+enclave/result.owner-name=alice"
97 " PRIVMSG caller :Bot 'worker-1' registered."))
98 (msg (parse-irc-message line)))
99 (assert-true msg)
100 (assert-equal "ok" (irc-message-tag msg "+enclave/result.status"))
101 (assert-equal "worker-1" (irc-message-tag msg "+enclave/result.bot-nick"))
102 (assert-equal "a688b5c63a4d2e1f" (irc-message-tag msg "+enclave/result.token"))
103 (assert-equal "EnclaveServ" (irc-message-nick msg))
104 (assert-equal "caller" (irc-message-target msg))))
106 (test "err reply carries code + detail"
107 (let* ((line (string-append
108 "@+enclave/result.status=err"
109 ";+enclave/result.code=permission-denied"
110 ";+enclave/result.detail=allow-services"
112 " PRIVMSG leader-bot :Permission denied"))
113 (msg (parse-irc-message line)))
114 (assert-equal "err" (irc-message-tag msg "+enclave/result.status"))
115 (assert-equal "permission-denied"
116 (irc-message-tag msg "+enclave/result.code"))
117 (assert-equal "allow-services"
118 (irc-message-tag msg "+enclave/result.detail")))))
121;; ============================================================
122;; Cap negotiation state — `enclave-conn-cap-acked?`
123;; ============================================================
125(test-group "enclave-conn-cap-acked?"
126 (test "false until caps are recorded"
127 (let ((c (enclave-conn irc: #f config: (enclave-config))))
128 (assert-false (enclave-conn-cap-acked? c "draft/multiline"))
129 (assert-false (enclave-conn-cap-acked? c "batch"))))
131 (test "true after caps-acked is populated"
132 (let ((c (enclave-conn irc: #f config: (enclave-config))))
133 (set-enclave-conn-caps-acked!
134 c (list "message-tags" "batch" "draft/multiline"))
135 (assert-true (enclave-conn-cap-acked? c "draft/multiline"))
136 (assert-true (enclave-conn-cap-acked? c "batch"))
137 (assert-false (enclave-conn-cap-acked? c "echo-message")))))
140;; ============================================================
141;; Client-side PING/PONG keepalive — state-only tests.
142;;
143;; The wire-emission paths (PING out, PONG response, reconnect
144;; with backoff) are exercised by test/smoke-driver.sgl against
145;; a live enclave-server. Here we drive `enclave-conn-keepalive-tick!`
146;; synchronously by faking timestamps on a bare conn, no real
147;; irc-connection involved.
148;; ============================================================
150(test-group "client-side keepalive state"
152 (test "fresh enclave-conn defaults"
153 (let ((c (enclave-conn irc: #f config: (enclave-config))))
154 (assert-false (enclave-conn-last-inbound-ts c))
155 (assert-false (enclave-conn-ping-outstanding? c))
156 (assert-false (enclave-conn-oldest-ping-ts c))
157 (assert-false (enclave-conn-reconnecting? c))
158 (assert-false (enclave-conn-shutdown? c))
159 (assert-equal 0 (enclave-conn-reconnect-attempt c))))
161 (test "enclave-conn-note-inbound! advances last-inbound-ts"
162 (let ((c (enclave-conn irc: #f config: (enclave-config))))
163 (set-enclave-conn-last-inbound-ts! c 100)
164 (enclave-conn-note-inbound! c)
165 (assert-true (> (enclave-conn-last-inbound-ts c) 100))))
167 ;; ---- the idle clock is INBOUND-ONLY -------------------------
168 ;;
169 ;; The blocker-2 regression guard, aimed at the PRODUCT rather than
170 ;; at a mirror of it.
171 ;;
172 ;; READ THIS BEFORE TRUSTING IT — the first version of this test
173 ;; was VACUOUS and an adversarial reviewer proved it. It drove
174 ;; `enclave-post-multiline` with `'()`, which returns 'sent-empty
175 ;; early. That does fail against the pre-fix source, so it looked
176 ;; like a real gate. But `split-lines` returns `(list "")` for
177 ;; empty text, so NO CALLER CAN EVER REACH the empty-list path: the
178 ;; guard covered a dead branch, and re-adding the touch to the
179 ;; single-line branch — the path every real post takes — left all
180 ;; tests green.
181 ;;
182 ;; These drive the paths real posts take. There is no irc here, so
183 ;; the write raises and is swallowed; what is being asserted is
184 ;; that nothing refreshed the clock ON THE WAY TO the write, which
185 ;; is where the removed calls lived in every one of these three
186 ;; procedures.
187 ;;
188 ;; Its limit, stated so nobody over-reads it: a touch added AFTER
189 ;; the write would not be caught here, because the write raises
190 ;; first. The gate for that is the harness experiment
191 ;; `test/harness/exp_chatty_vs_silent.py`, which runs against a
192 ;; live server and is the only thing that can see it.
193 (test "an outbound post does NOT refresh the idle clock"
194 (for-each
195 (lambda (post!)
196 (let ((c (enclave-conn irc: #f config: (enclave-config))))
197 (set-enclave-conn-last-inbound-ts! c 100)
198 (guard (e (else #f)) (post! c))
199 (assert-equal 100 (enclave-conn-last-inbound-ts c))))
200 (list (lambda (c) (enclave-post c "#chan" "hello there"))
201 (lambda (c) (enclave-post-multiline c "#chan" '("hello there")))
202 (lambda (c) (enclave-post-multiline c "#chan"
203 '("one two" "three four")))
204 (lambda (c) (enclave-post-react c "#chan" "mid1" ":+1:")))))
206 (test "keepalive-tick: idle conn under threshold does NOT PING"
207 ;; No outstanding PING, but inbound traffic was only 30s ago —
208 ;; the idle threshold is 60s, so we should sit tight.
209 (let ((c (enclave-conn irc: #f config: (enclave-config))))
210 (let* ((now 1000)
211 (last-in (- now 30)))
212 (set-enclave-conn-last-inbound-ts! c last-in)
213 (enclave-conn-keepalive-tick! c now)
214 ;; No PING was emitted (we have no irc, so an attempted
215 ;; emit would have raised — the empty outstanding list
216 ;; confirms emit was skipped).
217 (assert-false (enclave-conn-ping-outstanding? c)))))
219 (test "keepalive-tick: an OUTSTANDING ping suppresses a new one"
220 ;; Idle well past the threshold, but a PING is already in
221 ;; flight and inside its PONG window. Emitting another would be
222 ;; pointless; more importantly the tick must fall through to
223 ;; neither branch rather than piling on.
224 (let ((c (enclave-conn irc: #f config: (enclave-config))))
225 (set-enclave-conn-last-inbound-ts! c (- 1000 500))
226 (enclave-conn-ping-add! c "apk-inflight" (- 1000 5))
227 (enclave-conn-keepalive-tick! c 1000)
228 (assert-equal 1 (length (enclave-conn-pending-pings c)))
229 (assert-false (enclave-conn-reconnecting? c))))
231 (test "keepalive-tick: shutdown? short-circuits"
232 (let ((c (enclave-conn irc: #f config: (enclave-config))))
233 (set-enclave-conn-shutdown?! c #t)
234 ;; No irc, but shutdown? short-circuits before touching it.
235 (enclave-conn-keepalive-tick! c 1000)
236 (assert-false (enclave-conn-ping-outstanding? c))))
238 (test "keepalive-tick: reconnecting? short-circuits"
239 (let ((c (enclave-conn irc: #f config: (enclave-config))))
240 (set-enclave-conn-reconnecting?! c #t)
241 (enclave-conn-keepalive-tick! c 1000)
242 (assert-false (enclave-conn-ping-outstanding? c))))
244 ;; ---- outstanding-PING bookkeeping ---------------------------
246 (test "ping-ack! clears only the matching token"
247 (let ((c (enclave-conn irc: #f config: (enclave-config))))
248 (enclave-conn-ping-add! c "apk-a" 100)
249 (enclave-conn-ping-add! c "apk-b" 110)
250 (assert-false (enclave-conn-ping-ack! c "apk-unknown"))
251 (assert-equal 2 (length (enclave-conn-pending-pings c)))
252 (assert-true (enclave-conn-ping-ack! c "apk-b"))
253 (assert-equal 1 (length (enclave-conn-pending-pings c)))
254 (assert-equal 100 (enclave-conn-oldest-ping-ts c))))
256 (test "oldest-ping-ts tracks the OLDEST, not the newest"
257 ;; The guard that makes blocker 2 structurally unable to
258 ;; reappear inside the delivery-confirmation path: a later PING
259 ;; must never postpone an earlier one's deadline.
260 (let ((c (enclave-conn irc: #f config: (enclave-config))))
261 (enclave-conn-ping-add! c "apk-old" 100)
262 (enclave-conn-ping-add! c "apk-new" 900)
263 (assert-equal 100 (enclave-conn-oldest-ping-ts c))))
265 (test "a NEWER ping cannot postpone an older ping's PONG timeout"
266 ;; Same property, scored where it matters: through the tick.
267 ;; The old entry is 31s old (past the 30s timeout); the new one
268 ;; is 1s old. If the timeout were measured from the newest —
269 ;; which is exactly what re-stamping a single slot would do —
270 ;; this conn would look healthy forever under a steady stream
271 ;; of posts.
272 (with-async
273 (let ((c (enclave-conn irc: #f config: (enclave-config))))
274 (set-enclave-conn-last-inbound-ts! c (- 1000 100))
275 (enclave-conn-ping-add! c "apk-old" (- 1000 31))
276 (enclave-conn-ping-add! c "apk-new" (- 1000 1))
277 (enclave-conn-keepalive-tick! c 1000)
278 (assert-true (enclave-conn-reconnecting? c))
279 (assert-false (enclave-conn-ping-outstanding? c))
280 (set-enclave-conn-shutdown?! c #t))))
282 (test "keepalive-tick: pending-ping past timeout flips reconnecting?"
283 ;; Simulate a PING sent 31s ago (>30s timeout). Shutdown? is
284 ;; #f and reconnecting? is #f, so the tick should call
285 ;; `trigger-reconnect!`. We can observe the side effects:
286 ;; - reconnecting? flipped to #t
287 ;; - pending-ping-token cleared
288 ;; (The actual reconnect goroutine spawn races against the
289 ;; with-async lifetime, but trigger-reconnect! runs through
290 ;; far enough to flip the flag before the goroutine errors —
291 ;; and even if the goroutine survives, irc=#f raises in
292 ;; do-reconnect! and the with-exception-handler in the loop
293 ;; catches it without affecting our assertions.)
294 (with-async
295 (let ((c (enclave-conn irc: #f config: (enclave-config))))
296 (let* ((now 1000)
297 (sent-ts (- now 31)))
298 (set-enclave-conn-last-inbound-ts! c (- now 100))
299 (enclave-conn-ping-add! c "apk-test-token" sent-ts)
300 (enclave-conn-keepalive-tick! c now)
301 (assert-true (enclave-conn-reconnecting? c))
302 (assert-false (enclave-conn-ping-outstanding? c))
303 ;; Flag the conn as shutdown so the spawned reconnect
304 ;; goroutine bails on its next sleep wakeup, otherwise
305 ;; the with-async block waits forever for it.
306 (set-enclave-conn-shutdown?! c #t)))))
308 (test "shutdown? prevents reconnecting when set first"
309 (let ((c (enclave-conn irc: #f config: (enclave-config))))
310 (set-enclave-conn-shutdown?! c #t)
311 ;; Force a "PING timed out" condition into the conn but
312 ;; with shutdown? already set — keepalive-tick should
313 ;; observe shutdown? and skip the trigger entirely.
314 (enclave-conn-ping-add! c "stale-token" (- 1000 100))
315 (enclave-conn-keepalive-tick! c 1000)
316 (assert-false (enclave-conn-reconnecting? c))))
318 (test "constants are stable + sensible"
319 ;; These constants are part of the public contract — tests
320 ;; should know if someone tweaks them in a non-additive way.
321 ;; Indirectly assert via the threshold behavior.
322 (let ((c (enclave-conn irc: #f config: (enclave-config))))
323 ;; 59s of idle should NOT trigger a PING.
324 (set-enclave-conn-last-inbound-ts! c (- 1000 59))
325 (enclave-conn-keepalive-tick! c 1000)
326 (assert-false (enclave-conn-ping-outstanding? c))))
328 ;; ---- delivery confirmation ---------------------------------
330 (test "confirm-delivery! on a shut-down conn is 'not-ready"
331 (let ((c (enclave-conn irc: #f config: (enclave-config))))
332 (set-enclave-conn-shutdown?! c #t)
333 (assert-equal 'not-ready (enclave-confirm-delivery! c #f))))
335 (test "confirm-delivery! while reconnecting is 'link-down"
336 (let ((c (enclave-conn irc: #f config: (enclave-config))))
337 (set-enclave-conn-reconnecting?! c #t)
338 (assert-equal 'link-down (enclave-confirm-delivery! c #f))))
340 (test "confirm-delivery! answers immediately when a ping is already overdue"
341 ;; Guard 2, scored through the real entry point.
342 ;;
343 ;; An outstanding PING older than the budget already settles the
344 ;; question, so the call must return 'unconfirmed WITHOUT
345 ;; sending another PING and without spending the budget again.
346 ;;
347 ;; This conn has irc: #f, which is what makes the test sharp:
348 ;; if the guard were removed the call would fall through to the
349 ;; ready? check and then to `send-ping!`, both of which reach
350 ;; into a #f connection. The test would fail rather than pass
351 ;; quietly. It also asserts the list did not grow, so a guard
352 ;; that returned the right symbol after emitting a PING anyway
353 ;; would still be caught.
354 (let ((c (enclave-conn irc: #f config: (enclave-config))))
355 (enclave-conn-ping-add! c "apk-overdue"
356 (- (current-second)
357 (+ +post-confirm-timeout+ 1)))
358 (assert-equal 'no-evidence (enclave-confirm-delivery! c #f))
359 (assert-equal 1 (length (enclave-conn-pending-pings c)))))
361 (test "confirm-delivery! refuses to read a PONG from a REPLACED socket"
362 ;; The socket-identity guard. A reconnect can swap `irc` between
363 ;; the write and the confirmation, and a PONG arriving on the NEW
364 ;; connection says nothing about a message written to the OLD
365 ;; one. Passing an `irc-at-write` that no longer matches must be
366 ;; refused outright rather than confirmed.
367 (let ((c (enclave-conn irc: 'socket-b config: (enclave-config))))
368 (assert-equal 'link-changed (enclave-confirm-delivery! c 'socket-a))))
370 (test "an abandoned ping is NOT evidence of delivery"
371 ;; The HIGH an adversarial review found. A token leaves the
372 ;; outstanding list for two very different reasons: the peer
373 ;; answered it, or we gave up on the socket. Confirmation must
374 ;; act only on the first.
375 ;;
376 ;; enclave-disconnect clears the outstanding list without any
377 ;; PONG ever arriving. If confirmation keyed on absence — as it
378 ;; originally did — this would read as proof of delivery.
379 (let ((c (enclave-conn irc: #f config: (enclave-config))))
380 (enclave-conn-ping-add! c "apk-abandoned" (current-second))
381 (assert-true (enclave-conn-ping-waiting? c "apk-abandoned"))
382 (enclave-conn-pings-clear! c)
383 (assert-false (enclave-conn-ping-waiting? c "apk-abandoned"))
384 (assert-false (enclave-conn-ping-acked? c "apk-abandoned"))))
386 ;; ---- the confirmation wait's own decision ------------------
387 ;;
388 ;; These drive `confirm-verdict`, which is the step the wait loop
389 ;; repeats. It exists as a named procedure precisely so it can be
390 ;; reached from here: the loop itself sits past `send-ping!`, which
391 ;; needs a real socket, so while this decision was inline a
392 ;; sabotage reverting it to key on ABSENCE left the whole suite
393 ;; green. Verified by re-running that sabotage against these.
395 (test "confirm-verdict: an ABANDONED token is not confirmation"
396 ;; The HIGH. A reconnect during the wait clears the outstanding
397 ;; list without any PONG. Keying on absence read that as delivery
398 ;; and reported success for a message written to a socket being
399 ;; abandoned at that moment.
400 (let ((c (enclave-conn irc: 'sock config: (enclave-config)))
401 (far (+ (current-second) 60)))
402 (enclave-conn-ping-add! c "apk-t" (current-second))
403 (assert-equal 'wait (confirm-verdict c "apk-t" 'sock far))
404 (enclave-conn-pings-clear! c) ;; what trigger-reconnect! does
405 (assert-false (eq? 'confirmed (confirm-verdict c "apk-t" 'sock far)))))
407 (test "confirm-verdict: a genuine PONG IS confirmation"
408 ;; Positive control for the test above. Without it, a verdict
409 ;; procedure that NEVER says 'confirmed would pass for free.
410 (let ((c (enclave-conn irc: 'sock config: (enclave-config)))
411 (far (+ (current-second) 60)))
412 (enclave-conn-ping-add! c "apk-t" (current-second))
413 (assert-true (enclave-conn-ping-ack! c "apk-t"))
414 (assert-equal 'confirmed (confirm-verdict c "apk-t" 'sock far))))
416 (test "confirm-verdict: a real PONG wins over a link that then dropped"
417 ;; Ordering. Evidence that already arrived is not retracted by
418 ;; the link failing a moment later, or a post confirmed on a
419 ;; healthy socket would be reported unconfirmed whenever the
420 ;; connection dropped just afterwards.
421 (let ((c (enclave-conn irc: 'sock config: (enclave-config)))
422 (far (+ (current-second) 60)))
423 (enclave-conn-ping-add! c "apk-t" (current-second))
424 (enclave-conn-ping-ack! c "apk-t")
425 (set-enclave-conn-reconnecting?! c #t)
426 (assert-equal 'confirmed (confirm-verdict c "apk-t" 'sock far))))
428 (test "confirm-verdict: the other outcomes"
429 (let ((c (enclave-conn irc: 'sock config: (enclave-config)))
430 (far (+ (current-second) 60))
431 (past (- (current-second) 1)))
432 (enclave-conn-ping-add! c "apk-t" (current-second))
433 (assert-equal 'unconfirmed (confirm-verdict c "apk-t" 'sock past))
434 (assert-equal 'link-changed (confirm-verdict c "apk-t" 'other far))
435 (set-enclave-conn-shutdown?! c #t)
436 (assert-equal 'link-down (confirm-verdict c "apk-t" 'sock far))))
438 (test "an ANSWERED ping is evidence, and only for its own token"
439 ;; The positive control for the test above: the same predicate
440 ;; must report #t when the peer really did answer, or "not acked"
441 ;; would pass for free and prove nothing.
442 (let ((c (enclave-conn irc: #f config: (enclave-config))))
443 (enclave-conn-ping-add! c "apk-answered" (current-second))
444 (enclave-conn-ping-add! c "apk-other" (current-second))
445 (assert-true (enclave-conn-ping-ack! c "apk-answered"))
446 (assert-true (enclave-conn-ping-acked? c "apk-answered"))
447 (assert-false (enclave-conn-ping-acked? c "apk-other")))))
451;; ============================================================
452;; Registration-timeout resilience (apiary v0.1.4).
453;;
454;; The reconnect path must NEVER raise from do-reconnect! (or the
455;; main event loop crashes per [[tasks/apiary-resilient-to-server-
456;; restarts]]). End-to-end validation lives in
457;; `test/smoke-keepalive-integration.sh` (kill -9 enclave + restart
458;; mid-reconnect); here we just verify that await-registration!
459;; honors its timeout and returns #f cleanly when the deadline has
460;; already elapsed (the cheap-to-test branch of the wait loop).
461;; ============================================================
463(test-group "do-reconnect! resilience"
465 (test "await-registration! is exported as a procedure"
466 ;; The helper got pulled out of do-reconnect! so the production
467 ;; guard around it can be tested in isolation by the smoke
468 ;; harness (which drives a real irc-connection through a kill
469 ;; -9 + restart cycle). At unit-test scope we just verify the
470 ;; export resolves — the wire-level behavior is exercised by
471 ;; `test/smoke-keepalive-integration.sh`.
472 (assert-true (procedure? await-registration!))))
475;; ============================================================
476;; Bounded connect
477;;
478;; The defect these guard: a blocking connect(2) on this process's
479;; single cooperative scheduler took the kernel's full ~135s
480;; SYN-retransmit budget, during which NO MCP request could be
481;; answered — measured at 53/120 requests answered with a ~134s
482;; contiguous dead window. These tests pin the two properties that
483;; prevent it: the connect is BOUNDED, and its failure is CLASSIFIED.
484;;
485;; Note what is deliberately real here rather than mocked: the
486;; blackhole case actually opens a socket against TEST-NET-1
487;; (192.0.2.1, RFC 5737, guaranteed unrouted) and asserts on the
488;; wall-clock. A mocked bound would pass just as happily against an
489;; unbounded connect, which is the whole thing being prevented.
490;; ============================================================
492(test-group "bounded connect"
494 (test "connect bound is below the PONG timeout"
495 ;; Not a style preference. A connect attempt allowed to outlive
496 ;; +keepalive-pong-timeout+ (30s) would let the keepalive sweep
497 ;; declare the link dead and kick a SECOND reconnect while the
498 ;; first is still in flight. This assertion is what keeps that
499 ;; ordering true if someone raises the default later.
500 ;;
501 ;; ASSERTED VIA `load-enclave-config`, DELIBERATELY. An earlier
502 ;; version of this test read the struct's field default instead,
503 ;; and a sabotage run proved it VACUOUS: raising the constant that
504 ;; `load-enclave-config` actually uses from 5.0 to 45.0 left this
505 ;; test green, because the struct default is a separate literal.
506 ;; The bound that governs a real connection is the loaded one, so
507 ;; that is the one under test.
508 (setenv! "APIARY_CONNECT_TIMEOUT" "")
509 (setenv! "APIARY_TLS_HANDSHAKE_TIMEOUT" "")
510 (let ((cfg (load-enclave-config)))
511 (assert-true (< (enclave-config-connect-timeout cfg) 30.0))
512 (assert-true (> (enclave-config-connect-timeout cfg) 0))))
514 (test "the struct default and the loaded default cannot drift"
515 ;; The same default is written in two places — the `enclave-config`
516 ;; field default and `+connect-timeout-default+`, which the struct
517 ;; cannot reference because this file defines types before
518 ;; constants. Code that builds a config directly reads the first;
519 ;; code that loads from the environment reads the second. They must
520 ;; agree, and nothing in the compiler makes them.
521 ;;
522 ;; This test exists because the duplication was only discovered
523 ;; when a sabotage of one of them failed to turn anything red.
524 (setenv! "APIARY_CONNECT_TIMEOUT" "")
525 (setenv! "APIARY_TLS_HANDSHAKE_TIMEOUT" "")
526 (let ((loaded (load-enclave-config))
527 (fresh (enclave-config)))
528 (assert-equal (enclave-config-connect-timeout loaded)
529 (enclave-config-connect-timeout fresh))
530 (assert-equal (enclave-config-tls-handshake-timeout loaded)
531 (enclave-config-tls-handshake-timeout fresh))))
533 (test "handshake bound is separate from the connect bound"
534 ;; They bound different failures: the connect bound cannot reach
535 ;; a peer that ACCEPTS and then goes silent, because at that
536 ;; point the connect phase is over.
537 (setenv! "APIARY_CONNECT_TIMEOUT" "")
538 (setenv! "APIARY_TLS_HANDSHAKE_TIMEOUT" "")
539 (let ((cfg (load-enclave-config)))
540 (assert-true (> (enclave-config-tls-handshake-timeout cfg)
541 (enclave-config-connect-timeout cfg)))))
543 (test "a non-positive timeout override is REFUSED, not honoured"
544 ;; The underlying native reads a non-positive timeout as "no
545 ;; bound" and reverts to a plain blocking connect. So honouring
546 ;; APIARY_CONNECT_TIMEOUT=0 would silently restore the exact
547 ;; ~135s wedge, while looking like a deliberate configuration
548 ;; choice. It must fall back to the default instead.
549 (setenv! "APIARY_CONNECT_TIMEOUT" "0")
550 (let ((cfg (load-enclave-config)))
551 (assert-true (> (enclave-config-connect-timeout cfg) 0)))
552 (setenv! "APIARY_CONNECT_TIMEOUT" "-5")
553 (let ((cfg (load-enclave-config)))
554 (assert-true (> (enclave-config-connect-timeout cfg) 0)))
555 (setenv! "APIARY_CONNECT_TIMEOUT" "not-a-number")
556 (let ((cfg (load-enclave-config)))
557 (assert-true (> (enclave-config-connect-timeout cfg) 0)))
558 ;; ...and a legitimate override IS honoured, so the test above
559 ;; cannot pass merely because the override is ignored wholesale.
560 ;; (This is the positive control: without it, a `positive-or` that
561 ;; returned the fallback unconditionally would pass every
562 ;; assertion above.)
563 (setenv! "APIARY_CONNECT_TIMEOUT" "2.5")
564 (let ((cfg (load-enclave-config)))
565 (assert-equal 2.5 (enclave-config-connect-timeout cfg)))
566 ;; Cleared LAST so a failure above cannot leak 2.5 into every
567 ;; later test in this process. Any assertion that fires early
568 ;; leaves the env set, which is why the clears also run at the
569 ;; TOP of each test that depends on the defaults.
570 (setenv! "APIARY_CONNECT_TIMEOUT" ""))
572 (test "classify-connect-status maps statuses to kinds"
573 (assert-equal 'ok (classify-connect-status "connected"))
574 (assert-equal 'refused (classify-connect-status "connection refused"))
575 (assert-equal 'timeout (classify-connect-status "connection timed out"))
576 (assert-equal 'unreachable (classify-connect-status "host unreachable"))
577 (assert-equal 'unreachable
578 (classify-connect-status "network unreachable"))
579 ;; An UNKNOWN status must NOT be folded into a specific kind.
580 ;; Guessing here would recreate the defect: a message asserting a
581 ;; diagnosis it does not have.
582 (assert-equal 'other (classify-connect-status "some new errno text"))
583 (assert-equal 'other (classify-connect-status #f)))
585 (test "a refused endpoint is classified 'refused, fast"
586 ;; POSITIVE CONTROL for the blackhole test below: this proves the
587 ;; instrument can SEE a fast, correctly-labelled failure. Without
588 ;; it, "the blackhole case returned in under the bound" is also
589 ;; what a connect that never really ran would report.
590 (let* ((cfg (enclave-config host: "127.0.0.1" port: 1
591 user: "n" token: "t"
592 connect-timeout: 5.0))
593 (t0 (current-second))
594 (outcome (open-enclave-transport cfg))
595 (elapsed (- (current-second) t0)))
596 (assert-equal 'refused (connect-outcome-kind outcome))
597 (assert-false (connect-outcome-socket outcome))
598 ;; Fast, i.e. it did not sit out the bound.
599 (assert-true (< elapsed 2.0))))
601 (test "a blackholed endpoint fails WITHIN the bound"
602 ;; The measured defect, inverted into an assertion. 192.0.2.1 is
603 ;; TEST-NET-1 (RFC 5737) and is guaranteed not to be routed, so
604 ;; this is the same condition that took ~135s before.
605 ;;
606 ;; THE BOUND IS THE ASSERTION. The KIND is deliberately not pinned
607 ;; to 'timeout: a host with no default route, or a restricted CI
608 ;; network, gets ENETUNREACH immediately and correctly reports
609 ;; 'unreachable. Demanding 'timeout there would fail the suite for
610 ;; a difference in the machine's routing table rather than a
611 ;; difference in this code. Both are non-'ok, both are classified,
612 ;; and both are bounded — which is what this test is about.
613 (let* ((cfg (enclave-config host: "192.0.2.1" port: 6697
614 user: "n" token: "t"
615 connect-timeout: 2.0))
616 (t0 (current-second))
617 (outcome (open-enclave-transport cfg))
618 (elapsed (- (current-second) t0))
619 (kind (connect-outcome-kind outcome)))
620 (assert-true (or (eq? kind 'timeout) (eq? kind 'unreachable)))
621 (assert-false (connect-outcome-socket outcome))
622 ;; The bound fires well before the kernel's ~135s budget.
623 (assert-true (< elapsed 8.0))))
625 (test "an unresolvable host is classified 'dns"
626 (let ((outcome (open-enclave-transport
627 (enclave-config
628 host: "no-such-host.invalid" port: 6697
629 user: "n" token: "t"
630 connect-timeout: 2.0))))
631 (assert-equal 'dns (connect-outcome-kind outcome))
632 (assert-false (connect-outcome-socket outcome))))
634 (test "the four failure kinds produce DISTINCT messages"
635 ;; Symptom 3 of the defect was that connection-refused, NXDOMAIN,
636 ;; a TLS mismatch and a timeout all produced ONE message whose
637 ;; only varying part was the host:port echoed back — the input,
638 ;; not a diagnosis. Distinctness is the property, so assert it
639 ;; directly rather than eyeballing the strings.
640 (let ((msgs (map (lambda (kind)
641 (connect-outcome-message
642 (connect-outcome kind: kind detail: "same-detail")))
643 '(refused dns timeout tls registration config))))
644 (let loop ((rest msgs))
645 (cond
646 ((null? rest) #t)
647 (else
648 (for-each
649 (lambda (other)
650 (assert-false (string=? (car rest) other)))
651 (cdr rest))
652 (loop (cdr rest)))))))
654 (test "enclave-connect/detail reports 'config for an incomplete config"
655 ;; TERMINAL rather than retryable: no configuration is arriving
656 ;; later in this process's life, so a caller must be able to tell
657 ;; this apart from "not connected yet".
658 (let* ((result (enclave-connect/detail (enclave-config)))
659 (outcome (car result)))
660 (assert-equal 'config (connect-outcome-kind outcome))
661 (assert-false (cdr result))))
663 (test "a successful connect reports NO failure text and a reset count"
664 ;; Pins the VALUES the success path reports, not a formatter's
665 ;; tolerance of values a test supplied itself. `detail` reaches the
666 ;; operator only as "last failure: <detail>", so anything
667 ;; success-flavoured here renders as "last failure: connected" the
668 ;; next time the session drops — which is what an adversarial
669 ;; review found in an earlier version of this code.
670 ;;
671 ;; A recording hook is the whole point: it captures what the
672 ;; PRODUCTION call site passes, so sabotaging that call site turns
673 ;; this red. A test that called `report-link-status!` with its own
674 ;; arguments would assert nothing about the code under test.
675 (let* ((seen '())
676 (c (enclave-conn irc: #f config: (enclave-config))))
677 (set-enclave-conn-status-hook!
678 c (lambda (state detail attempt next-delay)
679 (set! seen (list state detail attempt next-delay))))
680 (report-link-connected! c)
681 (assert-equal 'connected (car seen))
682 (assert-equal "" (cadr seen))
683 (assert-equal 0 (caddr seen))
684 (assert-false (cadddr seen))))
686 (test "a status hook that raises cannot break the reconnect loop"
687 ;; The hook is supplied by another module. If a raise from it could
688 ;; escape, a reporting bug in the consumer would take down the
689 ;; reconnect machinery — trading a cosmetic defect for an outage.
690 (let ((c (enclave-conn irc: #f config: (enclave-config))))
691 (set-enclave-conn-status-hook!
692 c (lambda (state detail attempt next-delay)
693 (error "hook exploded")))
694 ;; Must return normally rather than propagating.
695 (report-link-connected! c)
696 (report-link-status! c 'connecting #f 3 8)
697 (assert-true #t)))
699 (test "backoff schedule grows and is capped"
700 (assert-equal 1.0 (reconnect-delay-for 1))
701 (assert-equal 2.0 (reconnect-delay-for 2))
702 (assert-equal 4.0 (reconnect-delay-for 3))
703 (assert-equal 60.0 (reconnect-delay-for 20))))
706(define (string-prefix? prefix s)
707 (and (>= (string-length s) (string-length prefix))
708 (string=? prefix (substring s 0 (string-length prefix)))))