host: Phase 3 — strangler migration ledger + coverage, 107/107

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

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

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

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

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