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

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:
2026-06-19 17:24:37 +00:00
parent ef7de817bb
commit 11aba081f4
6 changed files with 219 additions and 16 deletions

View File

@@ -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
View 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}))