From ef7de817bb45906f00284ea1910276881243aec7 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 19 Jun 2026 17:11:22 +0000 Subject: [PATCH] =?UTF-8?q?host:=20Phase=203=20=E2=80=94=20strangler=20mig?= =?UTF-8?q?ration=20ledger=20+=20coverage,=20107/107?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Opus 4.8 --- lib/host/conformance.sh | 2 + lib/host/ledger.sx | 82 ++++++++++++++++++++++++++++++++++++ lib/host/tests/ledger.sx | 89 ++++++++++++++++++++++++++++++++++++++++ plans/host-on-sx.md | 29 +++++++++++-- 4 files changed, 198 insertions(+), 4 deletions(-) create mode 100644 lib/host/ledger.sx create mode 100644 lib/host/tests/ledger.sx diff --git a/lib/host/conformance.sh b/lib/host/conformance.sh index a16d569a..ff94802d 100755 --- a/lib/host/conformance.sh +++ b/lib/host/conformance.sh @@ -59,6 +59,7 @@ MODULES=( "lib/host/sxtp.sx" "lib/host/router.sx" "lib/host/feed.sx" + "lib/host/ledger.sx" ) # Suites: NAME RUNNER-FN PATH @@ -68,6 +69,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" + "ledger host-lg-tests-run! lib/host/tests/ledger.sx" ) TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT diff --git a/lib/host/ledger.sx b/lib/host/ledger.sx new file mode 100644 index 00000000..445d9146 --- /dev/null +++ b/lib/host/ledger.sx @@ -0,0 +1,82 @@ +;; lib/host/ledger.sx — the strangler migration ledger. A catalogue of every +;; rose-ash HTTP endpoint with its Quart original and its current host status, so +;; the cut-over from Quart to the SX host is tracked endpoint-by-endpoint rather +;; than big-bang. Status is one of: +;; :native — born on the host, has no Quart original (e.g. /health probe) +;; :migrated — moved off Quart, now served by an SX handler +;; :proxied — still on Quart; the host forwards until cut over +;; Coverage (how far the strangler has progressed = how much is OFF Quart) is +;; computed from the catalogue. Pure data + queries — no IO, fully conformable. + +;; ── entry constructor ─────────────────────────────────────────────── +;; quart is a "service:handler" ref string (nil for :native endpoints); handler +;; is the SX handler name serving it (nil while still :proxied). +(define host/ledger-entry + (fn (domain method path quart status handler) + {:domain domain :method method :path path + :quart quart :status status :handler handler})) + +;; ── 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. +(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" "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) + (host/ledger-entry "likes" "GET" "/internal/data/liked-slugs" "likes:liked_slugs" "proxied" nil) + (host/ledger-entry "likes" "GET" "/internal/data/liked-ids" "likes:liked_ids" "proxied" nil) + (host/ledger-entry "likes" "POST" "/internal/actions/toggle" "likes:toggle" "proxied" nil))) + +;; ── status / domain queries ───────────────────────────────────────── +(define host/ledger-by-status + (fn (ledger status) (filter (fn (e) (= (get e :status) status)) ledger))) +(define host/ledger-migrated (fn (ledger) (host/ledger-by-status ledger "migrated"))) +(define host/ledger-proxied (fn (ledger) (host/ledger-by-status ledger "proxied"))) +(define host/ledger-native (fn (ledger) (host/ledger-by-status ledger "native"))) +(define host/ledger-by-domain + (fn (ledger domain) (filter (fn (e) (= (get e :domain) domain)) ledger))) + +;; An endpoint is OFF Quart (served by the host) iff native or migrated. +(define host/ledger-served? + (fn (e) (or (= (get e :status) "native") (= (get e :status) "migrated")))) + +;; First entry matching (method, path), or nil. +(define host/ledger-find + (fn (ledger method path) + (let ((hits (filter + (fn (e) (and (= (get e :method) method) (= (get e :path) path))) + ledger))) + (if (> (len hits) 0) (first hits) nil)))) + +;; Distinct domains in the catalogue (order: first-seen, reversed by cons). +(define host/ledger-domains + (fn (ledger) + (reduce + (fn (acc e) + (let ((d (get e :domain))) + (if (some (fn (x) (= x d)) acc) acc (cons d acc)))) + (list) + ledger))) + +;; ── coverage ──────────────────────────────────────────────────────── +;; served = off Quart (migrated + native); percent = served / total, floored. +(define host/ledger-coverage + (fn (ledger) + (let ((total (len ledger)) + (migrated (len (host/ledger-migrated ledger))) + (proxied (len (host/ledger-proxied ledger))) + (native (len (host/ledger-native ledger)))) + {:total total + :migrated migrated + :proxied proxied + :native native + :served (+ migrated native) + :percent (if (= total 0) 0 (quotient (* 100 (+ migrated native)) total))}))) diff --git a/lib/host/tests/ledger.sx b/lib/host/tests/ledger.sx new file mode 100644 index 00000000..8b1c0f0a --- /dev/null +++ b/lib/host/tests/ledger.sx @@ -0,0 +1,89 @@ +;; lib/host/tests/ledger.sx — the strangler migration ledger: entry shape, +;; status/domain queries, find, distinct domains, and coverage maths. + +(define host-lg-pass 0) +(define host-lg-fail 0) +(define host-lg-fails (list)) + +(define + host-lg-test + (fn + (name actual expected) + (if + (= actual expected) + (set! host-lg-pass (+ host-lg-pass 1)) + (begin + (set! host-lg-fail (+ host-lg-fail 1)) + (append! host-lg-fails {:name name :actual actual :expected expected}))))) + +;; ── entry constructor ─────────────────────────────────────────────── +(define host-lg-e (host/ledger-entry "feed" "GET" "/feed" "feed:timeline" "migrated" "host/feed-timeline")) +(host-lg-test "entry domain" (get host-lg-e :domain) "feed") +(host-lg-test "entry path" (get host-lg-e :path) "/feed") +(host-lg-test "entry status" (get host-lg-e :status) "migrated") +(host-lg-test "entry handler" (get host-lg-e :handler) "host/feed-timeline") + +;; ── find ──────────────────────────────────────────────────────────── +(host-lg-test + "find GET /feed -> migrated" + (get (host/ledger-find host/ledger "GET" "/feed") :status) + "migrated") +(host-lg-test + "find GET /feed -> handler" + (get (host/ledger-find host/ledger "GET" "/feed") :handler) + "host/feed-timeline") +(host-lg-test + "find POST /feed -> create" + (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) + +;; ── status queries ────────────────────────────────────────────────── +(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 2) +(host-lg-test "native count" (len (host/ledger-native host/ledger)) 1) +(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 8) + +;; ── served? predicate ─────────────────────────────────────────────── +(host-lg-test + "served? migrated" + (host/ledger-served? (host/ledger-find host/ledger "GET" "/feed")) + true) +(host-lg-test + "served? native" + (host/ledger-served? (host/ledger-find host/ledger "GET" "/health")) + true) +(host-lg-test + "served? proxied false" + (host/ledger-served? (host/ledger-find host/ledger "POST" "/internal/actions/relate")) + false) + +;; ── domain queries ────────────────────────────────────────────────── +(host-lg-test "relations domain count" (len (host/ledger-by-domain host/ledger "relations")) 4) +(host-lg-test "likes domain count" (len (host/ledger-by-domain host/ledger "likes")) 4) +(host-lg-test "domains count" (len (host/ledger-domains host/ledger)) 4) +(host-lg-test + "domains has relations" + (some (fn (d) (= d "relations")) (host/ledger-domains host/ledger)) + true) +(host-lg-test + "domains has feed" + (some (fn (d) (= d "feed")) (host/ledger-domains host/ledger)) + true) + +;; ── 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 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) + +(define + host-lg-tests-run! + (fn + () + {:total (+ host-lg-pass host-lg-fail) + :passed host-lg-pass + :failed host-lg-fail + :fails host-lg-fails})) diff --git a/plans/host-on-sx.md b/plans/host-on-sx.md index 83504b56..23ecf4a0 100644 --- a/plans/host-on-sx.md +++ b/plans/host-on-sx.md @@ -36,8 +36,9 @@ host — no `ocaml-on-sx` dependency. ## Status (rolling) -`bash lib/host/conformance.sh` → **82/82** (5 suites: handler, middleware, sxtp, -router, feed). Phases 1 & 2 DONE; Phase 3 (strangler ledger) next. +`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. ## Ground rules @@ -106,9 +107,16 @@ lib/host/sxtp.sx subsystem APIs (feed/search/commerce/… non-object body -> 400. Created activity is readable back via `GET /feed`. ## Phase 3 — Strangler migration ledger -- [ ] enumerate Quart endpoints; track migrated vs proxied +- [x] enumerate Quart endpoints; track migrated vs proxied — `ledger.sx`: a + catalogue of every endpoint (domain, method, path, Quart original, status + `:native`/`:migrated`/`:proxied`, SX handler) + queries (by-status/by-domain, + `host/ledger-find`, `host/ledger-served?`, distinct domains) and + `host/ledger-coverage` (off-Quart % = (migrated+native)/total). Seeded with + 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 (smallest: `likes` or `relations`) as proof +- [ ] cut over a whole domain (`relations` — it has a real SX subsystem + `lib/relations`; `likes` has none so it stays proxied) as proof ## Phase 4 — Dream framework layer (gated) - [ ] gate: `ocaml-on-sx` Phases 1–5 + minimal stdlib green @@ -154,6 +162,19 @@ lib/host/sxtp.sx subsystem APIs (feed/search/commerce/… and stand up a golden-response harness against the live Quart responses. Then cut over the smallest whole domain (`likes` or `relations`) as proof. +- **Phase 3 — ledger module (DONE, 107/107).** `lib/host/ledger.sx` + a 25-test + suite. Enumerated the endpoint surface via the `rose-ash-services` MCP + (`svc_routes`/`svc_queries`/`svc_actions`): `likes` and `relations` have **no + public blueprint routes** — they're internal-only, exposed as + `/internal/data/{query}` + `/internal/actions/{action}` (HMAC-signed). The + ledger is a pure-data catalogue keyed by (domain, method, path) carrying each + endpoint's Quart original, status, and serving SX handler; coverage reports the + off-Quart percentage. Cut-over target chosen: **`relations`** (already has a real + SX subsystem `lib/relations` — children/parents reads + relate/unrelate writes + map straight onto its public API); `likes` stays proxied (no SX lib to dispatch + to). NEXT: migrate the `relations` read endpoints onto host handlers (flip their + ledger status to `:migrated`) with golden tests. + ## Blockers - **Live wiring to the native OCaml HTTP server** (Phase 3/4): the prod server in