cross-domain slices 2-3: events + shop peers, full workflow operable from the web UI

The whole vision, clickable end-to-end across THREE fed-sx peers (blog / events / shop), each a
lib/host instance with SX_DOMAIN-selected types + behaviors.

- EVENTS peer: a 'calendar' type (on-allocate → real allocated relation, via the driver now
  PERFORMING relate effects) + an 'event' type. /calendars UI: allocated posts, scheduled events
  (each with its featured post + a Buy-ticket button + sold count), and a Schedule-an-event form.
  host/blog-new-event schedules an event on main, optionally featuring an allocated post.
- SHOP peer: an 'order' type. POST /order?event= creates an order (is-a order, related to the event)
  → 'order:<id>'. Replaces the Python shop service.
- BUY: events POSTs a cross-domain order to shop (host/blog--http-order), then links event--sold-->
  order. host/blog--out-raw reads cross-domain edges (host/blog-out filters to local slugs, which
  would drop federated refs — the bug that hid allocated posts + sold counts).
- BLOG: every post page shows an 'Allocate to a calendar' form.
- serve.sh: SX_DOMAIN gates blog/events/shop seeds; SX_EVENTS_BASE / SX_SHOP_BASE wire the chain.
  docker-compose: sx_events + sx_shop peers (own stores, shared fed secret, externalnet-ready).

LIVE, all via the browser: allocate 'welcome' on blog → events /calendars shows it → schedule
'Summer Gig' featuring welcome → Buy ticket → shop order → tickets sold increments. blog 218/218.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-07-02 21:14:51 +00:00
parent 4a0d53ac43
commit a5a6698772
3 changed files with 132 additions and 9 deletions

View File

@@ -108,6 +108,8 @@ services:
SX_ACTOR: "events.rose-ash.com"
SX_SELF_URL: "http://sx_events:8000"
SX_FED_SECRET: "rose-ash-fed-2026-shared-a3f9"
# Cross-domain: where to place ticket orders (the shop peer).
SX_SHOP_BASE: "http://sx_shop:8000"
volumes:
- ./spec:/app/spec:ro
- ./lib:/app/lib:ro
@@ -122,6 +124,41 @@ services:
- default
restart: unless-stopped
# The SHOP domain — a fed-sx peer running lib/host with SX_DOMAIN=shop (an "order" type). Events
# places ticket orders here (POST /order). Replaces the Python shop/market service.
sx_shop:
image: registry.rose-ash.com:5000/sx_docs:latest
container_name: sx-dev-sx_shop-1
entrypoint: ["bash", "/app/lib/host/serve.sh"]
working_dir: /app
environment:
SX_PROJECT_DIR: /app
SX_SERVER: /app/bin/sx_server
HOST_PORT: "8000"
SX_HTTP_HOST: "0.0.0.0"
SX_PERSIST_DIR: /data/persist
SX_ADMIN_USER: admin
SX_ADMIN_PASSWORD: "sx-shop-camper-2026"
SX_SESSION_SECRET: "shop-sess-9d2e1f"
SX_SERVING_JIT: "1"
OCAMLRUNPARAM: "b"
SX_DOMAIN: "shop"
SX_ACTOR: "shop.rose-ash.com"
SX_SELF_URL: "http://sx_shop:8000"
SX_FED_SECRET: "rose-ash-fed-2026-shared-a3f9"
volumes:
- ./spec:/app/spec:ro
- ./lib:/app/lib:ro
- ./next:/app/next:ro
- ./web:/app/web:ro
- ./shared/static:/app/shared/static:ro
- ./hosts/ocaml/_build/default/bin/sx_server.exe:/app/bin/sx_server:ro
- /root/sx-shop-persist:/data/persist
networks:
- externalnet
- default
restart: unless-stopped
networks:
externalnet:
external: true

View File

@@ -152,6 +152,14 @@
;; It federates to events, whose calendar type declares an on-allocate behavior that links it.
(define host/blog--events-base "") ;; the events peer base URL (serve-set from SX_EVENTS_BASE)
(define host/blog--set-events-base! (fn (b) (set! host/blog--events-base b)))
(define host/blog--shop-base "") ;; the shop peer base URL (serve-set from SX_SHOP_BASE)
(define host/blog--set-shop-base! (fn (b) (set! host/blog--shop-base b)))
;; buy a ticket for an event: a directed cross-domain call to the shop (POST /order/<event>) that
;; creates an order and returns "order:<id>"; we then link event--sold-->order. (Synchronous cross-
;; domain call, like the RA kernel — not everything is a federated activity; directed reads/writes
;; are fine.)
(define host/blog--http-order
(fn (event) (get (http-request "POST" (str host/blog--shop-base "/order?event=" event) {} "") "body")))
(define host/blog--allocate-activity
(fn (post calendar)
{:verb "allocate" :actor host/blog--actor
@@ -580,6 +588,13 @@
(if (and (= (get e :src) slug) (= (get e :kind) kind))
(concat acc (list (get e :dst))) acc))
(list) (host/blog--all-edges))))))
;; unfiltered outgoing edges — includes CROSS-DOMAIN targets (a post/order on another peer, which
;; isn't a local slug so host/blog-out would drop it). Used for federated links (allocated, sold).
(define host/blog--out-raw
(fn (slug kind)
(reduce (fn (acc e)
(if (and (= (get e :src) slug) (= (get e :kind) kind)) (concat acc (list (get e :dst))) acc))
(list) (host/blog--all-edges))))
(define host/blog-in
(fn (slug kind)
(let ((existing (host/blog-slugs)))
@@ -2981,21 +2996,77 @@
(unquote (if (> (len (get e "args")) 0) (str (first (get e "args"))) "")))))
host/blog--flow-log))))))))))))
;; ── /calendars — the events domain view: posts allocated to each calendar (federated from blog) ──
;; the scheduled events on a calendar, each with its linked post + a Buy-ticket form (→ shop).
(define host/blog--events-list
(fn (calendar)
(let ((events (host/blog-out calendar "scheduled")))
(if (= (len events) 0) (quote (p :style "color:#999" (em "No events scheduled.")))
(cons (quote ul)
(map (fn (ev)
(let ((features (host/blog--out-raw ev "features")) (sold (host/blog--out-raw ev "sold")))
(quasiquote (li :style "margin:0.3em 0"
(b (unquote (str ev)))
(unquote (if (> (len features) 0) (str " · features: " (first features)) ""))
(unquote (str " · tickets sold: " (str (len sold)) " "))
(form :method "post" :action (unquote (str "/buy?event=" ev)) :style "display:inline"
(button :type "submit" "🎟 Buy ticket"))))))
events))))))
;; events: schedule an event on the main calendar, optionally featuring a (blog-allocated) post.
(define host/blog-new-event
(fn (req)
(let ((title (host/field req "title")) (date (or (host/field req "date") "")) (post (or (host/field req "post") "")))
(begin
(when (and title (not (= title "")))
(let ((slug (host/blog-slugify title)))
(begin
(host/blog-put! slug title (str "(article (h1 \"" title "\") (p \"" date "\"))") "published")
(host/blog-relate! slug "event" "is-a")
(host/blog-relate! "main" slug "scheduled")
(when (not (= post "")) (host/blog-relate! slug post "features")))))
(dream-redirect "/calendars")))))
;; events: buy a ticket for an event — a cross-domain order on the shop, then link event--sold-->order.
(define host/blog-buy
(fn (req)
(let ((event (or (dream-query-param req "event") (host/field req "event") "")))
(begin
(when (and (not (= event "")) (not (= host/blog--shop-base "")))
(let ((body (host/blog--http-order event)))
(when (starts-with? body "order:")
(host/blog-relate! event (substr body 6 (- (len body) 6)) "sold"))))
(dream-redirect "/calendars")))))
;; shop: create an order for an event (an order post is-a order, related to the event) → "order:<id>".
(define host/blog-order
(fn (req)
(let ((event (or (dream-query-param req "event") "unknown")))
(let ((oid (str "order-" event "-" (str (len (host/blog-slugs))))))
(begin
(host/blog-put! oid (str "Order: " event) (str "(article (h1 \"Order\") (p \"" event "\"))") "published")
(host/blog-relate! oid "order" "is-a")
(host/blog-relate! oid event "for")
(dream-response 200 {:content-type "text/plain; charset=utf-8"} (str "order:" oid)))))))
;; ── /calendars — the events domain view: allocated posts + scheduled events + a create form ──
(define host/blog-calendars
(fn (req)
(host/blog--resp req 200
(host/blog--page req "Calendars"
(quasiquote
(div (h1 "Calendars")
(p "Posts allocated to a calendar (federated in from blog, linked by the calendar type's on-allocate behavior).")
(h3 :style "margin:1em 0 0.3em" "main")
(div (h1 "📅 Calendars (events domain)")
(p "Posts allocated in from blog, events scheduled on each calendar, and ticket sales.")
(h3 :style "margin:1em 0 0.2em" "main")
(h4 :style "margin:0.6em 0 0.2em;font-size:0.95em" "Allocated posts")
(unquote
(let ((posts (host/blog-out "main" "allocated")))
(if (= (len posts) 0)
(quote (p :style "color:#999" (em "Nothing allocated yet.")))
(cons (quote ul)
(map (fn (p) (quasiquote (li (unquote (str p))))) posts)))))))))))
(let ((posts (host/blog--out-raw "main" "allocated")))
(if (= (len posts) 0) (quote (p :style "color:#999" (em "Nothing allocated yet.")))
(cons (quote ul) (map (fn (p) (quasiquote (li (unquote (str p))))) posts)))))
(h4 :style "margin:0.6em 0 0.2em;font-size:0.95em" "Scheduled events")
(unquote (host/blog--events-list "main"))
(h4 :style "margin:0.8em 0 0.2em;font-size:0.95em" "Schedule an event")
(form :method "post" :action "/new-event"
:style "padding:0.6em;border:1px dashed #bbb;background:#fafafa;font-size:0.9em"
(input :name "title" :placeholder "Event title" :style "width:12em") " "
(input :name "date" :placeholder "date" :style "width:7em") " "
(input :name "post" :placeholder "features post (slug)" :style "width:11em") " "
(button :type "submit" "Create event"))))))))
;; ── /activities — P2: the EVENT SOURCE ───────────────────────────────
;; Every observable state change emitted as a canonical activity (Create/Update on content,
@@ -3052,6 +3123,9 @@
(dream-get "/flows" host/blog-flows)
(dream-get "/fed-tick" host/blog-fed-tick)
(dream-get "/calendars" host/blog-calendars)
(dream-post "/new-event" host/blog-new-event)
(dream-post "/buy" host/blog-buy)
(dream-post "/order" host/blog-order)
(dream-get "/activities" host/blog-activities)
(dream-get "/:slug/source" host/blog-source)
(dream-get "/:slug/relate-options" host/blog-relate-options)

View File

@@ -243,6 +243,18 @@ EPOCH=1
echo "(epoch $EPOCH)"
echo "(eval \"(host/blog--set-type-behavior! \\\"calendar\\\" (list {\\\"verb\\\" \\\"allocate\\\" \\\"type\\\" \\\"article\\\" \\\"dag\\\" \\\"allocate-link\\\"}))\")"
EPOCH=$((EPOCH+1))
# an "event" type (events scheduled on a calendar); point at the shop peer for ticket orders.
echo "(epoch $EPOCH)"
echo "(eval \"(host/blog-seed! \\\"event\\\" \\\"Event\\\" \\\"(article (h1 \\\\\\\"Event\\\\\\\"))\\\" \\\"published\\\")\")"
EPOCH=$((EPOCH+1))
echo "(epoch $EPOCH)"
echo "(eval \"(host/blog--set-shop-base! \\\"${SX_SHOP_BASE:-}\\\")\")"
EPOCH=$((EPOCH+1))
elif [ "${SX_DOMAIN:-blog}" = "shop" ]; then
# The SHOP domain: an "order" type. POST /order?event= creates an order (is-a order) for an event.
echo "(epoch $EPOCH)"
echo "(eval \"(host/blog-seed! \\\"order\\\" \\\"Order\\\" \\\"(article (h1 \\\\\\\"Order\\\\\\\"))\\\" \\\"published\\\")\")"
EPOCH=$((EPOCH+1))
else
# The BLOG domain: article create→publish (sync) + update→blog-digest (durable kernel) + a
# "category" field for the edit form; and point at the events peer for cross-domain allocate.