host: Phase 3 — relations READ cut-over (get-children/get-parents), 121/121
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
Migrate the two internal relations read queries onto lib/relations: GET /internal/data/get-children + /get-parents dispatch to relations/children and relations/parents. Bridge the Quart (type,id) node key to a graph atom symbol "type:id" with relation-type as the edge kind; optional child/parent -type params filter by "type:" prefix. Golden tests pin each endpoint to subsystem-call + envelope. Ledger entries flipped to :migrated (off-Quart coverage 27% -> 45%). Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -46,6 +46,12 @@ MODULES=(
|
||||
"lib/acl/audit.sx"
|
||||
"lib/acl/federation.sx"
|
||||
"lib/acl/api.sx"
|
||||
"lib/relations/schema.sx"
|
||||
"lib/relations/engine.sx"
|
||||
"lib/relations/api.sx"
|
||||
"lib/relations/explain.sx"
|
||||
"lib/relations/federation.sx"
|
||||
"lib/relations/tree.sx"
|
||||
"lib/feed/normalize.sx"
|
||||
"lib/feed/stream.sx"
|
||||
"lib/feed/api.sx"
|
||||
@@ -59,6 +65,7 @@ MODULES=(
|
||||
"lib/host/sxtp.sx"
|
||||
"lib/host/router.sx"
|
||||
"lib/host/feed.sx"
|
||||
"lib/host/relations.sx"
|
||||
"lib/host/ledger.sx"
|
||||
)
|
||||
|
||||
@@ -69,6 +76,7 @@ SUITES=(
|
||||
"sxtp host-sx-tests-run! lib/host/tests/sxtp.sx"
|
||||
"router host-rt-tests-run! lib/host/tests/router.sx"
|
||||
"feed host-fd-tests-run! lib/host/tests/feed.sx"
|
||||
"relations host-rl-tests-run! lib/host/tests/relations.sx"
|
||||
"ledger host-lg-tests-run! lib/host/tests/ledger.sx"
|
||||
)
|
||||
|
||||
|
||||
@@ -18,16 +18,16 @@
|
||||
|
||||
;; ── the catalogue ───────────────────────────────────────────────────
|
||||
;; Reflects the live host: feed reads+writes migrated, /health native, the
|
||||
;; internal-only likes/relations data+action endpoints still proxied to Quart.
|
||||
;; relations is the next cut-over candidate — it already has a real SX subsystem
|
||||
;; (lib/relations); likes has none, so it stays proxied until one exists.
|
||||
;; relations READ endpoints migrated onto lib/relations (see lib/host/relations.sx),
|
||||
;; relations writes + the internal-only likes data+action endpoints still proxied
|
||||
;; to Quart. likes has no SX subsystem, so it stays proxied until one exists.
|
||||
(define host/ledger
|
||||
(list
|
||||
(host/ledger-entry "host" "GET" "/health" nil "native" "host/health-route")
|
||||
(host/ledger-entry "feed" "GET" "/feed" "feed:timeline" "migrated" "host/feed-timeline")
|
||||
(host/ledger-entry "feed" "POST" "/feed" "feed:create" "migrated" "host/feed-create")
|
||||
(host/ledger-entry "relations" "GET" "/internal/data/get-children" "relations:get_children" "proxied" nil)
|
||||
(host/ledger-entry "relations" "GET" "/internal/data/get-parents" "relations:get_parents" "proxied" nil)
|
||||
(host/ledger-entry "relations" "GET" "/internal/data/get-children" "relations:get_children" "migrated" "host/relations-children")
|
||||
(host/ledger-entry "relations" "GET" "/internal/data/get-parents" "relations:get_parents" "migrated" "host/relations-parents")
|
||||
(host/ledger-entry "relations" "POST" "/internal/actions/relate" "relations:relate" "proxied" nil)
|
||||
(host/ledger-entry "relations" "POST" "/internal/actions/unrelate" "relations:unrelate" "proxied" nil)
|
||||
(host/ledger-entry "likes" "GET" "/internal/data/is-liked" "likes:is_liked" "proxied" nil)
|
||||
|
||||
58
lib/host/relations.sx
Normal file
58
lib/host/relations.sx
Normal file
@@ -0,0 +1,58 @@
|
||||
;; lib/host/relations.sx — Relations domain endpoints on the host. The relations
|
||||
;; service is internal-only (no public routes): Quart exposes it as signed
|
||||
;; /internal/data/{query} reads + /internal/actions/{action} writes. This migrates
|
||||
;; the two READ queries — get-children, get-parents — straight onto the SX host,
|
||||
;; dispatching to the lib/relations subsystem (a saturating Datalog graph).
|
||||
;;
|
||||
;; Node model: the Quart relations API keys nodes by a (type, id) pair; the graph
|
||||
;; subsystem keys them by an opaque atom. We bridge by composing the atom as the
|
||||
;; symbol "type:id", with the relation-type as the edge kind. Optional child-type
|
||||
;; / parent-type params filter the result by that "type:" prefix — matching the
|
||||
;; Quart queries' optional type narrowing.
|
||||
;; Depends on lib/relations/* + lib/host/handler.sx + lib/dream/* (query params).
|
||||
|
||||
;; ── node helpers ────────────────────────────────────────────────────
|
||||
(define host/-rel-node
|
||||
(fn (type id) (string->symbol (str type ":" id))))
|
||||
(define host/-rel-node-type?
|
||||
(fn (node type) (starts-with? (symbol->string node) (str type ":"))))
|
||||
(define host/-rel-strings
|
||||
(fn (nodes) (map (fn (n) (symbol->string n)) nodes)))
|
||||
|
||||
;; ── GET /internal/data/get-children ─────────────────────────────────
|
||||
;; query: parent-type, parent-id, relation-type (required); child-type (optional
|
||||
;; filter). Returns the child node ids ("type:id") for the parent under that kind.
|
||||
(define host/relations-children
|
||||
(fn (req)
|
||||
(let ((ptype (dream-query-param req "parent-type"))
|
||||
(pid (dream-query-param req "parent-id"))
|
||||
(kind (dream-query-param req "relation-type")))
|
||||
(if (and ptype pid kind)
|
||||
(let ((kids (relations/children (host/-rel-node ptype pid) (string->symbol kind)))
|
||||
(ctype (dream-query-param req "child-type")))
|
||||
(let ((sel (if ctype (filter (fn (k) (host/-rel-node-type? k ctype)) kids) kids)))
|
||||
(host/ok (host/-rel-strings sel))))
|
||||
(host/error 400 "missing parameter")))))
|
||||
|
||||
;; ── GET /internal/data/get-parents ──────────────────────────────────
|
||||
;; query: child-type, child-id, relation-type (required); parent-type (optional
|
||||
;; filter). Returns the parent node ids ("type:id") for the child under that kind.
|
||||
(define host/relations-parents
|
||||
(fn (req)
|
||||
(let ((ctype (dream-query-param req "child-type"))
|
||||
(cid (dream-query-param req "child-id"))
|
||||
(kind (dream-query-param req "relation-type")))
|
||||
(if (and ctype cid kind)
|
||||
(let ((ps (relations/parents (host/-rel-node ctype cid) (string->symbol kind)))
|
||||
(ptype (dream-query-param req "parent-type")))
|
||||
(let ((sel (if ptype (filter (fn (p) (host/-rel-node-type? p ptype)) ps) ps)))
|
||||
(host/ok (host/-rel-strings sel))))
|
||||
(host/error 400 "missing parameter")))))
|
||||
|
||||
;; ── read route group ────────────────────────────────────────────────
|
||||
;; Internal data reads (the signed-internal-auth gate is a separate middleware
|
||||
;; concern, like the feed reads); these dispatch straight to the subsystem.
|
||||
(define host/relations-routes
|
||||
(list
|
||||
(dream-get "/internal/data/get-children" host/relations-children)
|
||||
(dream-get "/internal/data/get-parents" host/relations-parents)))
|
||||
@@ -37,11 +37,15 @@
|
||||
(get (host/ledger-find host/ledger "POST" "/feed") :handler)
|
||||
"host/feed-create")
|
||||
(host-lg-test "find missing -> nil" (host/ledger-find host/ledger "GET" "/nope") nil)
|
||||
(host-lg-test
|
||||
"find migrated relations read -> handler"
|
||||
(get (host/ledger-find host/ledger "GET" "/internal/data/get-children") :handler)
|
||||
"host/relations-children")
|
||||
|
||||
;; ── status queries ──────────────────────────────────────────────────
|
||||
(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 2)
|
||||
(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 4)
|
||||
(host-lg-test "native count" (len (host/ledger-native host/ledger)) 1)
|
||||
(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 8)
|
||||
(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 6)
|
||||
|
||||
;; ── served? predicate ───────────────────────────────────────────────
|
||||
(host-lg-test
|
||||
@@ -73,11 +77,11 @@
|
||||
;; ── coverage ────────────────────────────────────────────────────────
|
||||
(define host-lg-cov (host/ledger-coverage host/ledger))
|
||||
(host-lg-test "coverage total" (get host-lg-cov :total) 11)
|
||||
(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 2)
|
||||
(host-lg-test "coverage proxied" (get host-lg-cov :proxied) 8)
|
||||
(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 4)
|
||||
(host-lg-test "coverage proxied" (get host-lg-cov :proxied) 6)
|
||||
(host-lg-test "coverage native" (get host-lg-cov :native) 1)
|
||||
(host-lg-test "coverage served" (get host-lg-cov :served) 3)
|
||||
(host-lg-test "coverage percent" (get host-lg-cov :percent) 27)
|
||||
(host-lg-test "coverage served" (get host-lg-cov :served) 5)
|
||||
(host-lg-test "coverage percent" (get host-lg-cov :percent) 45)
|
||||
|
||||
(define
|
||||
host-lg-tests-run!
|
||||
|
||||
112
lib/host/tests/relations.sx
Normal file
112
lib/host/tests/relations.sx
Normal file
@@ -0,0 +1,112 @@
|
||||
;; lib/host/tests/relations.sx — the migrated relations read endpoints,
|
||||
;; GET /internal/data/get-children and /get-parents, dispatching to lib/relations.
|
||||
;; Golden tests pin each endpoint to "subsystem call + standard envelope": the
|
||||
;; host adds the HTTP/JSON shell over relations/children|parents and nothing else
|
||||
;; (golden derived from the same subsystem call, so result order matches).
|
||||
|
||||
(define host-rl-pass 0)
|
||||
(define host-rl-fail 0)
|
||||
(define host-rl-fails (list))
|
||||
|
||||
(define
|
||||
host-rl-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! host-rl-pass (+ host-rl-pass 1))
|
||||
(begin
|
||||
(set! host-rl-fail (+ host-rl-fail 1))
|
||||
(append! host-rl-fails {:name name :actual actual :expected expected})))))
|
||||
|
||||
(define host-rl-req (fn (target) (dream-request "GET" target {} "")))
|
||||
(define host-rl-app (host/make-app (list host/relations-routes)))
|
||||
(define host-rl-sym (fn (s) (string->symbol s)))
|
||||
|
||||
;; ── seed a known graph ──────────────────────────────────────────────
|
||||
;; org:1 --member--> list:7, list:8 ; org:1 --owner--> page:9
|
||||
(relations/load! (list))
|
||||
(relations/relate (host-rl-sym "org:1") (host-rl-sym "list:7") (host-rl-sym "member"))
|
||||
(relations/relate (host-rl-sym "org:1") (host-rl-sym "list:8") (host-rl-sym "member"))
|
||||
(relations/relate (host-rl-sym "org:1") (host-rl-sym "page:9") (host-rl-sym "owner"))
|
||||
|
||||
;; ── get-children ────────────────────────────────────────────────────
|
||||
(define host-rl-kids
|
||||
"/internal/data/get-children?parent-type=org&parent-id=1&relation-type=member")
|
||||
(host-rl-test "children 200" (dream-status (host-rl-app (host-rl-req host-rl-kids))) 200)
|
||||
(host-rl-test
|
||||
"children has list:7"
|
||||
(contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "list:7")
|
||||
true)
|
||||
(host-rl-test
|
||||
"children has list:8"
|
||||
(contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "list:8")
|
||||
true)
|
||||
(host-rl-test
|
||||
"children excludes other-kind page:9"
|
||||
(contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "page:9")
|
||||
false)
|
||||
(host-rl-test
|
||||
"children count via subsystem"
|
||||
(len (relations/children (host-rl-sym "org:1") (host-rl-sym "member")))
|
||||
2)
|
||||
|
||||
;; child-type filter narrows by node prefix.
|
||||
(host-rl-test
|
||||
"children child-type=list keeps both"
|
||||
(contains?
|
||||
(dream-resp-body (host-rl-app (host-rl-req (str host-rl-kids "&child-type=list"))))
|
||||
"list:8")
|
||||
true)
|
||||
(host-rl-test
|
||||
"children child-type=page filters all out"
|
||||
(contains?
|
||||
(dream-resp-body (host-rl-app (host-rl-req (str host-rl-kids "&child-type=page"))))
|
||||
"list:7")
|
||||
false)
|
||||
|
||||
;; ── get-parents ─────────────────────────────────────────────────────
|
||||
(define host-rl-par
|
||||
"/internal/data/get-parents?child-type=list&child-id=7&relation-type=member")
|
||||
(host-rl-test "parents 200" (dream-status (host-rl-app (host-rl-req host-rl-par))) 200)
|
||||
(host-rl-test
|
||||
"parents has org:1"
|
||||
(contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-par))) "org:1")
|
||||
true)
|
||||
|
||||
;; ── missing required params -> 400 ──────────────────────────────────
|
||||
(host-rl-test
|
||||
"children missing param -> 400"
|
||||
(dream-status (host-rl-app (host-rl-req "/internal/data/get-children?parent-type=org")))
|
||||
400)
|
||||
(host-rl-test
|
||||
"parents missing param -> 400"
|
||||
(dream-status (host-rl-app (host-rl-req "/internal/data/get-parents?child-type=list")))
|
||||
400)
|
||||
|
||||
;; ── golden: endpoint = subsystem call + envelope ────────────────────
|
||||
(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"))))
|
||||
"}"))
|
||||
(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"))))
|
||||
"}"))
|
||||
|
||||
(define
|
||||
host-rl-tests-run!
|
||||
(fn
|
||||
()
|
||||
{:total (+ host-rl-pass host-rl-fail)
|
||||
:passed host-rl-pass
|
||||
:failed host-rl-fail
|
||||
:fails host-rl-fails}))
|
||||
@@ -36,9 +36,10 @@ host — no `ocaml-on-sx` dependency.
|
||||
|
||||
## Status (rolling)
|
||||
|
||||
`bash lib/host/conformance.sh` → **107/107** (6 suites: handler, middleware, sxtp,
|
||||
router, feed, ledger). Phases 1 & 2 DONE; Phase 3 (strangler ledger) underway —
|
||||
ledger module landed; `relations` cut-over next.
|
||||
`bash lib/host/conformance.sh` → **121/121** (7 suites: handler, middleware, sxtp,
|
||||
router, feed, relations, ledger). Phases 1 & 2 DONE; Phase 3 (strangler ledger)
|
||||
underway — ledger module + `relations` READ cut-over landed (45% off Quart);
|
||||
relations writes + golden harness next.
|
||||
|
||||
## Ground rules
|
||||
|
||||
@@ -115,8 +116,13 @@ lib/host/sxtp.sx subsystem APIs (feed/search/commerce/…
|
||||
the live state: feed reads+writes migrated, `/health` native, the
|
||||
internal-only `relations`/`likes` data+action endpoints proxied.
|
||||
- [ ] golden-response harness vs the live Quart responses
|
||||
- [ ] cut over a whole domain (`relations` — it has a real SX subsystem
|
||||
`lib/relations`; `likes` has none so it stays proxied) as proof
|
||||
- [~] cut over a whole domain (`relations`) as proof — READ side DONE
|
||||
(`lib/host/relations.sx`): `GET /internal/data/get-children` + `/get-parents`
|
||||
dispatch to `lib/relations` (`relations/children`/`parents`). Node model:
|
||||
graph atom = symbol `"type:id"`, edge = relation-type; optional child/parent
|
||||
`-type` param filters by `"type:"` prefix. Golden tests pin each endpoint to
|
||||
`subsystem-call + envelope`. Ledger entries flipped to `:migrated`. WRITE side
|
||||
(`relate`/`unrelate` actions, behind auth+ACL like POST /feed) next.
|
||||
|
||||
## Phase 4 — Dream framework layer (gated)
|
||||
- [ ] gate: `ocaml-on-sx` Phases 1–5 + minimal stdlib green
|
||||
@@ -175,6 +181,21 @@ lib/host/sxtp.sx subsystem APIs (feed/search/commerce/…
|
||||
to). NEXT: migrate the `relations` read endpoints onto host handlers (flip their
|
||||
ledger status to `:migrated`) with golden tests.
|
||||
|
||||
- **Phase 3 — relations READ cut-over (DONE, 121/121).** `lib/host/relations.sx`
|
||||
+ a 13-test golden suite; ledger flipped (off-Quart coverage 27% → 45%). The two
|
||||
internal read queries (`get-children`, `get-parents`) now dispatch to the
|
||||
`lib/relations` Datalog graph. Bridge: the Quart `(type, id)` node key maps to a
|
||||
graph atom `(string->symbol "type:id")` with relation-type as the edge kind;
|
||||
optional `child-type`/`parent-type` params filter the result list by `"type:"`
|
||||
prefix (verified live: composite-string nodes round-trip through
|
||||
`relations/relate` → `relations/children`). Golden discipline: `relations` is
|
||||
internal-only (no public Quart route — confirmed via `svc_routes`), so the golden
|
||||
is a **pinned fixture** (a known graph loaded in-test, asserted as
|
||||
`subsystem-call + envelope`) rather than a live Quart capture. Reads are
|
||||
unguarded for now — the signed-internal-auth gate is a separate middleware layer,
|
||||
same as the feed reads. NEXT: relations WRITE actions (`relate`/`unrelate`)
|
||||
behind the auth+ACL pipeline (mirroring POST /feed).
|
||||
|
||||
## Blockers
|
||||
|
||||
- **Live wiring to the native OCaml HTTP server** (Phase 3/4): the prod server in
|
||||
|
||||
Reference in New Issue
Block a user