giles
065fd248da
lib/host/sxtp.sx implements the host<->subsystem wire format per
applications/sxtp/spec.sx:
- message algebra (request/response/condition/event + status helpers
ok/created/not-found/forbidden/invalid/fail) as string-keyed dicts;
verb/status/type stored as symbols (ride the wire bare)
- codec: sxtp/serialize (dict -> text/sx list form, deterministic top-level
field order, nested messages emitted in their own list form, no :msg leak)
and sxtp/parse (text/sx -> dict via a deep keyword-token->string normaliser)
- Dream bridge: sxtp/from-dream (HTTP req -> SXTP req, method->verb,
query->params) and sxtp/to-dream (SXTP resp -> HTTP resp, status->code,
body serialised to text/sx)
- 39-test suite covering algebra, serialise/parse round-trip, mappings, bridge
Runtime notes: serialize renders string-keyed dicts as {:k v} and symbols
bare; parsed keyword tokens are a distinct type (not = to string literals) so
parse normalises; unquote-splicing is unreliable so the emitter is str-based.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
130 lines
5.5 KiB
Plaintext
130 lines
5.5 KiB
Plaintext
;; lib/host/tests/sxtp.sx — SXTP message algebra, wire serialise/parse round-trip,
|
|
;; and the Dream HTTP <-> SXTP bridge.
|
|
|
|
(define host-sx-pass 0)
|
|
(define host-sx-fail 0)
|
|
(define host-sx-fails (list))
|
|
|
|
(define
|
|
host-sx-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! host-sx-pass (+ host-sx-pass 1))
|
|
(begin
|
|
(set! host-sx-fail (+ host-sx-fail 1))
|
|
(append! host-sx-fails {:name name :actual actual :expected expected})))))
|
|
|
|
;; ── constructors + predicates ──────────────────────────────────────
|
|
(define host-sx-req (sxtp/request "navigate" "/x" {:headers {:host "h"}}))
|
|
(define host-sx-resp (sxtp/ok {:id "e1"}))
|
|
|
|
(host-sx-test "request?" (sxtp/request? host-sx-req) true)
|
|
(host-sx-test "request not response" (sxtp/response? host-sx-req) false)
|
|
(host-sx-test "response?" (sxtp/response? host-sx-resp) true)
|
|
(host-sx-test "condition?" (sxtp/condition? (sxtp/condition "x" {})) true)
|
|
|
|
;; ── accessors (verb/status are symbols) ────────────────────────────
|
|
(host-sx-test "verb" (symbol->string (sxtp/verb host-sx-req)) "navigate")
|
|
(host-sx-test "path" (sxtp/path host-sx-req) "/x")
|
|
(host-sx-test "req header" (get (sxtp/req-headers host-sx-req) :host) "h")
|
|
(host-sx-test "status" (symbol->string (sxtp/status host-sx-resp)) "ok")
|
|
(host-sx-test "body" (get (sxtp/body host-sx-resp) :id) "e1")
|
|
|
|
;; ── status helpers ─────────────────────────────────────────────────
|
|
(host-sx-test "created status" (symbol->string (sxtp/status (sxtp/created {}))) "created")
|
|
(host-sx-test
|
|
"not-found status"
|
|
(symbol->string (sxtp/status (sxtp/not-found "/p" "gone")))
|
|
"not-found")
|
|
(host-sx-test
|
|
"not-found body is condition"
|
|
(sxtp/condition? (sxtp/body (sxtp/not-found "/p" "gone")))
|
|
true)
|
|
(host-sx-test
|
|
"forbidden message"
|
|
(sxtp/cond-message (sxtp/body (sxtp/forbidden "no")))
|
|
"no")
|
|
|
|
;; ── serialise (deterministic top-level field order) ────────────────
|
|
(host-sx-test
|
|
"serialize request"
|
|
(sxtp/serialize host-sx-req)
|
|
"(request :verb navigate :path \"/x\" :headers {:host \"h\"})")
|
|
(host-sx-test
|
|
"serialize ok"
|
|
(sxtp/serialize (sxtp/ok {:id "e1"}))
|
|
"(response :status ok :body {:id \"e1\"})")
|
|
;; nested condition rides the wire in its (condition ...) list form, no :msg leak.
|
|
(host-sx-test
|
|
"serialize nested condition as list"
|
|
(contains?
|
|
(sxtp/serialize (sxtp/not-found "/p" "gone"))
|
|
"(condition :type resource-not-found")
|
|
true)
|
|
(host-sx-test
|
|
"serialize no :msg leak"
|
|
(contains? (sxtp/serialize host-sx-resp) ":msg")
|
|
false)
|
|
|
|
;; ── parse + round-trip ─────────────────────────────────────────────
|
|
(define host-sx-parsed
|
|
(sxtp/parse "(request :verb query :path \"/events\" :headers {:host \"h\"})"))
|
|
(host-sx-test "parse msg type" (sxtp/request? host-sx-parsed) true)
|
|
(host-sx-test "parse verb" (symbol->string (sxtp/verb host-sx-parsed)) "query")
|
|
(host-sx-test "parse path" (sxtp/path host-sx-parsed) "/events")
|
|
(host-sx-test
|
|
"parse nested header normalised"
|
|
(get (sxtp/req-headers host-sx-parsed) :host)
|
|
"h")
|
|
|
|
(define host-sx-rt (sxtp/parse (sxtp/serialize (sxtp/ok {:id "e1" :n 3}))))
|
|
(host-sx-test "round-trip status" (symbol->string (sxtp/status host-sx-rt)) "ok")
|
|
(host-sx-test "round-trip body id" (get (sxtp/body host-sx-rt) :id) "e1")
|
|
(host-sx-test "round-trip body n" (get (sxtp/body host-sx-rt) :n) 3)
|
|
|
|
;; ── HTTP <-> SXTP mappings ─────────────────────────────────────────
|
|
(host-sx-test "verb GET->fetch" (symbol->string (sxtp/verb-for-method "GET")) "fetch")
|
|
(host-sx-test "verb POST->create" (symbol->string (sxtp/verb-for-method "POST")) "create")
|
|
(host-sx-test "verb DELETE->delete" (symbol->string (sxtp/verb-for-method "DELETE")) "delete")
|
|
(host-sx-test "verb unknown->fetch" (symbol->string (sxtp/verb-for-method "WIBBLE")) "fetch")
|
|
(host-sx-test "http ok->200" (sxtp/http-status (string->symbol "ok")) 200)
|
|
(host-sx-test "http not-found->404" (sxtp/http-status (string->symbol "not-found")) 404)
|
|
|
|
;; ── Dream bridge ───────────────────────────────────────────────────
|
|
(define host-sx-from
|
|
(sxtp/from-dream (dream-request "POST" "/feed?a=1" {} "hi")))
|
|
(host-sx-test "from-dream verb" (symbol->string (sxtp/verb host-sx-from)) "create")
|
|
(host-sx-test "from-dream path" (sxtp/path host-sx-from) "/feed")
|
|
(host-sx-test "from-dream param" (sxtp/param host-sx-from "a") "1")
|
|
(host-sx-test "from-dream body" (sxtp/body host-sx-from) "hi")
|
|
|
|
(define host-sx-tod (sxtp/to-dream (sxtp/ok {:id "e1"})))
|
|
(host-sx-test "to-dream status" (dream-status host-sx-tod) 200)
|
|
(host-sx-test
|
|
"to-dream content-type text/sx"
|
|
(dream-resp-header host-sx-tod "content-type")
|
|
"text/sx")
|
|
(host-sx-test
|
|
"to-dream body is sx text"
|
|
(dream-resp-body host-sx-tod)
|
|
"{:id \"e1\"}")
|
|
(host-sx-test
|
|
"to-dream not-found->404"
|
|
(dream-status (sxtp/to-dream (sxtp/not-found "/p" "gone")))
|
|
404)
|
|
(host-sx-test
|
|
"to-dream forbidden->403"
|
|
(dream-status (sxtp/to-dream (sxtp/forbidden "no")))
|
|
403)
|
|
|
|
(define
|
|
host-sx-tests-run!
|
|
(fn
|
|
()
|
|
{:total (+ host-sx-pass host-sx-fail)
|
|
:passed host-sx-pass
|
|
:failed host-sx-fail
|
|
:fails host-sx-fails}))
|