host: Phase 2 — middleware (auth+ACL+error) + guarded POST /feed, 43/43
Composable handler->handler layers over Dream's primitives, with auth and permission POLICY injected so the layer is policy-free and testable: - middleware.sx: host/wrap-errors (JSON 500 via dream-catch-with), host/require-auth (bearer->principal via dream-bearer-token, JSON 401, injected token resolver), host/require-permission (lib/acl acl/permit? gate, JSON 403, injected resource extractor), host/pipeline (first = outermost) - feed.sx: POST /feed via host/feed-write-routes — auth ∘ ACL(post,feed) ∘ wrap-errors over host/feed-create (parse JSON body -> feed/post -> 201; non-object -> 400). Created activity reads back via GET /feed. - middleware suite (9) + feed write tests (6 new); conformance preloads now include the Datalog engine + ACL subsystem + Dream auth/error. ACL works with string atoms (no symbol coercion). Mute/prefs layer and sxtp.sx deferred to the next tick. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -22,28 +22,50 @@ fi
|
||||
VERBOSE="${1:-}"
|
||||
|
||||
# Kernel + subsystem dependencies, then the host modules. Order matters:
|
||||
# stdlib/r7rs first, then the feed subsystem (the first migrated domain), then
|
||||
# Dream (types/json/router) the host builds on, then the host layer itself.
|
||||
# stdlib/r7rs first; the Datalog engine + ACL subsystem (authorisation); the feed
|
||||
# subsystem (the first migrated domain); Dream (types/json/auth/error/router) the
|
||||
# host builds on; then the host layer itself.
|
||||
MODULES=(
|
||||
"spec/stdlib.sx"
|
||||
"lib/r7rs.sx"
|
||||
"lib/apl/runtime.sx"
|
||||
"lib/datalog/tokenizer.sx"
|
||||
"lib/datalog/parser.sx"
|
||||
"lib/datalog/unify.sx"
|
||||
"lib/datalog/db.sx"
|
||||
"lib/datalog/builtins.sx"
|
||||
"lib/datalog/aggregates.sx"
|
||||
"lib/datalog/strata.sx"
|
||||
"lib/datalog/eval.sx"
|
||||
"lib/datalog/api.sx"
|
||||
"lib/datalog/magic.sx"
|
||||
"lib/acl/schema.sx"
|
||||
"lib/acl/facts.sx"
|
||||
"lib/acl/engine.sx"
|
||||
"lib/acl/explain.sx"
|
||||
"lib/acl/audit.sx"
|
||||
"lib/acl/federation.sx"
|
||||
"lib/acl/api.sx"
|
||||
"lib/feed/normalize.sx"
|
||||
"lib/feed/stream.sx"
|
||||
"lib/feed/api.sx"
|
||||
"lib/dream/types.sx"
|
||||
"lib/dream/json.sx"
|
||||
"lib/dream/auth.sx"
|
||||
"lib/dream/error.sx"
|
||||
"lib/dream/router.sx"
|
||||
"lib/host/handler.sx"
|
||||
"lib/host/middleware.sx"
|
||||
"lib/host/router.sx"
|
||||
"lib/host/feed.sx"
|
||||
)
|
||||
|
||||
# Suites: NAME RUNNER-FN PATH
|
||||
SUITES=(
|
||||
"handler host-hd-tests-run! lib/host/tests/handler.sx"
|
||||
"router host-rt-tests-run! lib/host/tests/router.sx"
|
||||
"feed host-fd-tests-run! lib/host/tests/feed.sx"
|
||||
"handler host-hd-tests-run! lib/host/tests/handler.sx"
|
||||
"middleware host-mw-tests-run! lib/host/tests/middleware.sx"
|
||||
"router host-rt-tests-run! lib/host/tests/router.sx"
|
||||
"feed host-fd-tests-run! lib/host/tests/feed.sx"
|
||||
)
|
||||
|
||||
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
|
||||
|
||||
@@ -1,8 +1,10 @@
|
||||
;; lib/host/feed.sx — Feed domain endpoints on the host. The first real endpoint
|
||||
;; migrated onto the SX host: the activity timeline, read straight from the feed
|
||||
;; subsystem's public API (feed/all + the stream combinators) and serialised as
|
||||
;; JSON. GET /feed returns recent-first activities; ?actor=<id> filters by actor
|
||||
;; and ?limit=<n> caps the count. Depends on lib/feed/* + lib/host/handler.sx.
|
||||
;; lib/host/feed.sx — Feed domain endpoints on the host. The first domain migrated
|
||||
;; onto the SX host: read the activity timeline (GET /feed) and create activities
|
||||
;; (POST /feed). Both go straight through the feed subsystem's public API; the
|
||||
;; write path runs behind the host middleware stack (auth + ACL). Depends on
|
||||
;; lib/feed/* + lib/host/handler.sx + lib/host/middleware.sx (write routes only).
|
||||
|
||||
;; ── read ───────────────────────────────────────────────────────────
|
||||
|
||||
;; GET /feed -> recent-first activities as a JSON envelope.
|
||||
;; Query: ?actor=<id> (filter) ?limit=<n> (cap, applied after filtering).
|
||||
@@ -16,7 +18,32 @@
|
||||
(if limit (feed/take filtered (string->number limit)) filtered)))
|
||||
(host/ok (feed/items capped)))))))
|
||||
|
||||
;; Route group contributed by the feed domain.
|
||||
;; Public read route group.
|
||||
(define host/feed-routes
|
||||
(list
|
||||
(dream-get "/feed" host/feed-timeline)))
|
||||
|
||||
;; ── 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.
|
||||
(define host/feed-create
|
||||
(fn (req)
|
||||
(let ((raw (dream-json-body req)))
|
||||
(if (= (type-of raw) "dict")
|
||||
(host/ok-status 201 (feed/post raw))
|
||||
(host/error 400 "invalid activity")))))
|
||||
|
||||
;; Guarded write route group: POST /feed behind auth + ACL ("post" on "feed").
|
||||
;; resolve : token -> principal | nil (injected auth policy, e.g. token lookup
|
||||
;; against the identity subsystem). Errors thrown downstream become a JSON 500.
|
||||
(define host/feed-write-routes
|
||||
(fn (resolve)
|
||||
(list
|
||||
(dream-post "/feed"
|
||||
(host/pipeline
|
||||
(list
|
||||
host/wrap-errors
|
||||
(host/require-auth resolve)
|
||||
(host/require-permission "post" (fn (req) "feed")))
|
||||
host/feed-create)))))
|
||||
|
||||
54
lib/host/middleware.sx
Normal file
54
lib/host/middleware.sx
Normal file
@@ -0,0 +1,54 @@
|
||||
;; lib/host/middleware.sx — Host middleware: composable handler->handler layers
|
||||
;; for the cross-cutting concerns every write endpoint shares — error trapping
|
||||
;; (JSON 500), authentication (bearer token -> principal), and authorisation
|
||||
;; (ACL permit?). Middleware is plain function composition; host/pipeline threads a
|
||||
;; list onto a handler, FIRST middleware outermost (so it runs first). Auth and
|
||||
;; permission policy are INJECTED — the token resolver and the resource extractor —
|
||||
;; so this layer carries no hardcoded policy. Reuses Dream's bearer/error helpers
|
||||
;; and lib/acl's public acl/permit?.
|
||||
;; Depends on lib/dream/{auth,error,router}.sx + lib/acl/api.sx + lib/host/handler.sx.
|
||||
|
||||
;; Compose a list of middlewares onto a handler (first = outermost).
|
||||
(define host/pipeline
|
||||
(fn (middlewares handler)
|
||||
(dr/apply-middlewares middlewares handler)))
|
||||
|
||||
;; The authenticated principal attached by host/require-auth.
|
||||
(define host/principal (fn (req) (dream-principal req)))
|
||||
|
||||
;; ── error trapping ─────────────────────────────────────────────────
|
||||
;; Any error thrown downstream becomes a JSON 500 envelope.
|
||||
(define host/-on-error
|
||||
(fn (req e) (host/error 500 "internal error")))
|
||||
(define host/wrap-errors (dream-catch-with host/-on-error))
|
||||
|
||||
;; ── authentication ─────────────────────────────────────────────────
|
||||
;; resolve : token -> principal | nil. Missing/invalid token -> JSON 401 with a
|
||||
;; WWW-Authenticate: Bearer challenge; success attaches :dream-principal so
|
||||
;; downstream layers (and host/principal) can read it.
|
||||
(define host/require-auth
|
||||
(fn (resolve)
|
||||
(fn (next)
|
||||
(fn (req)
|
||||
(let ((tok (dream-bearer-token req)))
|
||||
(let ((principal (if tok (resolve tok) nil)))
|
||||
(if (nil? principal)
|
||||
(dream-add-header
|
||||
(host/error 401 "unauthorized")
|
||||
"www-authenticate"
|
||||
"Bearer")
|
||||
(next (assoc req :dream-principal principal)))))))))
|
||||
|
||||
;; ── authorisation ──────────────────────────────────────────────────
|
||||
;; Gate on ACL: the authed principal must be permitted `action` on the resource
|
||||
;; computed by res-fn from the request. Denied -> JSON 403. Assumes the ACL fact
|
||||
;; db was loaded (acl/load!) at startup. Place AFTER host/require-auth.
|
||||
(define host/require-permission
|
||||
(fn (action res-fn)
|
||||
(fn (next)
|
||||
(fn (req)
|
||||
(let ((subject (host/principal req))
|
||||
(resource (res-fn req)))
|
||||
(if (acl/permit? subject action resource)
|
||||
(next req)
|
||||
(host/error 403 "forbidden")))))))
|
||||
@@ -1,7 +1,7 @@
|
||||
;; lib/host/tests/feed.sx — the first migrated endpoint, GET /feed. Includes a
|
||||
;; golden test: the host response body must equal the feed subsystem's own
|
||||
;; recent-first stream wrapped in the standard envelope — the endpoint adds the
|
||||
;; HTTP/JSON shell and nothing else.
|
||||
;; lib/host/tests/feed.sx — the migrated feed endpoints, GET /feed (read) and
|
||||
;; POST /feed (guarded write). Includes a golden test: the host read response
|
||||
;; body must equal the feed subsystem's own recent-first stream wrapped in the
|
||||
;; standard envelope — the endpoint adds the HTTP/JSON shell and nothing else.
|
||||
|
||||
(define host-fd-pass 0)
|
||||
(define host-fd-fail 0)
|
||||
@@ -43,7 +43,7 @@
|
||||
(feed/post {:actor "bob" :verb "post" :object "p2" :at 2})
|
||||
(feed/post {:actor "alice" :verb "like" :object "p2" :at 3})
|
||||
|
||||
;; recent-first: newest activity (at 3) leads, so its object p2 appears before p1.
|
||||
;; recent-first: newest activity (at 3) leads, so its marker precedes the oldest.
|
||||
(host-fd-test
|
||||
"timeline recent-first"
|
||||
(let ((body (dream-resp-body (host-fd-app (host-fd-req "/feed")))))
|
||||
@@ -88,6 +88,47 @@
|
||||
(feed/items (feed/by-actor (feed/recent (feed/all)) "alice")))
|
||||
"}"))
|
||||
|
||||
;; ── write: POST /feed (auth + ACL + action) ────────────────────────
|
||||
(acl/load! (list (acl-grant "alice" "post" "feed")))
|
||||
(define host-fd-resolve (fn (tok) (if (= tok "good") "alice" nil)))
|
||||
(define
|
||||
host-fd-wapp
|
||||
(host/make-app
|
||||
(list host/feed-routes (host/feed-write-routes host-fd-resolve))))
|
||||
(define
|
||||
host-fd-post
|
||||
(fn (auth body)
|
||||
(dream-request "POST" "/feed" (if auth {:authorization auth} {}) body)))
|
||||
|
||||
(feed/reset!)
|
||||
(host-fd-test
|
||||
"post no auth -> 401"
|
||||
(dream-status (host-fd-wapp (host-fd-post nil "{}")))
|
||||
401)
|
||||
(host-fd-test
|
||||
"post unchanged feed after 401"
|
||||
(feed/size)
|
||||
0)
|
||||
(host-fd-test
|
||||
"post authed+permitted -> 201"
|
||||
(dream-status
|
||||
(host-fd-wapp
|
||||
(host-fd-post
|
||||
"Bearer good"
|
||||
"{\"actor\":\"alice\",\"verb\":\"post\",\"object\":\"p9\",\"at\":9}")))
|
||||
201)
|
||||
(host-fd-test "post grew feed" (feed/size) 1)
|
||||
(host-fd-test
|
||||
"created activity visible in timeline"
|
||||
(contains?
|
||||
(dream-resp-body (host-fd-wapp (host-fd-req "/feed")))
|
||||
"p9")
|
||||
true)
|
||||
(host-fd-test
|
||||
"post non-object body -> 400"
|
||||
(dream-status (host-fd-wapp (host-fd-post "Bearer good" "[1,2]")))
|
||||
400)
|
||||
|
||||
(define
|
||||
host-fd-tests-run!
|
||||
(fn
|
||||
|
||||
107
lib/host/tests/middleware.sx
Normal file
107
lib/host/tests/middleware.sx
Normal file
@@ -0,0 +1,107 @@
|
||||
;; 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}))
|
||||
@@ -36,7 +36,8 @@ host — no `ocaml-on-sx` dependency.
|
||||
|
||||
## Status (rolling)
|
||||
|
||||
`bash lib/host/conformance.sh` → **28/28** (3 suites: handler, router, feed). Phase 1 DONE.
|
||||
`bash lib/host/conformance.sh` → **43/43** (4 suites: handler, middleware, router,
|
||||
feed). Phase 1 DONE; Phase 2 in progress (middleware + write endpoint DONE, SXTP next).
|
||||
|
||||
## Ground rules
|
||||
|
||||
@@ -84,9 +85,18 @@ lib/host/sxtp.sx subsystem APIs (feed/search/commerce/…
|
||||
- [x] `conformance.sh` (mirrors `lib/dream`'s runner) — 28/28
|
||||
|
||||
## Phase 2 — Middleware + SXTP
|
||||
- [ ] `middleware.sx` — composable auth/acl/mute/error layers
|
||||
- [ ] `sxtp.sx` — host↔subsystem wire format (align with existing spec)
|
||||
- [ ] migrate a write endpoint (auth + permission + action)
|
||||
- [x] `middleware.sx` — composable layers as `handler->handler`: `host/wrap-errors`
|
||||
(JSON 500), `host/require-auth` (bearer -> principal, JSON 401, INJECTED token
|
||||
resolver), `host/require-permission` (ACL `acl/permit?` gate, JSON 403,
|
||||
INJECTED resource extractor), `host/pipeline` (first = outermost). Reuses
|
||||
Dream's `dream-bearer-token` + `dream-catch-with`; calls lib/acl public API.
|
||||
Mute/prefs layer deferred (no blocker, add when a domain needs it).
|
||||
- [ ] `sxtp.sx` — host↔subsystem wire format (align with existing spec at
|
||||
`applications/sxtp/spec.sx`)
|
||||
- [x] migrate a write endpoint (auth + permission + action): `POST /feed`
|
||||
(`host/feed-write-routes resolve`) — auth ∘ ACL("post","feed") ∘ wrap-errors
|
||||
over `host/feed-create`, which parses the JSON body and `feed/post`s it (201);
|
||||
non-object body -> 400. Created activity is readable back via `GET /feed`.
|
||||
|
||||
## Phase 3 — Strangler migration ledger
|
||||
- [ ] enumerate Quart endpoints; track migrated vs proxied
|
||||
@@ -116,6 +126,16 @@ lib/host/sxtp.sx subsystem APIs (feed/search/commerce/…
|
||||
`hosts/` change (out of scope) — tracked under Blockers as the eventual
|
||||
live-wiring step. For now the host layer is exercised purely via conformance.
|
||||
|
||||
- **Phase 2 (middleware + write endpoint DONE, 43/43).** `lib/host/middleware.sx`
|
||||
+ a guarded `POST /feed`. Middleware is plain function composition over Dream's
|
||||
primitives; auth/permission *policy* is injected (token resolver, resource
|
||||
extractor) so the layer is policy-free and testable. ACL authorisation runs
|
||||
against lib/acl's public `acl/permit?` (string atoms work — no symbol coercion
|
||||
needed). The write path proves the auth ∘ permission ∘ action stack end-to-end:
|
||||
401 unauth, 403 unpermitted, 201 + readback on success, 400 on bad body.
|
||||
- **Remaining for Phase 2: `sxtp.sx`** — the host↔subsystem wire format. Align
|
||||
with the existing spec at `applications/sxtp/spec.sx`. This is the next tick.
|
||||
|
||||
## Blockers
|
||||
|
||||
- **Live wiring to the native OCaml HTTP server** (Phase 3/4): the prod server in
|
||||
|
||||
Reference in New Issue
Block a user