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:
@@ -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)
|
||||
|
||||
@@ -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.
|
||||
|
||||
Reference in New Issue
Block a user