giles
999249b944
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>
108 lines
3.3 KiB
Plaintext
108 lines
3.3 KiB
Plaintext
;; lib/host/tests/middleware.sx — auth (bearer -> principal), ACL gate, and error
|
|
;; trapping, composed via host/pipeline. ACL facts: alice may "post" on "feed".
|
|
|
|
(define host-mw-pass 0)
|
|
(define host-mw-fail 0)
|
|
(define host-mw-fails (list))
|
|
|
|
(define
|
|
host-mw-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! host-mw-pass (+ host-mw-pass 1))
|
|
(begin
|
|
(set! host-mw-fail (+ host-mw-fail 1))
|
|
(append! host-mw-fails {:name name :actual actual :expected expected})))))
|
|
|
|
;; ── fixtures ───────────────────────────────────────────────────────
|
|
(acl/load! (list (acl-grant "alice" "post" "feed")))
|
|
|
|
(define host-mw-resolve
|
|
(fn (tok) (if (= tok "good") "alice" nil)))
|
|
|
|
(define host-mw-handler
|
|
(fn (req) (host/ok-status 201 (host/principal req))))
|
|
|
|
;; protected: needs auth + post/feed permission
|
|
(define host-mw-protected
|
|
(host/pipeline
|
|
(list
|
|
(host/require-auth host-mw-resolve)
|
|
(host/require-permission "post" (fn (req) "feed")))
|
|
host-mw-handler))
|
|
|
|
;; protected with an action alice is NOT granted
|
|
(define host-mw-protected-del
|
|
(host/pipeline
|
|
(list
|
|
(host/require-auth host-mw-resolve)
|
|
(host/require-permission "delete" (fn (req) "feed")))
|
|
host-mw-handler))
|
|
|
|
(define
|
|
host-mw-req
|
|
(fn (auth)
|
|
(dream-request "POST" "/feed"
|
|
(if auth {:authorization auth} {})
|
|
"")))
|
|
|
|
;; ── auth ───────────────────────────────────────────────────────────
|
|
(host-mw-test
|
|
"no token -> 401"
|
|
(dream-status (host-mw-protected (host-mw-req nil)))
|
|
401)
|
|
(host-mw-test
|
|
"401 has www-authenticate"
|
|
(dream-resp-header (host-mw-protected (host-mw-req nil)) "www-authenticate")
|
|
"Bearer")
|
|
(host-mw-test
|
|
"bad token -> 401"
|
|
(dream-status (host-mw-protected (host-mw-req "Bearer wrong")))
|
|
401)
|
|
|
|
;; ── authz ──────────────────────────────────────────────────────────
|
|
(host-mw-test
|
|
"authed + permitted -> 201"
|
|
(dream-status (host-mw-protected (host-mw-req "Bearer good")))
|
|
201)
|
|
(host-mw-test
|
|
"principal threaded to handler"
|
|
(contains?
|
|
(dream-resp-body (host-mw-protected (host-mw-req "Bearer good")))
|
|
":data \"alice\"")
|
|
true)
|
|
(host-mw-test
|
|
"authed but not permitted -> 403"
|
|
(dream-status (host-mw-protected-del (host-mw-req "Bearer good")))
|
|
403)
|
|
(host-mw-test
|
|
"403 envelope"
|
|
(contains?
|
|
(dream-resp-body (host-mw-protected-del (host-mw-req "Bearer good")))
|
|
":error \"forbidden\"")
|
|
true)
|
|
|
|
;; ── error trapping ─────────────────────────────────────────────────
|
|
(define host-mw-boom (fn (req) (error "kaboom")))
|
|
(host-mw-test
|
|
"wrap-errors -> 500"
|
|
(dream-status ((host/wrap-errors host-mw-boom) (host-mw-req nil)))
|
|
500)
|
|
(host-mw-test
|
|
"500 envelope"
|
|
(contains?
|
|
(dream-resp-body ((host/wrap-errors host-mw-boom) (host-mw-req nil)))
|
|
":ok false")
|
|
true)
|
|
|
|
(define
|
|
host-mw-tests-run!
|
|
(fn
|
|
()
|
|
{:total (+ host-mw-pass host-mw-fail)
|
|
:passed host-mw-pass
|
|
:failed host-mw-fail
|
|
:fails host-mw-fails}))
|