giles
9293366cb4
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
build-request-body's POST-form branch now serialises the form fields to a text/sx body via the serialize primitive (content-type text/sx), instead of FormData -> URLSearchParams -> urlencoded. A hydrated page posts SX; the host reads it via host/sx-body / host/field (the server already accepts both — urlencoded stays the no-engine / login-bootstrap fallback). Recompiled the web stack -> .sxbc. Verified client-agnostically (no DOM, the user's preference): a new sxtp suite test proves the wire contract serialize(engine) <-> host/sx-body(server) round-trips a field dict losslessly, INCLUDING sx_content full of quotes/parens that would break a naive encoder, plus host/field's content-type discrimination + urlencoded fallback (sxtp 43/43). The DOM field-read (dom-query-all + .value) is the one irreducibly- browser bit — left to a targeted Playwright smoke. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
153 lines
6.9 KiB
Plaintext
153 lines
6.9 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)
|
|
|
|
;; ── engine<->server write wire: serialize (engine) <-> host/sx-body (server) ──
|
|
;; A boosted form posts (serialize {field->value}) as text/sx; the server reads it
|
|
;; back with host/sx-body. This is the SX write wire, verified with NO DOM (client-
|
|
;; agnostic): what the engine's serialize emits, host/sx-body must parse back
|
|
;; losslessly — including sx_content full of the quotes/parens that would break a
|
|
;; naive encoder. (The server side is what conformance can prove; the DOM field-read
|
|
;; is the one irreducibly-browser bit, left to a Playwright smoke.)
|
|
(define host-sx-wire-content "(article (h1 \"Title\") (p \"He said \\\"hi\\\" (x)\"))")
|
|
(define host-sx-wire-req
|
|
(dream-request "POST" "/x" {:content-type "text/sx"}
|
|
(serialize {:title "Hi there" :sx_content host-sx-wire-content :status "published"})))
|
|
(host-sx-test "sx-body round-trips a serialized field dict"
|
|
(get (host/sx-body host-sx-wire-req) "title") "Hi there")
|
|
(host-sx-test "sx-body preserves quoted/parenthesised sx_content losslessly"
|
|
(get (host/sx-body host-sx-wire-req) "sx_content") host-sx-wire-content)
|
|
(host-sx-test "field reads a text/sx body by content-type"
|
|
(host/field host-sx-wire-req "status") "published")
|
|
(host-sx-test "field falls back to urlencoded form (the no-engine path)"
|
|
(host/field (dream-request "POST" "/x"
|
|
{:content-type "application/x-www-form-urlencoded"}
|
|
"title=From+Form&status=draft") "title")
|
|
"From Form")
|
|
|
|
(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}))
|