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

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

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