coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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:
giles
2026-06-30 11:07:30 +00:00
parent ad86f3051e
commit 999249b944
14 changed files with 145 additions and 221 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
lib/host/tests/blog.sx
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")

23
lib/host/tests/feed.sx
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

28
lib/host/tests/handler.sx
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 ─────────────────────────────────────────────────

6
lib/host/tests/middleware.sx
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

18
lib/host/tests/relations.sx
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

2
lib/host/tests/router.sx
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 ───────────────────────────────────────────────────────

2
lib/host/tests/session.sx
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 ────────────────────────────────────────