host: content-addressed SPA cache + declarative SX-htmx relate picker + SIGPIPE hardening
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
Three composing pieces that make the blog SPA correct and resilient.
Content-addressed module cache (lib/host/static.sx, serve.sh, blog.sx shell,
conformance.sh): index each web-stack .sxbc by the content hash in its head,
serve GET /sx/h/{hash} immutable text/sx, and emit <script data-sx-manifest>
{file->hash} so the WASM client loads modules content-addressed (localStorage +
immutable) instead of path + max-age. serve.sh builds the index at boot;
conformance.sh now loads static.sx before blog.sx (the shell calls
host/static-manifest-json).
Declarative relate picker (lib/host/blog.sx, lib/dream/form.sx): replace the
inline /relate-picker.js blob — which never ran on swapped-in content, so the
candidate list was empty after a boosted nav to /<slug>/edit — with a declarative
SX-htmx form: sx-get relate-options on "load" + debounced "input", innerHTML-swap
the results ul; infinite scroll via a server-emitted "load more" sentinel
(sx-trigger revealed, sx-swap outerHTML) that pages the rest, q preserved via a
new symmetric dr/url-encode. The engine re-binds these triggers on swapped
content, so the picker populates on full load AND boosted SPA nav. Candidate
relate forms get :sx-disable (plain POST->303->reload, their original behavior;
the engine would otherwise boost them and swap the redirect unreliably).
sx-retry "exponential:1000:30000" on the form+sentinel retries a dropped/offline
fetch forever (the cap bounds the interval, not the attempts).
SIGPIPE hardening (hosts/ocaml/bin/sx_server.ml): the native http-listen server
had no SIGPIPE handler, so a client aborting an in-flight fetch (the engine
cancels superseded requests on a debounced filter/fast nav) closed the socket
mid-write and killed the whole process (exit 141). Ignore SIGPIPE so the failed
write becomes a catchable Sys_error the per-connection handler already swallows.
Tests: host conformance 272/272; relate-picker.spec.js 5/5 incl. a boosted-nav
populate regression; spa-check 4/4.
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -58,6 +58,43 @@
|
||||
((s2 (replace s "+" " ")))
|
||||
(dr/url-decode-loop s2 0 (string-length s2) ""))))
|
||||
|
||||
;; ── percent encoding (symmetric with dr/url-decode) ────────────────
|
||||
;; RFC3986 unreserved set passes through; everything else is %XX (uppercase
|
||||
;; hex). Space becomes %20 (not +), so the result is safe in a query value.
|
||||
(define dr/hex-chars "0123456789ABCDEF")
|
||||
(define
|
||||
dr/url-encode-char
|
||||
(fn
|
||||
(c)
|
||||
(let
|
||||
((n (char-code c)))
|
||||
(if
|
||||
(or
|
||||
(and (>= n 48) (<= n 57)) ;; 0-9
|
||||
(and (>= n 65) (<= n 90)) ;; A-Z
|
||||
(and (>= n 97) (<= n 122)) ;; a-z
|
||||
(= c "-") (= c "_") (= c ".") (= c "~"))
|
||||
c
|
||||
(str "%"
|
||||
(char-at dr/hex-chars (quotient n 16))
|
||||
(char-at dr/hex-chars (mod n 16)))))))
|
||||
|
||||
(define
|
||||
dr/url-encode-loop
|
||||
(fn
|
||||
(s i n acc)
|
||||
(if
|
||||
(>= i n)
|
||||
acc
|
||||
(dr/url-encode-loop s (+ i 1) n
|
||||
(str acc (dr/url-encode-char (char-at s i)))))))
|
||||
|
||||
(define
|
||||
dr/url-encode
|
||||
(fn
|
||||
(s)
|
||||
(dr/url-encode-loop (or s "") 0 (string-length (or s "")) "")))
|
||||
|
||||
;; ── substring splitter (split primitive is char-class based) ───────
|
||||
(define
|
||||
dr/split-on
|
||||
|
||||
@@ -363,7 +363,11 @@
|
||||
(fn (slug p kind)
|
||||
(quasiquote
|
||||
(li :style "border-bottom:1px solid #eee"
|
||||
(form :method "post" :style "margin:0"
|
||||
;; sx-disable: this relate form is a plain POST -> 303 -> full reload (the
|
||||
;; engine swaps the picker rows in, which would otherwise boost this form;
|
||||
;; a boosted POST+redirect into #content swaps unreliably). A relate is a
|
||||
;; deliberate action, so a clean reload that re-renders the editor is right.
|
||||
(form :method "post" :style "margin:0" :sx-disable "true"
|
||||
:action (unquote (str "/" slug "/relate"))
|
||||
(input :type "hidden" :name "other" :value (unquote (get p :slug)))
|
||||
(input :type "hidden" :name "kind" :value (unquote kind))
|
||||
@@ -371,9 +375,29 @@
|
||||
:style "width:100%;text-align:left;background:none;border:none;padding:0.5em;cursor:pointer"
|
||||
(unquote (get p :title))))))))
|
||||
|
||||
;; The infinite-scroll "load more" sentinel: an <li> that, when scrolled into view
|
||||
;; (sx-trigger "revealed"), GETs the NEXT page and replaces ITSELF (sx-swap
|
||||
;; outerHTML, default self-target) with those rows + the next sentinel. This is the
|
||||
;; SX-htmx engine doing the paging — no client JS. q is %-encoded back into the URL
|
||||
;; so the filter is preserved across pages.
|
||||
(define host/blog--picker-more
|
||||
(fn (slug kind q next)
|
||||
(quasiquote
|
||||
(li :class "rp-more"
|
||||
:style "list-style:none;padding:0.5em;text-align:center;opacity:0.6"
|
||||
:sx-get (unquote (str "/" slug "/relate-options?kind=" kind
|
||||
"&q=" (dr/url-encode q) "&offset=" next))
|
||||
:sx-trigger "revealed"
|
||||
:sx-swap "outerHTML"
|
||||
;; a dropped/offline page-fetch retries with exponential backoff (1s→30s)
|
||||
;; until it succeeds, so a flaky connection self-heals as you scroll.
|
||||
:sx-retry "exponential:1000:30000"
|
||||
"Loading more…"))))
|
||||
|
||||
;; GET /<slug>/relate-options?kind=&q=&offset= — one page of candidate rows for a
|
||||
;; kind as an HTML fragment (the <li>s the picker script appends). Public read; the
|
||||
;; relate action stays guarded.
|
||||
;; kind as an HTML fragment, swapped into the picker by the SX-htmx engine. A full
|
||||
;; page is followed by a "load more" sentinel (above); the last page is not. Public
|
||||
;; read; the relate action stays guarded.
|
||||
(define host/blog-relate-options
|
||||
(fn (req)
|
||||
(let ((slug (dream-param req "slug"))
|
||||
@@ -384,20 +408,12 @@
|
||||
(offset (host/query-int req "offset" 0)))
|
||||
(let ((page (take (drop (host/blog--relate-candidates slug q kind) offset)
|
||||
host/blog--picker-limit)))
|
||||
(dream-html
|
||||
(join "" (map (fn (p) (render-page (host/blog--picker-item slug p kind))) page)))))))
|
||||
(let ((rows (join "" (map (fn (p) (render-page (host/blog--picker-item slug p kind))) page)))
|
||||
(more (if (= (len page) host/blog--picker-limit)
|
||||
(render-page (host/blog--picker-more slug kind q (+ offset host/blog--picker-limit)))
|
||||
"")))
|
||||
(dream-html (str rows more)))))))
|
||||
|
||||
;; GET /relate-picker.js — progressive-enhancement glue. MULTI-INSTANCE: wires
|
||||
;; every .relate-picker box on the page (a Related picker + a Tags picker can
|
||||
;; coexist), reading data-slug + data-kind from each. Debounced live filter +
|
||||
;; scroll-to-load-more against /<slug>/relate-options. The host serves static HTML
|
||||
;; (no SX hydration), so the interactive layer is this small cached script.
|
||||
(define host/blog-picker-js-src
|
||||
"(function(){function wire(box){var f=box.querySelector('.rp-filter');if(!f)return;var r=box.querySelector('.rp-results');var slug=box.getAttribute('data-slug'),kind=box.getAttribute('data-kind')||'related',off=0,q='',busy=false,done=false,pending=false,t;function load(reset){if(busy){if(reset)pending=true;return;}if(!reset&&done)return;busy=true;if(reset){off=0;done=false;}fetch('/'+slug+'/relate-options?kind='+encodeURIComponent(kind)+'&q='+encodeURIComponent(q)+'&offset='+off).then(function(x){return x.text();}).then(function(h){var d=document.createElement('div');d.innerHTML=h;var n=d.children.length;if(reset)r.innerHTML='';while(d.firstChild)r.appendChild(d.firstChild);off+=n;done=n<20;busy=false;if(pending){pending=false;load(true);}}).catch(function(){busy=false;if(pending){pending=false;load(true);}});}f.addEventListener('input',function(){clearTimeout(t);t=setTimeout(function(){q=f.value.trim();load(true);},200);});r.addEventListener('scroll',function(){if(r.scrollTop+r.clientHeight>=r.scrollHeight-40){load(false);}});load(true);}var boxes=document.querySelectorAll('.relate-picker');for(var i=0;i<boxes.length;i++){wire(boxes[i]);}})();")
|
||||
(define host/blog-picker-js
|
||||
(fn (req)
|
||||
(dream-response 200 {:content-type "application/javascript; charset=utf-8"}
|
||||
host/blog-picker-js-src)))
|
||||
|
||||
;; ── page shell ──────────────────────────────────────────────────────
|
||||
;; A page is an SX element tree, rendered via render-page (5.1). The handler
|
||||
@@ -427,6 +443,12 @@
|
||||
(quasiquote
|
||||
(html
|
||||
(head (meta :charset "utf-8") (title (unquote title))
|
||||
;; content-addressed module manifest: {file -> hash}. The client's
|
||||
;; loadBytecodeFile reads this and fetches each web-stack module
|
||||
;; immutably from /sx/h/{hash} (localStorage-cached, never stale)
|
||||
;; instead of /static/wasm/sx/*.sxbc with max-age.
|
||||
(script :type "application/json" :data-sx-manifest "1"
|
||||
(raw! (unquote (host/static-manifest-json))))
|
||||
(script :src "/static/wasm/sx_browser.bc.wasm.js")
|
||||
(script :src "/static/wasm/sx-platform.js"))
|
||||
(body
|
||||
@@ -536,9 +558,9 @@
|
||||
(else "")))))
|
||||
|
||||
;; Kind-aware relation editor for the edit page: current links (each with a
|
||||
;; kind-scoped remove), plus a filterable picker (a .relate-picker box the shared
|
||||
;; /relate-picker.js wires by data-kind). The picker's candidates come from the
|
||||
;; kind's registry :candidates ("all" / tags / types). One editor per kind.
|
||||
;; kind-scoped remove), plus a filterable picker (a declarative SX-htmx form, one
|
||||
;; per kind). The picker's candidates come from the kind's registry :candidates
|
||||
;; ("all" / tags / types).
|
||||
(define host/blog--relation-editor
|
||||
(fn (slug kind)
|
||||
;; current edges read up front (a perform) — NOT inside the quasiquote, where
|
||||
@@ -561,11 +583,25 @@
|
||||
(button :type "submit" "remove")))))
|
||||
current))
|
||||
(quote (p :style "opacity:0.7" "None yet."))))
|
||||
(div :class "relate-picker" :data-slug (unquote slug) :data-kind (unquote kind)
|
||||
(input :type "text" :class "rp-filter" :placeholder "filter…" :autocomplete "off"
|
||||
;; Declarative SX-htmx picker (no client JS). The form GETs relate-options
|
||||
;; serialising its inputs (kind + the filter q) into the query: on initial
|
||||
;; "load" and on a debounced "input" it innerHTML-swaps the results ul.
|
||||
;; Paging is driven by the "load more" sentinel each page carries. The
|
||||
;; SX engine re-binds these triggers on swapped-in content, so the picker
|
||||
;; works whether the edit page is a full load or a boosted SPA nav.
|
||||
(form :class "relate-picker" :data-slug (unquote slug) :data-kind (unquote kind)
|
||||
:sx-get (unquote (str "/" slug "/relate-options"))
|
||||
:sx-trigger "input delay:200ms, load"
|
||||
:sx-target (unquote (str "#rp-" kind "-results"))
|
||||
:sx-swap "innerHTML"
|
||||
;; a failed initial/filter fetch retries with backoff (1s→30s)
|
||||
:sx-retry "exponential:1000:30000"
|
||||
:style "margin:0"
|
||||
(input :type "hidden" :name "kind" :value (unquote kind))
|
||||
(input :type "text" :name "q" :class "rp-filter" :placeholder "filter…" :autocomplete "off"
|
||||
:style "width:100%;padding:0.4em;box-sizing:border-box")
|
||||
(ul :class "rp-results"
|
||||
:style "list-style:none;padding:0;margin:0.5em 0;max-height:240px;overflow:auto;border:1px solid #ddd")))))))
|
||||
(ul :id (unquote (str "rp-" kind "-results")) :class "rp-results"
|
||||
:style "list-style:none;padding:0;margin:0.5em 0;border:1px solid #ddd")))))))
|
||||
|
||||
;; "Is this post a tag?" toggle — marking a post a tag is just an is-a edge to the
|
||||
;; "tag" type-post, so it reuses the relate/unrelate routes (no new endpoint).
|
||||
@@ -889,8 +925,6 @@
|
||||
(div :style "margin-top:2em;border-top:1px solid #ccc;padding-top:1em"
|
||||
(unquote tag-toggle))
|
||||
(unquote relation-editors)
|
||||
;; one shared picker script wires every .relate-picker box
|
||||
(raw! "<script src=\"/relate-picker.js\"></script>")
|
||||
(p :style "margin-top:1.5em"
|
||||
(a :href (unquote (str "/" slug "/")) "view post")
|
||||
" · "
|
||||
@@ -935,7 +969,6 @@
|
||||
(dream-get "/posts" host/blog-index)
|
||||
(dream-get "/new" host/blog-new-form)
|
||||
(dream-get "/tags" host/blog-tags-index)
|
||||
(dream-get "/relate-picker.js" host/blog-picker-js)
|
||||
(dream-get "/:slug/source" host/blog-source)
|
||||
(dream-get "/:slug/relate-options" host/blog-relate-options)
|
||||
(dream-get "/:slug" host/blog-post)))
|
||||
|
||||
@@ -76,6 +76,7 @@ MODULES=(
|
||||
"lib/host/auth.sx"
|
||||
"lib/host/sxtp.sx"
|
||||
"lib/host/router.sx"
|
||||
"lib/host/static.sx"
|
||||
"lib/host/feed.sx"
|
||||
"lib/host/relations.sx"
|
||||
"lib/host/blog.sx"
|
||||
|
||||
@@ -1,20 +1,32 @@
|
||||
// Browser check for the relate picker (lib/host/blog.sx). Runs against an
|
||||
// ephemeral host server seeded with a host post + 25 candidates by
|
||||
// run-picker-check.sh, which copies this spec into the Playwright env and sets
|
||||
// SX_TEST_URL. Exercises the login redirect, the JS-driven candidate load,
|
||||
// debounced filter, infinite scroll, and click-to-relate.
|
||||
// SX_TEST_URL. The picker is a DECLARATIVE SX-htmx form (no client JS): the form
|
||||
// GETs /<slug>/relate-options on "load" and on a debounced "input", swapping the
|
||||
// results <ul>; a full page carries a "load more" sentinel that pages on reveal.
|
||||
// Exercises the login redirect, the initial populate, debounced filter, infinite
|
||||
// scroll, click-to-relate, AND populate after a boosted SPA nav (the case the old
|
||||
// inline <script> picker silently failed — a script never runs on swapped content).
|
||||
const { test, expect } = require('playwright/test');
|
||||
|
||||
const USER = process.env.SX_ADMIN_USER || 'admin';
|
||||
const PASS = process.env.SX_ADMIN_PASSWORD || 'letmein';
|
||||
const HOST = 'picker-host'; // the post whose edit page we drive
|
||||
const LIMIT = 20; // host/blog--picker-limit
|
||||
const LIMIT = 20; // host/blog--picker-limit (one page)
|
||||
// the Related picker box (the edit page now has one picker per kind)
|
||||
const REL = '.relate-picker[data-kind="related"]';
|
||||
const RELF = `${REL} .rp-filter`;
|
||||
const RELR = `${REL} .rp-results`;
|
||||
const RELROWS = `${RELR} li:not(.rp-more)`; // candidate rows (exclude the sentinel)
|
||||
const MORE = `${RELR} .rp-more`; // the load-more sentinel
|
||||
|
||||
// Navigate to a guarded path; the host redirects to /login?next=…, so fill the
|
||||
// boot-init marks <html data-sx-ready="true"> once the WASM kernel + web stack
|
||||
// load. WASM compile + asset fetches, so allow generous time.
|
||||
async function waitReady(page) {
|
||||
await expect(page.locator('html[data-sx-ready="true"]')).toHaveCount(1, { timeout: 45000 });
|
||||
}
|
||||
|
||||
// Navigate to a GUARDED path; the host redirects to /login?next=…, so fill the
|
||||
// form and we should land back on the original path (exercises the auth flow).
|
||||
async function loginTo(page, path) {
|
||||
await page.goto(path);
|
||||
@@ -25,6 +37,15 @@ async function loginTo(page, path) {
|
||||
await page.waitForURL((u) => !u.pathname.startsWith('/login'));
|
||||
}
|
||||
|
||||
// Log in directly (for reaching PUBLIC pages while authenticated).
|
||||
async function login(page) {
|
||||
await page.goto('/login');
|
||||
await page.fill('input[name="username"]', USER);
|
||||
await page.fill('input[name="password"]', PASS);
|
||||
await page.click('button[type="submit"]');
|
||||
await page.waitForURL((u) => !u.pathname.startsWith('/login'));
|
||||
}
|
||||
|
||||
test.describe('relate picker', () => {
|
||||
test('edit page has Related + Tags pickers and an is-a-tag toggle', async ({ page }) => {
|
||||
await loginTo(page, `/${HOST}/edit`);
|
||||
@@ -34,29 +55,35 @@ test.describe('relate picker', () => {
|
||||
await expect(page.getByRole('button', { name: 'Make this a tag' })).toBeVisible(); // toggle
|
||||
});
|
||||
|
||||
test('picker loads a page of candidates then loads more on scroll', async ({ page }) => {
|
||||
test('picker populates on load and pages via the load-more sentinel', async ({ page }) => {
|
||||
await loginTo(page, `/${HOST}/edit`);
|
||||
const rows = page.locator(`${RELR} li`);
|
||||
// initial JS load fills exactly one page
|
||||
await expect.poll(() => rows.count(), { timeout: 8000 }).toBe(LIMIT);
|
||||
// scroll the results box to the bottom -> infinite scroll fetches the rest
|
||||
await page.locator(RELR).evaluate((el) => el.scrollTo(0, el.scrollHeight));
|
||||
await expect.poll(() => rows.count(), { timeout: 8000 }).toBeGreaterThan(LIMIT);
|
||||
await waitReady(page); // wait for the WASM kernel before the picker's "load" fires
|
||||
const rows = page.locator(RELROWS);
|
||||
// the declarative form's "load" trigger fills the first page (the populate fix)
|
||||
await expect.poll(() => rows.count(), { timeout: 10000 }).toBeGreaterThanOrEqual(LIMIT);
|
||||
// there are more candidates than one page, so reveal the sentinel (if it hasn't
|
||||
// already auto-revealed) to page in the rest — robust to the exact total and to
|
||||
// the sentinel starting above or below the fold.
|
||||
const more = page.locator(MORE);
|
||||
if (await more.count()) await more.first().scrollIntoViewIfNeeded();
|
||||
await expect.poll(() => rows.count(), { timeout: 10000 }).toBeGreaterThan(LIMIT); // paged in more
|
||||
});
|
||||
|
||||
test('typing in the filter narrows the candidates', async ({ page }) => {
|
||||
await loginTo(page, `/${HOST}/edit`);
|
||||
await expect.poll(() => page.locator(`${RELR} li`).count(), { timeout: 8000 }).toBeGreaterThan(0);
|
||||
await waitReady(page);
|
||||
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBeGreaterThan(0);
|
||||
await page.fill(RELF, 'Item 13');
|
||||
await expect.poll(() => page.locator(`${RELR} li`).count(), { timeout: 8000 }).toBe(1);
|
||||
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBe(1);
|
||||
await expect(page.locator(RELR)).toContainText('Picker Item 13');
|
||||
});
|
||||
|
||||
test('clicking a candidate relates it (and it shows on the post page)', async ({ page }) => {
|
||||
await loginTo(page, `/${HOST}/edit`);
|
||||
await waitReady(page);
|
||||
await page.fill(RELF, 'Item 07');
|
||||
await expect.poll(() => page.locator(`${RELR} li`).count(), { timeout: 8000 }).toBe(1);
|
||||
await page.locator(`${RELR} button`).first().click();
|
||||
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 10000 }).toBe(1);
|
||||
await page.locator(`${RELROWS} button`).first().click();
|
||||
// form POST -> 303 back to the edit page; the related list now links the slug
|
||||
await expect(page).toHaveURL(new RegExp(`/${HOST}/edit`));
|
||||
await expect(page.locator('a[href="/picker-item-07/"]')).toHaveCount(1);
|
||||
@@ -65,4 +92,21 @@ test.describe('relate picker', () => {
|
||||
await expect(page.getByRole('heading', { name: 'Related posts' })).toBeVisible();
|
||||
await expect(page.locator('body')).toContainText('Picker Item 07');
|
||||
});
|
||||
|
||||
test('picker populates after a boosted SPA nav to the edit page', async ({ page }) => {
|
||||
// Reach the edit page by CLICKING its link (a boosted SPA nav), not page.goto.
|
||||
// The old inline <script> picker never ran on swapped-in content, so the list
|
||||
// stayed empty here. The declarative form's "load" trigger is re-bound by the
|
||||
// engine on swap, so it populates — that's the regression this guards.
|
||||
await login(page);
|
||||
await page.goto(`/${HOST}/`); // public post page, logged in
|
||||
await waitReady(page);
|
||||
await page.evaluate(() => { window.__noReload = true; });
|
||||
await page.locator(`a[href="/${HOST}/edit"]`).first().click();
|
||||
await page.waitForURL((u) => u.pathname === `/${HOST}/edit`, { timeout: 15000 });
|
||||
expect(await page.evaluate(() => window.__noReload)).toBe(true); // it was a SPA nav, no full reload
|
||||
// the picker, brought in by the swap, loaded its first page of candidates
|
||||
await expect.poll(() => page.locator(RELROWS).count(), { timeout: 12000 }).toBeGreaterThanOrEqual(1);
|
||||
await expect(page.locator(RELR)).toContainText('Picker Item');
|
||||
});
|
||||
});
|
||||
|
||||
@@ -150,6 +150,12 @@ EPOCH=1
|
||||
echo "(epoch $EPOCH)"
|
||||
echo "(eval \"(host/blog-seed-types!)\")"
|
||||
EPOCH=$((EPOCH+1))
|
||||
# Index the web-stack .sxbc by content hash so /sx/h/{hash} can serve them
|
||||
# immutably and the shell can emit the data-sx-manifest (content-addressed
|
||||
# client module cache). Done once at boot.
|
||||
echo "(epoch $EPOCH)"
|
||||
echo "(eval \"(host/static-build-sxh-index!)\")"
|
||||
EPOCH=$((EPOCH+1))
|
||||
echo "(epoch $EPOCH)"
|
||||
# Anonymous reads (feed timeline + relations container reads + blog post detail)
|
||||
# plus the GUARDED blog write routes: POST /new (editor form ingest), POST/PUT/
|
||||
|
||||
@@ -3,6 +3,13 @@
|
||||
;; http-listen host reads files with the `file-read` primitive (no perform), so
|
||||
;; GET /static/** maps to a file under the static root (default "shared/static",
|
||||
;; resolved against the server cwd — mount ./shared/static there in the container).
|
||||
;;
|
||||
;; Also wires the CONTENT-ADDRESSED module cache the SX client expects: GET
|
||||
;; /sx/h/{hash} serves a web-stack .sxbc by its content hash (immutable, never
|
||||
;; stale — a deploy changes the content → changes the hash → a fresh URL), and a
|
||||
;; <script data-sx-manifest> mapping {file -> hash} makes the client's
|
||||
;; loadBytecodeFile take the content-addressed branch (localStorage + immutable)
|
||||
;; instead of the path + max-age=3600 branch.
|
||||
;; Depends on lib/dream/types.sx (dream-response/-html-status/-param) + router.
|
||||
|
||||
(define host/static-root "shared/static")
|
||||
@@ -23,6 +30,14 @@
|
||||
((ends-with? path ".wasm") "application/wasm")
|
||||
(true "application/octet-stream"))))
|
||||
|
||||
;; A content-hashed filename (e.g. js_of_ocaml-651f6707.wasm, or anything under
|
||||
;; /sx/h/) is immutable; everything else gets a modest max-age (mutable bundle).
|
||||
(define host/static--cache-control
|
||||
(fn (rel)
|
||||
(if (ends-with? rel ".wasm")
|
||||
"public, max-age=31536000, immutable"
|
||||
"public, max-age=3600")))
|
||||
|
||||
;; reject empty, absolute, or traversal paths.
|
||||
(define host/static--safe?
|
||||
(fn (rel)
|
||||
@@ -41,12 +56,56 @@
|
||||
(dream-html-status 404 "Not Found")
|
||||
(dream-response 200
|
||||
{:content-type (host/static--ctype rel)
|
||||
:cache-control "public, max-age=3600"}
|
||||
:cache-control (host/static--cache-control rel)}
|
||||
(file-read path)))))))
|
||||
|
||||
;; Route group: GET /static/** -> file under the static root. A plain route LIST
|
||||
;; (like host/feed-routes); host/serve combines + flattens the groups itself.
|
||||
;; ── content-addressed module cache (/sx/h/{hash}) ───────────────────
|
||||
;; Each web-stack .sxbc carries its content hash in its head: (sxbc 1 "HASH" ...).
|
||||
;; Index every .sxbc by that hash at startup so the client can fetch each module
|
||||
;; immutably + localStorage-cached, and never stale.
|
||||
(define host/static--sxh->path (dict)) ;; hash -> filepath
|
||||
(define host/static--file->hash (dict)) ;; "dom.sxbc" -> hash
|
||||
|
||||
;; the embedded hash from a .sxbc head: (sxbc 1 "HASH" ... -> "HASH"
|
||||
(define host/static--sxbc-hash
|
||||
(fn (head) (nth (split head "\"") 1)))
|
||||
|
||||
(define host/static-build-sxh-index!
|
||||
(fn ()
|
||||
(for-each
|
||||
(fn (path)
|
||||
(let ((h (host/static--sxbc-hash (substr (file-read path) 0 60)))
|
||||
(base (last (split path "/"))))
|
||||
(dict-set! host/static--sxh->path h path)
|
||||
(dict-set! host/static--file->hash base h)))
|
||||
(file-glob (str host/static-root "/wasm/sx/*.sxbc")))))
|
||||
|
||||
;; GET /sx/h/{hash} -> the .sxbc content, immutable (content-addressed).
|
||||
(define host/static-sxh-serve
|
||||
(fn (hash)
|
||||
(let ((path (get host/static--sxh->path hash)))
|
||||
(if (nil? path)
|
||||
(dream-html-status 404 "Not Found")
|
||||
(dream-response 200
|
||||
{:content-type "text/sx; charset=utf-8"
|
||||
:cache-control "public, max-age=31536000, immutable"}
|
||||
(file-read path))))))
|
||||
|
||||
;; the data-sx-manifest JSON for the shell: {"modules": {"dom.sxbc": "hash", ...}}.
|
||||
;; The client's loadBytecodeFile reads manifest.modules[file] -> hash -> /sx/h/.
|
||||
(define host/static-manifest-json
|
||||
(fn ()
|
||||
(str "{\"v\":1,\"boot\":[],\"defs\":{},\"modules\":{"
|
||||
(join ","
|
||||
(map (fn (k) (str "\"" k "\":\"" (get host/static--file->hash k) "\""))
|
||||
(keys host/static--file->hash)))
|
||||
"}}")))
|
||||
|
||||
;; Route group: GET /static/** (path) + GET /sx/h/** (content-addressed). A plain
|
||||
;; route LIST (like host/feed-routes); host/serve combines + flattens the groups.
|
||||
(define host/static-routes
|
||||
(list
|
||||
(dream-get "/static/**"
|
||||
(fn (req) (host/static-serve (dream-param req "**"))))))
|
||||
(fn (req) (host/static-serve (dream-param req "**"))))
|
||||
(dream-get "/sx/h/**"
|
||||
(fn (req) (host/static-sxh-serve (dream-param req "**"))))))
|
||||
|
||||
@@ -271,11 +271,30 @@
|
||||
(contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "Beta Post"))
|
||||
false)
|
||||
(host/blog-unrelate! "alpha-post" "beta-post" "related")
|
||||
(host-bl-test "relate-picker.js served as javascript"
|
||||
(dream-resp-header (host-bl-app (host-bl-req "/relate-picker.js")) "content-type")
|
||||
"application/javascript; charset=utf-8")
|
||||
(host-bl-test "relate-picker.js carries the fetch glue"
|
||||
(contains? (dream-resp-body (host-bl-app (host-bl-req "/relate-picker.js"))) "relate-options") true)
|
||||
;; The picker is a declarative SX-htmx form (no client JS): the form GETs
|
||||
;; relate-options serialising kind + the filter q, swapping the results ul on
|
||||
;; "load" and on debounced "input". The SX engine re-binds these triggers on
|
||||
;; swapped content, so it works on a full load AND a boosted SPA nav.
|
||||
(host-bl-test "picker form is declaratively wired to relate-options (load + debounced input)"
|
||||
(let ((html (render-page (host/blog--relation-editor "alpha-post" "related"))))
|
||||
(list (contains? html "/alpha-post/relate-options")
|
||||
(contains? html "input delay:200ms, load")
|
||||
(contains? html "rp-related-results")))
|
||||
(list true true true))
|
||||
;; Paging is server-driven: a full page carries a "load more" sentinel that, when
|
||||
;; revealed, GETs the next page and replaces itself (outerHTML), preserving q.
|
||||
(host-bl-test "load-more sentinel: revealed, outerHTML-swap, next offset, preserved q"
|
||||
(let ((html (render-page (host/blog--picker-more "alpha-post" "related" "my q" 20))))
|
||||
(list (contains? html "rp-more")
|
||||
(contains? html "revealed")
|
||||
(contains? html "outerHTML")
|
||||
(contains? html "offset=20")
|
||||
(contains? html "q=my%20q")
|
||||
(contains? html "exponential:1000:30000"))) ;; retries a dropped fetch
|
||||
(list true true true true true true))
|
||||
(host-bl-test "relate-options omits the load-more sentinel on a short last page"
|
||||
(contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "rp-more")
|
||||
false)
|
||||
(host/blog-put! "hint-post" "Hint Post" "(p \"h\")" "published")
|
||||
(host-bl-test "relations section: hint when logged-in + no relations"
|
||||
(contains? (str (host/blog--relations-or-hint "hint-post" true)) "add some") true)
|
||||
|
||||
Reference in New Issue
Block a user