diff --git a/docker-compose.dev-sx-host.yml b/docker-compose.dev-sx-host.yml index 394831fc..f5fee2cd 100644 --- a/docker-compose.dev-sx-host.yml +++ b/docker-compose.dev-sx-host.yml @@ -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 diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 595d727a..e8283d52 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -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/) that +;; creates an order and returns "order:"; 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:". +(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) diff --git a/lib/host/serve.sh b/lib/host/serve.sh index 73ffac04..e56bc643 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -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.