host: SX-native wire — reads + write bodies are text/sx, JSON CRUD deleted

Greenfield SX-native pivot (NOT a strangler): the host speaks SX/SXTP end to end;
JSON only at the future ActivityPub federation edge.

- OUTPUT: host/json-status -> host/sx-status — every host/ok/host/error response is
  text/sx via the serialize primitive (NOT application/json). Flips feed, relations,
  blog reads. Tests assert the SX envelope ({:ok true :data ...}).
- DELETE the blog JSON CRUD /posts (POST/PUT/DELETE) + bearer-based host/blog--protect:
  a pure old-contract REST mirror. Create/edit go through the HTML editor forms;
  programmatic writes speak SXTP. FOLLOW-UP: no browser delete route yet (was JSON-only,
  no UI) — add POST /:slug/delete + cascade edge cleanup when the metamodel UI needs it.
- INPUT: host/sx-body (sxtp.sx) parses a text/sx request body to a string-keyed dict
  (parse-safe + sxtp/-normalize). feed POST + relations attach/detach read it.
- UNIFIED field reader host/fields / host/field: text/sx body OR urlencoded form by
  content-type. The blog form handlers (new/edit/relate/unrelate) + login read through
  it — additive, urlencoded still works (no-engine / bootstrap fallback).

Conformance 290/290 (11 suites). Retires the strangler framing in the plan; adds the
'SX all the way out' wire table. The engine half (browser posts text/sx) follows.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-06-30 11:07:30 +00:00
parent ad86f3051e
commit 999249b944
14 changed files with 145 additions and 221 deletions

View File

@@ -63,9 +63,9 @@
;; with the same return target so the user lands where they were headed.
(define host/login-submit
(fn (req)
(let ((user (dream-form-field req "username"))
(pass (dream-form-field req "password"))
(next-path (host/-safe-next (dream-form-field req "next"))))
(let ((user (host/field req "username"))
(pass (host/field req "password"))
(next-path (host/-safe-next (host/field req "next"))))
(if (host/-verify-cred user pass)
(begin
(host/login! req user)

View File

@@ -7,13 +7,13 @@
;;
;; GET / HTML index of posts (public)
;; GET /<slug>/ rendered post (public) -> HTML / 404
;; GET /posts JSON list (public) -> [{slug,title,status}]
;; GET /posts SX list (public) -> {:ok true :data ({:slug …} …)}
;; GET /new HTML create form (public chrome)
;; POST /new form-urlencoded ingest from the editor (guarded)
;; POST /posts JSON create (guarded)
;; PUT /posts/<slug> JSON update (guarded)
;; DELETE /posts/<slug> delete (guarded)
;; Reads anonymous; writes behind the auth+ACL pipeline ("edit" on "blog").
;; POST /new form ingest from the editor (guarded)
;; POST /<slug>/edit form ingest, edit an existing post (guarded)
;; Reads anonymous; writes behind the auth+ACL pipeline ("edit" on "blog"). The
;; JSON CRUD /posts (POST/PUT/DELETE) was deleted in the SX-native pivot — the wire
;; is SX/SXTP (host/ok emits text/sx), writes go through the form ingest.
;; Depends on spec/render + web/adapter-html (render-to-html), lib/persist/*
;; (durable KV), lib/dream/* (+ form), lib/host/{handler,middleware}.sx.
@@ -1042,9 +1042,9 @@
;; body with a 400 HTML page (this path serves a browser form).
(define host/blog-form-submit
(fn (req)
(let ((title (dream-form-field req "title"))
(sx-content (dream-form-field req "sx_content"))
(status (or (dream-form-field req "status") "published")))
(let ((title (host/field req "title"))
(sx-content (host/field req "sx_content"))
(status (or (host/field req "status") "published")))
(cond
((or (nil? title) (= title ""))
(host/blog--resp req 400
@@ -1062,67 +1062,13 @@
(host/blog-put! slug title (or sx-content "") status)
(dream-redirect (str "/" slug "/")))))))))
;; POST /posts — JSON create {slug?,title,sx_content,status}. 409 if slug exists.
(define host/blog-create
(fn (req)
(let ((p (dream-json-body req)))
(if (= (type-of p) "dict")
(let ((title (get p :title)))
(cond
((or (nil? title) (= title "")) (host/error 400 "title required"))
((not (host/blog-content-ok? (get p :sx_content)))
(host/error 400 "invalid sx_content"))
(else
(let ((slug (or (get p :slug) (host/blog-slugify title))))
(if (host/blog-exists? slug)
(host/error 409 "post already exists")
(begin
(host/blog-put! slug title (or (get p :sx_content) "")
(or (get p :status) "published"))
(host/ok-status 201 {:slug slug :title title})))))))
(host/error 400 "invalid payload")))))
;; PUT /posts/<slug> — JSON update {title?,sx_content?,status?}. 404 if absent.
(define host/blog-update-handler
(fn (req)
(let ((slug (dream-param req "slug")) (p (dream-json-body req)))
(if (= (type-of p) "dict")
(let ((r (host/blog-get slug)))
(cond
((nil? r) (host/error 404 "no such post"))
((not (host/blog-content-ok? (get p :sx_content)))
(host/error 400 "invalid sx_content"))
(else
(begin
(host/blog-put! slug
(or (get p :title) (get r :title))
(or (get p :sx_content) (get r :sx-content))
(or (get p :status) (get r :status)))
(host/ok {:slug slug :updated true})))))
(host/error 400 "invalid payload")))))
;; DELETE /posts/<slug>
;; drop every edge touching `slug`, across all kinds + both directions, so a
;; deleted post leaves no dangling links anywhere in the graph.
(define host/blog--drop-all-edges!
(fn (slug)
(for-each
(fn (spec)
(let ((kind (get spec :kind)))
(begin
(for-each (fn (o) (host/blog-unrelate! slug o kind)) (host/blog-out slug kind))
(for-each (fn (o) (host/blog-unrelate! o slug kind)) (host/blog-in slug kind)))))
host/blog-rel-kinds)))
(define host/blog-delete-handler
(fn (req)
(let ((slug (dream-param req "slug")))
(if (host/blog-exists? slug)
(begin
(host/blog--drop-all-edges! slug)
(host/blog-delete! slug)
(host/ok {:slug slug :deleted true}))
(host/error 404 "no such post")))))
;; The JSON CRUD /posts (create/update/delete) was DELETED in the greenfield
;; SX-native pivot (plans/relations-as-posts.md, "SX all the way out") — it was a
;; pure old-contract REST mirror. Create + edit go through the HTML editor forms
;; (POST /new, POST /:slug/edit); programmatic writes will speak SXTP. FOLLOW-UP:
;; there is no browser delete route yet (delete was JSON-only and had no UI) — add
;; POST /:slug/delete + cascade edge cleanup (drop every edge touching the slug,
;; both directions, all kinds) when the metamodel UI needs it.
;; POST /<slug>/relate — relate this post to another (form `other` = slug, `kind` =
;; relation kind, default "related"). Validated: kind must be a known kind and the
@@ -1131,8 +1077,8 @@
(define host/blog-relate-submit
(fn (req)
(let ((slug (dream-param req "slug"))
(other (dream-form-field req "other"))
(kind (or (dream-form-field req "kind") "related")))
(other (host/field req "other"))
(kind (or (host/field req "kind") "related")))
(if (nil? (host/blog-get slug))
(host/blog--resp req 404
(host/blog--page req "Not found"
@@ -1161,8 +1107,8 @@
(define host/blog-unrelate-submit
(fn (req)
(let ((slug (dream-param req "slug"))
(other (dream-form-field req "other"))
(kind (or (dream-form-field req "kind") "related")))
(other (host/field req "other"))
(kind (or (host/field req "kind") "related")))
(begin
(when (and other (not (= other "")) (host/blog--kind-spec kind))
(host/blog-unrelate! slug other kind))
@@ -1230,9 +1176,9 @@
(host/blog--resp req 404
(host/blog--page req "Not found"
(quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
(let ((title (or (dream-form-field req "title") (get r :title)))
(sx-content (or (dream-form-field req "sx_content") ""))
(status (or (dream-form-field req "status") (get r :status))))
(let ((title (or (host/field req "title") (get r :title)))
(sx-content (or (host/field req "sx_content") ""))
(status (or (host/field req "status") (get r :status))))
;; collect issues up front (perform): unparseable markup, then each
;; schema requirement the post's types impose. Empty = save.
(let ((issues (if (host/blog-content-ok? sx-content)
@@ -1264,17 +1210,9 @@
(dream-get "/:slug/relate-options" host/blog-relate-options)
(dream-get "/:slug" host/blog-post)))
;; Guarded writes: form ingest + JSON create/update/delete behind auth+ACL.
;; NB: helper is host/blog--protect, NOT `guard` (reserved special form).
(define host/blog--protect
(fn (resolve h)
(host/pipeline
(list
host/wrap-errors
(host/require-user resolve)
(host/require-permission "edit" (fn (req) "blog")))
h)))
;; Browser variant: identical ACL gate, but an unauthenticated request REDIRECTS
;; Guarded writes: HTML editor form ingest behind auth+ACL. (The JSON CRUD that
;; used a bearer-based host/blog--protect was deleted in the SX-native pivot.)
;; Browser gate: identical ACL, but an unauthenticated request REDIRECTS
;; to the login page (host/require-login) rather than returning a raw JSON 401 —
;; the form/edit pages are HTML, so a logged-out click should land on /login and
;; return here afterwards.
@@ -1293,10 +1231,7 @@
(dream-get "/:slug/edit" (host/blog--protect-html resolve host/blog-edit-form))
(dream-post "/:slug/edit" (host/blog--protect-html resolve host/blog-edit-submit))
(dream-post "/:slug/relate" (host/blog--protect-html resolve host/blog-relate-submit))
(dream-post "/:slug/unrelate" (host/blog--protect-html resolve host/blog-unrelate-submit))
(dream-post "/posts" (host/blog--protect resolve host/blog-create))
(dream-put "/posts/:slug" (host/blog--protect resolve host/blog-update-handler))
(dream-delete "/posts/:slug" (host/blog--protect resolve host/blog-delete-handler)))))
(dream-post "/:slug/unrelate" (host/blog--protect-html resolve host/blog-unrelate-submit)))))
;; EXPERIMENTAL: create-only, UNGUARDED — POST /new form ingest with error
;; trapping but NO auth, for validating the editor->host publish loop on the

View File

@@ -25,11 +25,11 @@
;; ── write ──────────────────────────────────────────────────────────
;; POST /feed -> create an activity from the JSON body. Returns 201 + the created
;; (normalised) activity. Body must be a JSON object; anything else -> 400.
;; POST /feed -> create an activity from the text/sx body. Returns 201 + the created
;; (normalised) activity. Body must be an SX dict; anything else -> 400.
(define host/feed-create
(fn (req)
(let ((raw (dream-json-body req)))
(let ((raw (host/sx-body req)))
(if (= (type-of raw) "dict")
(host/ok-status 201 (feed/post raw))
(host/error 400 "invalid activity")))))

View File

@@ -1,33 +1,35 @@
;; lib/host/handler.sx — Host handler layer: the bridge from a Dream request to a
;; subsystem call and back to a Dream response. A host handler IS a Dream handler
;; (request -> response); these helpers build the JSON envelope every host
;; endpoint shares: {"ok":true,"data":...} on success, {"ok":false,"error":...}
;; on failure. Plus a status-carrying JSON constructor that Dream's own dream-json
;; (200-only) lacks, and a couple of request-reading conveniences.
;; Depends on lib/dream/types.sx + lib/dream/json.sx.
;; (request -> response); these helpers build the SX-native envelope every host
;; endpoint shares — text/sx, serialized SX wire format (NOT JSON): {:ok true
;; :data ...} on success, {:ok false :error ...} on failure. The platform speaks
;; SX end to end; JSON lives only at the ActivityPub federation edge (JSON-LD).
;; Depends on lib/dream/types.sx.
;; ── responses ──────────────────────────────────────────────────────
;; JSON response at an arbitrary status (dream-json is 200-only).
(define host/json-status
;; SX response at an arbitrary status: content-type text/sx, body = the value
;; serialized to SX wire format (the same `serialize` SXTP uses). The SX engine /
;; WASM kernel parses this directly — NO JSON on the internal wire.
(define host/sx-status
(fn (status value)
(dream-response status {:content-type "application/json"}
(dream-json-encode value))))
(dream-response status {:content-type "text/sx; charset=utf-8"}
(serialize value))))
;; Success envelope: 200 {"ok":true,"data":<value>}.
;; Success envelope: 200 {:ok true :data <value>}.
(define host/ok
(fn (value)
(host/json-status 200 {:ok true :data value})))
(host/sx-status 200 {:ok true :data value})))
;; Success envelope at a chosen status (e.g. 201 for a created resource).
(define host/ok-status
(fn (status value)
(host/json-status status {:ok true :data value})))
(host/sx-status status {:ok true :data value})))
;; Error envelope: {"ok":false,"error":<message>} at the given status.
;; Error envelope: {:ok false :error <message>} at the given status.
(define host/error
(fn (status message)
(host/json-status status {:ok false :error message})))
(host/sx-status status {:ok false :error message})))
;; ── request reading ────────────────────────────────────────────────

View File

@@ -81,9 +81,10 @@
nil))))
;; POST /internal/actions/attach-child — create the container edge. 201 on success.
;; Body is text/sx (host/sx-body); non-dict -> 400.
(define host/relations-attach
(fn (req)
(let ((p (dream-json-body req)))
(let ((p (host/sx-body req)))
(if (= (type-of p) "dict")
(let ((e (host/-rel-edge p)))
(if e
@@ -96,9 +97,10 @@
(host/error 400 "invalid payload")))))
;; POST /internal/actions/detach-child — remove the container edge. 200 on success.
;; Body is text/sx (host/sx-body); non-dict -> 400.
(define host/relations-detach
(fn (req)
(let ((p (dream-json-body req)))
(let ((p (host/sx-body req)))
(if (= (type-of p) "dict")
(let ((e (host/-rel-edge p)))
(if e

View File

@@ -171,3 +171,30 @@
(fn (text)
(let ((lst (parse text)))
(sxtp/-pairs->dict (rest lst) {:msg (symbol->string (first lst))}))))
;; ── host write-body: a request's text/sx body -> string-keyed dict ──
;; The write-side counterpart to host/sx-status: the SX engine posts text/sx for
;; writes (boosted forms serialise their fields), so write handlers read the body
;; through this instead of dream-json-body. parse-safe yields keyword-token keys;
;; sxtp/-normalize deep-converts them to strings so (get p :field) works — the same
;; shape dream-json-body produced from JSON. Empty / blank / non-dict / unparseable
;; body -> nil (handlers then return 400).
(define host/sx-body
(fn (req)
(let ((raw (dream-body req)))
(if (or (nil? raw) (= raw ""))
nil
(let ((v (parse-safe raw)))
(if (= (type-of v) "dict") (sxtp/-normalize v) nil))))))
;; ── unified write-field reader: text/sx body OR urlencoded form ─────
;; A boosted form posts text/sx (the SX engine serialises its fields); a no-engine
;; / pre-hydration submit (and the login bootstrap) posts urlencoded. Content-type
;; decides. host/fields returns ALL fields as one string-keyed dict; host/field
;; reads one by name. Form handlers read through these so both encodings work.
(define host/fields
(fn (req)
(if (contains? (or (dream-content-type-of req) "") "text/sx")
(or (host/sx-body req) {})
(or (dream-form-fields req) {}))))
(define host/field (fn (req name) (get (host/fields req) name)))

View File

@@ -42,8 +42,8 @@
(host-bl-test "home lists post"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/"))) "href=\"/hello/\"")
true)
(host-bl-test "json list shows post"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/posts"))) "\"slug\":\"hello\"")
(host-bl-test "sx list shows post"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/posts"))) ":slug \"hello\"")
true)
(host-bl-test "GET /new shows form"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/new"))) "<form")
@@ -53,7 +53,7 @@
(host-bl-test "unknown slug 404" (dream-status (host-bl-app (host-bl-req "/nope/"))) 404)
(feed/reset!)
(host-bl-test "/feed not captured by :slug"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/feed"))) "\"ok\":true")
(contains? (dream-resp-body (host-bl-app (host-bl-req "/feed"))) ":ok true")
true)
;; ── writes: editor form ingest + JSON CRUD (auth+ACL) ───────────────
@@ -94,39 +94,8 @@
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "<h1>My First Post</h1>")
true)
;; -- JSON CRUD --
(host-bl-test "json create -> 201"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json"
"{\"title\":\"Json Post\",\"sx_content\":\"(p \\\"jp\\\")\",\"status\":\"draft\"}")))
201)
(host-bl-test "json create unpermitted -> 403"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer weak" "application/json"
"{\"title\":\"Nope\"}")))
403)
(host-bl-test "json create duplicate -> 409"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json"
"{\"slug\":\"json-post\",\"title\":\"Json Post\"}")))
409)
(host-bl-test "json create no title -> 400"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json" "{}")))
400)
(host-bl-test "update -> 200"
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/json-post" "Bearer good" "application/json"
"{\"sx_content\":\"(p \\\"edited\\\")\"}")))
200)
(host-bl-test "update changed content"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/json-post/"))) "edited")
true)
(host-bl-test "update missing -> 404"
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/ghost" "Bearer good" "application/json" "{}")))
404)
(host-bl-test "delete -> 200"
(dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/json-post" "Bearer good" "" "")))
200)
(host-bl-test "deleted -> 404" (dream-status (host-bl-wapp (host-bl-req "/json-post/"))) 404)
(host-bl-test "delete missing -> 404"
(dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/ghost" "Bearer good" "" "")))
404)
;; (JSON CRUD tests removed — the /posts JSON create/update/delete endpoints were
;; deleted in the SX-native pivot; create + edit go through the form ingest above.)
;; -- write-time validation: malformed sx_content rejected, never stored --
;; "%3Ch1+broken%29" decodes to "<h1 broken)" — a typo'd paren the parser rejects.
@@ -138,20 +107,8 @@
(host-bl-test "rejected form post was not stored"
(dream-status (host-bl-wapp (host-bl-req "/bad-form/")))
404)
(host-bl-test "json create malformed sx_content -> 400"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json"
"{\"title\":\"Bad Json\",\"sx_content\":\"<h1 broken)\"}")))
400)
(host-bl-test "rejected json post was not stored"
(dream-status (host-bl-wapp (host-bl-req "/bad-json/")))
404)
(host-bl-test "json update malformed sx_content -> 400"
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/my-first-post" "Bearer good"
"application/json" "{\"sx_content\":\"<h1 broken)\"}")))
400)
(host-bl-test "rejected update left content intact"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "<h1>My First Post</h1>")
true)
;; (JSON malformed-content tests removed with the JSON CRUD endpoints; the form
;; ingest malformed-content checks above still cover write-time validation.)
;; -- view source (public) --
(host-bl-test "view source -> 200"
@@ -246,13 +203,9 @@
(list (contains? (host/blog-related "my-first-post") "another-one")
(contains? (host/blog-related "another-one") "my-first-post")))
(list false false))
(host-bl-test "delete cleans up related edges"
(begin
(host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" "Bearer good"
"application/x-www-form-urlencoded" "other=another-one"))
(host-bl-wapp (host-bl-send "DELETE" "/posts/another-one" "Bearer good" "" ""))
(contains? (host/blog-related "my-first-post") "another-one"))
false)
;; (The "delete cleans up related edges" test was removed with the JSON DELETE
;; /posts endpoint; cascade edge cleanup returns when a browser delete route is
;; added — see the FOLLOW-UP note in lib/host/blog.sx.)
;; -- relate picker (filterable candidate endpoint + glue + hint) --
(host/blog-put! "alpha-post" "Alpha Post" "(p \"a\")" "published")

View File

@@ -33,8 +33,8 @@
(dream-status (host-fd-app (host-fd-req "/feed")))
200)
(host-fd-test
"empty feed data:[]"
(contains? (dream-resp-body (host-fd-app (host-fd-req "/feed"))) "\"data\":[]")
"empty feed data ()"
(contains? (dream-resp-body (host-fd-app (host-fd-req "/feed"))) ":data ()")
true)
;; ── seeded feed ────────────────────────────────────────────────────
@@ -47,7 +47,7 @@
(host-fd-test
"timeline recent-first"
(let ((body (dream-resp-body (host-fd-app (host-fd-req "/feed")))))
(< (index-of body "\"at\":3") (index-of body "\"at\":1")))
(< (index-of body ":at 3") (index-of body ":at 1")))
true)
;; actor filter: only alice's two activities.
@@ -68,25 +68,18 @@
"limit caps results"
(contains?
(dream-resp-body (host-fd-app (host-fd-req "/feed?limit=1")))
"\"at\":1")
":at 1")
false)
;; ── golden: endpoint = subsystem recent stream + envelope ───────────
(host-fd-test
"golden full timeline"
(dream-resp-body (host-fd-app (host-fd-req "/feed")))
(str
"{\"ok\":true,\"data\":"
(dream-json-encode (feed/items (feed/recent (feed/all))))
"}"))
(serialize {:ok true :data (feed/items (feed/recent (feed/all)))}))
(host-fd-test
"golden actor-filtered"
(dream-resp-body (host-fd-app (host-fd-req "/feed?actor=alice")))
(str
"{\"ok\":true,\"data\":"
(dream-json-encode
(feed/items (feed/by-actor (feed/recent (feed/all)) "alice")))
"}"))
(serialize {:ok true :data (feed/items (feed/by-actor (feed/recent (feed/all)) "alice"))}))
;; ── write: POST /feed (auth + ACL + action) ────────────────────────
(acl/load! (list (acl-grant "alice" "post" "feed")))
@@ -115,7 +108,7 @@
(host-fd-wapp
(host-fd-post
"Bearer good"
"{\"actor\":\"alice\",\"verb\":\"post\",\"object\":\"p9\",\"at\":9}")))
"{:actor \"alice\" :verb \"post\" :object \"p9\" :at 9}")))
201)
(host-fd-test "post grew feed" (feed/size) 1)
(host-fd-test
@@ -126,7 +119,7 @@
true)
(host-fd-test
"post non-object body -> 400"
(dream-status (host-fd-wapp (host-fd-post "Bearer good" "[1,2]")))
(dream-status (host-fd-wapp (host-fd-post "Bearer good" "(1 2)")))
400)
(define

View File

@@ -18,48 +18,48 @@
;; ── host/ok ────────────────────────────────────────────────────────
(host-hd-test "ok status 200" (dream-status (host/ok "x")) 200)
(host-hd-test
"ok content-type json"
"ok content-type sx"
(dream-resp-header (host/ok "x") "content-type")
"application/json")
"text/sx; charset=utf-8")
(host-hd-test
"ok envelope ok:true"
(contains? (dream-resp-body (host/ok "x")) "\"ok\":true")
(contains? (dream-resp-body (host/ok "x")) ":ok true")
true)
(host-hd-test
"ok envelope carries data"
(contains? (dream-resp-body (host/ok "hi")) "\"data\":\"hi\"")
(contains? (dream-resp-body (host/ok "hi")) ":data \"hi\"")
true)
;; ── host/ok-status ─────────────────────────────────────────────────
(host-hd-test "ok-status custom" (dream-status (host/ok-status 201 "y")) 201)
(host-hd-test
"ok-status data"
(contains? (dream-resp-body (host/ok-status 201 "y")) "\"data\":\"y\"")
(contains? (dream-resp-body (host/ok-status 201 "y")) ":data \"y\"")
true)
;; ── host/error ─────────────────────────────────────────────────────
(host-hd-test "error status" (dream-status (host/error 404 "nope")) 404)
(host-hd-test
"error ok:false"
(contains? (dream-resp-body (host/error 404 "nope")) "\"ok\":false")
(contains? (dream-resp-body (host/error 404 "nope")) ":ok false")
true)
(host-hd-test
"error message"
(contains? (dream-resp-body (host/error 404 "nope")) "\"error\":\"nope\"")
(contains? (dream-resp-body (host/error 404 "nope")) ":error \"nope\"")
true)
(host-hd-test
"error content-type json"
"error content-type sx"
(dream-resp-header (host/error 500 "boom") "content-type")
"application/json")
"text/sx; charset=utf-8")
;; ── host/json-status ───────────────────────────────────────────────
;; ── host/sx-status ─────────────────────────────────────────────────
(host-hd-test
"json-status arbitrary status"
(dream-status (host/json-status 418 {:a 1}))
"sx-status arbitrary status"
(dream-status (host/sx-status 418 {:a 1}))
418)
(host-hd-test
"json-status encodes body"
(contains? (dream-resp-body (host/json-status 200 {:a 1})) "\"a\":1")
"sx-status serializes body"
(contains? (dream-resp-body (host/sx-status 200 {:a 1})) ":a 1")
true)
;; ── host/query-int ─────────────────────────────────────────────────

View File

@@ -71,7 +71,7 @@
"principal threaded to handler"
(contains?
(dream-resp-body (host-mw-protected (host-mw-req "Bearer good")))
"\"data\":\"alice\"")
":data \"alice\"")
true)
(host-mw-test
"authed but not permitted -> 403"
@@ -81,7 +81,7 @@
"403 envelope"
(contains?
(dream-resp-body (host-mw-protected-del (host-mw-req "Bearer good")))
"\"error\":\"forbidden\"")
":error \"forbidden\"")
true)
;; ── error trapping ─────────────────────────────────────────────────
@@ -94,7 +94,7 @@
"500 envelope"
(contains?
(dream-resp-body ((host/wrap-errors host-mw-boom) (host-mw-req nil)))
"\"ok\":false")
":ok false")
true)
(define

View File

@@ -88,19 +88,11 @@
(host-rl-test
"golden children"
(dream-resp-body (host-rl-app (host-rl-req host-rl-kids)))
(str
"{\"ok\":true,\"data\":"
(dream-json-encode
(host/-rel-strings (relations/children (host-rl-sym "org:1") (host-rl-sym "member"))))
"}"))
(serialize {:ok true :data (host/-rel-strings (relations/children (host-rl-sym "org:1") (host-rl-sym "member")))}))
(host-rl-test
"golden parents"
(dream-resp-body (host-rl-app (host-rl-req host-rl-par)))
(str
"{\"ok\":true,\"data\":"
(dream-json-encode
(host/-rel-strings (relations/parents (host-rl-sym "list:7") (host-rl-sym "member"))))
"}"))
(serialize {:ok true :data (host/-rel-strings (relations/parents (host-rl-sym "list:7") (host-rl-sym "member")))}))
;; ── writes: attach-child / detach-child (auth + ACL + closed loop) ──
(acl/load!
@@ -119,7 +111,7 @@
(dream-request "POST" (str "/internal/actions/" action)
(if auth {:authorization auth} {}) body)))
(define host-rl-edge
"{\"parent-type\":\"org\",\"parent-id\":\"2\",\"child-type\":\"list\",\"child-id\":\"5\",\"relation-type\":\"member\"}")
"{:parent-type \"org\" :parent-id \"2\" :child-type \"list\" :child-id \"5\" :relation-type \"member\"}")
(define host-rl-org2
"/internal/data/get-children?parent-type=org&parent-id=2&relation-type=member")
@@ -162,12 +154,12 @@
;; bad payloads
(host-rl-test
"attach non-object body -> 400"
(dream-status (host-rl-wapp (host-rl-post "attach-child" "Bearer good" "[1,2]")))
(dream-status (host-rl-wapp (host-rl-post "attach-child" "Bearer good" "(1 2)")))
400)
(host-rl-test
"attach missing param -> 400"
(dream-status
(host-rl-wapp (host-rl-post "attach-child" "Bearer good" "{\"parent-type\":\"org\"}")))
(host-rl-wapp (host-rl-post "attach-child" "Bearer good" "{:parent-type \"org\"}")))
400)
(define

View File

@@ -52,7 +52,7 @@
"group path param"
(contains?
(dream-resp-body (host-rt-app (host-rt-req "GET" "/widgets/42")))
"\"data\":\"42\"")
":data \"42\"")
true)
;; ── fallback ───────────────────────────────────────────────────────

View File

@@ -93,7 +93,7 @@
(host-se-test "principal threaded from the session to the handler"
(contains?
(dream-resp-body (host-se-secure (host-se-cookie-of (host-se-login "admin" "secret"))))
"\"data\":\"admin\"")
":data \"admin\"")
true)
;; ── unauthenticated / forged ────────────────────────────────────────

View File

@@ -68,14 +68,34 @@ Sequence: finish the schema language (Slices 67) → the two UI surfaces + re
data and define a real domain through the UI. The slices below are the schema language; this is
what it's *for*.
### Endgame — the whole platform as a typed domain (the strangler's finish line)
### Endgame — the whole platform as a typed domain (greenfield, not a strangler)
Not just the blog: the entire rose-ash platform — **store, events, orders, cart, …** — is
expressible as type + relation definitions in this one metamodel. `Product`, `Event`, `Order`,
`Ticket` are types; "cart has line-items", "order for an event", "ticket of an event" are
relations with signatures (cardinality = a cart has many line-items, a ticket belongs to one
event). This is the completion of the host-on-sx strangler off Quart (`[[project_host_on_sx]]`):
define the domain schema as data instead of porting each service's bespoke models.
event). This is NOT a strangler off Quart (`[[project_host_on_sx]]`) — it's a **greenfield,
SX-native system**: define the domain schema as data from first principles, then **port the data
once at the end** (define-then-port), rather than reimplementing each service's bespoke models
endpoint-by-endpoint. The strangler's compatibility machinery (JSON mirrors, route/model parity,
incremental contracts) is dropped — it was tax, not value, for a system that doesn't *correspond*
to the old one.
### SX all the way out — no JSON on the internal wire
The platform speaks **SX/SXTP end to end**, both directions, browser included — JSON survives only
at the ActivityPub federation edge (JSON-LD, a published external standard).
| Layer | SX-native form |
|-------|----------------|
| Page render | HTML (the document itself) |
| Data reads | `text/sx` via the `serialize` primitive (`host/ok`/`host/error``host/sx-status`) |
| Write bodies | `text/sx` parsed via `sxtp/parse` (was JSON / form-urlencoded) |
| Browser → server | the engine posts `text/sx` (boosted forms serialise fields to SX wire); form-urlencoded survives only as the **no-engine / pre-hydration fallback** + the **login bootstrap** handshake |
| Federation edge | JSON-LD (ActivityPub — the *only* JSON) |
The blog **JSON CRUD `/posts`** (POST/PUT/DELETE) is **deleted**, not converted: it was a pure
old-contract REST mirror; writes go through the HTML editor forms + SXTP.
Three honest additions store/events surface (the blog didn't need them):