giles
e2a90e3bbd
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 15s
lib/host/blog.sx serves blog posts as HTML at GET /<slug>/ (the original strangler target, Quart blog post_detail). A post is a content-on-sx CtDoc rendered via content/html; anonymous + world-visible. In-memory slug->doc registry now (host/blog-lookup swappable for a persist-backed content stream later, handler/route unchanged). :slug catch-all mounted LAST so /feed, /health, /internal/* take precedence. Needs the Smalltalk+persist+content preload chain + (st-bootstrap-classes!)+(content/bootstrap!) — blog.sx self-bootstraps at load. serve.sh loads the chain + seeds a welcome post. Ledger gains the migrated blog post-detail (off-Quart 50% -> 53%). LIVE: blog.rose-ash.com/welcome/ renders real HTML through Cloudflare->Caddy; /feed still JSON (precedence verified), unknown slug 404. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
90 lines
5.7 KiB
Plaintext
90 lines
5.7 KiB
Plaintext
;; 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
|
|
;; relations container endpoints migrated onto lib/relations (reads get-children/
|
|
;; get-parents + writes attach-child/detach-child — see lib/host/relations.sx).
|
|
;; The TYPED relations actions (relate/unrelate/can-relate) stay proxied: they
|
|
;; carry registry + cardinality validation lib/relations does not implement. The
|
|
;; internal-only likes data+action endpoints stay proxied too — likes has no SX
|
|
;; subsystem to dispatch to.
|
|
(define host/ledger
|
|
(list
|
|
(host/ledger-entry "host" "GET" "/health" nil "native" "host/health-route")
|
|
(host/ledger-entry "blog" "GET" "/:slug" "blog:post_detail" "migrated" "host/blog-post")
|
|
(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" "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/attach-child" "relations:attach_child" "migrated" "host/relations-attach")
|
|
(host/ledger-entry "relations" "POST" "/internal/actions/detach-child" "relations:detach_child" "migrated" "host/relations-detach")
|
|
(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 "relations" "POST" "/internal/actions/can-relate" "relations:can_relate" "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))})))
|