commerce: order ledger on persist + idempotent reconciliation (20 tests)

ledger.sx — each order is an append-only persist stream "order/<id>";
status/total/paid/recon are folds over events (ledger = source of truth).
order-pay / order-refund are idempotent via persist/append-once keyed on the
payment ref, so a replayed SumUp webhook records once. order-recon-of
classifies unpaid/ok/underpaid/overpaid on net vs total; ledger-mismatches
finds genuine paid != ordered across streams. minikanren+scheme/flow+persist
verified coexisting in one process. Total 132/132 across 8 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/commerce/api.sx

@@ -0,0 +1,56 @@
+;; lib/commerce/api.sx — public commerce surface.
+;;
+;; A session bundles a pricing context with a cart: {:ctx CTX :cart CART}.
+;; All operations are pure and return a new session. The total and the
+;; per-line breakdown are deterministic functions of (ctx, cart).
+;;
+;; commerce-checkout is a Phase-3 stub — the order lifecycle is a durable
+;; flow that suspends at the SumUp payment boundary.
+
+(define commerce-session (fn (ctx) {:cart empty-cart :ctx ctx}))
+
+(define commerce-ctx (fn (sess) (get sess :ctx)))
+(define commerce-cart (fn (sess) (get sess :cart)))
+(define commerce-lines (fn (sess) (cart-lines (get sess :cart))))
+(define commerce-count (fn (sess) (cart-count (get sess :cart))))
+
+(define
+  commerce-add
+  (fn
+    (sess sku variant qty)
+    (assoc sess :cart (cart-add (get sess :cart) sku variant qty))))
+
+(define
+  commerce-remove
+  (fn
+    (sess sku variant)
+    (assoc sess :cart (cart-remove (get sess :cart) sku variant))))
+
+(define
+  commerce-set-qty
+  (fn
+    (sess sku variant qty)
+    (assoc sess :cart (cart-set-qty (get sess :cart) sku variant qty))))
+
+;; True when the sku exists in the session's catalog snapshot.
+(define
+  commerce-can-add?
+  (fn (sess sku) (catalog-has? (ctx-catalog (get sess :ctx)) sku)))
+
+(define
+  commerce-total
+  (fn (sess) (cart-total (get sess :ctx) (get sess :cart))))
+
+;; Per-line audit breakdown — the "which line contributed what" view.
+(define
+  line-detail
+  (fn (ctx line) (let ((cat (ctx-catalog ctx))) {:sku (line-sku line) :unit (line-unit-price cat (line-sku line) (line-variant line)) :qty (line-qty line) :variant (line-variant line) :extended (line-extended cat line) :tax (line-tax ctx line)})))
+
+(define
+  commerce-explain
+  (fn
+    (sess)
+    (map (fn (l) (line-detail (get sess :ctx) l)) (get sess :cart))))
+
+;; Phase 3 — order lifecycle flow (reserve -> pay -> fulfil) lands here.
+(define commerce-checkout (fn (sess) {:note "order lifecycle flow lands in Phase 3" :phase 3 :status :not-implemented}))

lib/commerce/cart.sx

@@ -0,0 +1,86 @@
+;; lib/commerce/cart.sx — cart as an ordered list of line items.
+;;
+;; A cart is a native list of lines; a line is (list sku variant qty).
+;; All operations are pure: they return a new cart, never mutate. Line
+;; order is insertion order (stable) so totals are reproducible.
+;;
+;; cart-lineo is the relational view — because a line *is* a (sku variant qty)
+;; tuple, membero queries the cart directly, forward or backward.
+
+(define empty-cart (list))
+
+(define make-line (fn (sku variant qty) (list sku variant qty)))
+(define line-sku (fn (l) (nth l 0)))
+(define line-variant (fn (l) (nth l 1)))
+(define line-qty (fn (l) (nth l 2)))
+
+(define
+  same-line?
+  (fn
+    (l sku variant)
+    (and (= (line-sku l) sku) (= (line-variant l) variant))))
+
+(define
+  cart-qty
+  (fn
+    (cart sku variant)
+    (let
+      ((m (filter (fn (l) (same-line? l sku variant)) cart)))
+      (if (empty? m) 0 (line-qty (first m))))))
+
+(define
+  cart-remove
+  (fn
+    (cart sku variant)
+    (filter (fn (l) (not (same-line? l sku variant))) cart)))
+
+;; Add qty units; merges into an existing (sku,variant) line in place,
+;; otherwise appends a new line at the end.
+(define
+  cart-add
+  (fn
+    (cart sku variant qty)
+    (let
+      ((existing (cart-qty cart sku variant)))
+      (if
+        (= existing 0)
+        (append cart (list (make-line sku variant qty)))
+        (map
+          (fn
+            (l)
+            (if
+              (same-line? l sku variant)
+              (make-line sku variant (+ existing qty))
+              l))
+          cart)))))
+
+;; Set the absolute quantity; qty <= 0 removes the line.
+(define
+  cart-set-qty
+  (fn
+    (cart sku variant qty)
+    (if
+      (<= qty 0)
+      (cart-remove cart sku variant)
+      (if
+        (= (cart-qty cart sku variant) 0)
+        (append cart (list (make-line sku variant qty)))
+        (map
+          (fn
+            (l)
+            (if (same-line? l sku variant) (make-line sku variant qty) l))
+          cart)))))
+
+(define cart-empty? (fn (cart) (empty? cart)))
+(define cart-lines (fn (cart) cart))
+(define cart-skus (fn (cart) (map line-sku cart)))
+
+;; Total number of units across all lines.
+(define
+  cart-count
+  (fn (cart) (reduce (fn (acc l) (+ acc (line-qty l))) 0 cart)))
+
+;; Relational view of cart lines.
+(define
+  cart-lineo
+  (fn (cart sku variant qty) (membero (list sku variant qty) cart)))

lib/commerce/catalog.sx

@@ -0,0 +1,83 @@
+;; lib/commerce/catalog.sx — catalog snapshot + relational accessors.
+;;
+;; A catalog snapshot is an immutable dict:
+;;   {:products (list (list sku price class) ...)
+;;    :variants (list (list sku variant delta) ...)
+;;    :stock    (list (list sku variant qty) ...)}
+;;
+;; Money is integer minor units (pence/cents). class is a keyword product
+;; class consumed later by tax and promotion relations. delta is a signed
+;; price adjustment for a variant; qty is on-hand stock for (sku,variant).
+;;
+;; Accessor relations take the snapshot as the first argument and are fully
+;; multidirectional: (producto cat "widget" p c) binds p,c forward;
+;; (producto cat s 1000 c) enumerates every sku priced 1000 backward.
+
+(define empty-catalog {:products (list) :stock (list) :variants (list)})
+
+(define make-catalog (fn (products variants stock) {:products products :stock stock :variants variants}))
+
+(define cat-products (fn (cat) (get cat :products)))
+(define cat-variants (fn (cat) (get cat :variants)))
+(define cat-stock (fn (cat) (get cat :stock)))
+
+;; --- core fact relations ---
+
+(define
+  producto
+  (fn
+    (cat sku price class)
+    (membero (list sku price class) (get cat :products))))
+
+(define
+  varianto
+  (fn
+    (cat sku variant delta)
+    (membero (list sku variant delta) (get cat :variants))))
+
+(define
+  stocko
+  (fn
+    (cat sku variant qty)
+    (membero (list sku variant qty) (get cat :stock))))
+
+;; --- derived relations ---
+
+(define
+  priceo
+  (fn (cat sku price) (fresh (c) (producto cat sku price c))))
+
+(define
+  classo
+  (fn (cat sku class) (fresh (p) (producto cat sku p class))))
+
+;; Effective unit price of a (sku,variant): base + variant delta.
+(define
+  unit-priceo
+  (fn
+    (cat sku variant price)
+    (fresh
+      (base delta)
+      (priceo cat sku base)
+      (varianto cat sku variant delta)
+      (pluso-i base delta price))))
+
+;; --- deterministic lookups (first solution under fixed fact order) ---
+
+(define
+  catalog-price
+  (fn
+    (cat sku)
+    (let
+      ((rs (run 1 p (priceo cat sku p))))
+      (if (empty? rs) nil (first rs)))))
+
+(define
+  catalog-class
+  (fn
+    (cat sku)
+    (let
+      ((rs (run 1 c (classo cat sku c))))
+      (if (empty? rs) nil (first rs)))))
+
+(define catalog-has? (fn (cat sku) (not (nil? (catalog-price cat sku)))))

lib/commerce/conformance.sh

@@ -0,0 +1,133 @@
+#!/usr/bin/env bash
+# lib/commerce/conformance.sh — run commerce test suites in one sx_server
+# process per suite, emit scoreboard.json + scoreboard.md.
+#
+# commerce-on-sx builds pricing/promotion as miniKanren relations, so every
+# suite loads the miniKanren stack first, then the commerce modules.
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
+if [ ! -x "$SX_SERVER" ]; then
+  SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
+fi
+if [ ! -x "$SX_SERVER" ]; then
+  echo "ERROR: sx_server.exe not found." >&2
+  exit 1
+fi
+
+SUITES=(catalog cart price api promo stack quote ledger)
+
+OUT_JSON="lib/commerce/scoreboard.json"
+OUT_MD="lib/commerce/scoreboard.md"
+
+run_suite() {
+  local suite=$1
+  local file="lib/commerce/tests/${suite}.sx"
+  local TMP
+  TMP=$(mktemp)
+  cat > "$TMP" << EPOCHS
+(epoch 1)
+(load "spec/stdlib.sx")
+(load "lib/r7rs.sx")
+(load "lib/guest/match.sx")
+(load "lib/minikanren/unify.sx")
+(load "lib/minikanren/stream.sx")
+(load "lib/minikanren/goals.sx")
+(load "lib/minikanren/fresh.sx")
+(load "lib/minikanren/conde.sx")
+(load "lib/minikanren/run.sx")
+(load "lib/minikanren/relations.sx")
+(load "lib/minikanren/project.sx")
+(load "lib/minikanren/intarith.sx")
+(load "lib/minikanren/matche.sx")
+(load "lib/minikanren/defrel.sx")
+(load "lib/persist/event.sx")
+(load "lib/persist/backend.sx")
+(load "lib/persist/log.sx")
+(load "lib/persist/kv.sx")
+(load "lib/persist/idempotency.sx")
+(load "lib/commerce/catalog.sx")
+(load "lib/commerce/cart.sx")
+(load "lib/commerce/price.sx")
+(load "lib/commerce/api.sx")
+(load "lib/commerce/promo.sx")
+(load "lib/commerce/stack.sx")
+(load "lib/commerce/quote.sx")
+(load "lib/commerce/ledger.sx")
+(epoch 2)
+(eval "(define ct-pass 0)")
+(eval "(define ct-fail 0)")
+(eval "(define ct-fails (list))")
+(eval "(define commerce-test (fn (name got expected) (if (= got expected) (set! ct-pass (+ ct-pass 1)) (begin (set! ct-fail (+ ct-fail 1)) (append! ct-fails name)))))")
+(epoch 3)
+(load "${file}")
+(epoch 4)
+(eval "(list ct-pass ct-fail)")
+(eval "ct-fails")
+EPOCHS
+
+  local OUTPUT
+  OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
+  rm -f "$TMP"
+
+  # The (list ct-pass ct-fail) result follows its (ok-len 2 N) ack line.
+  local LINE
+  LINE=$(echo "$OUTPUT" | grep -oE '^\([0-9]+ [0-9]+\)$' | tail -1)
+  local P F
+  P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\)$/\1/')
+  F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\)$/\2/')
+  P=${P:-0}
+  F=${F:-0}
+  echo "${P} ${F}"
+}
+
+declare -A SUITE_PASS
+declare -A SUITE_FAIL
+TOTAL_PASS=0
+TOTAL_FAIL=0
+
+echo "Running commerce conformance suite..." >&2
+for s in "${SUITES[@]}"; do
+  read -r p f < <(run_suite "$s")
+  SUITE_PASS[$s]=$p
+  SUITE_FAIL[$s]=$f
+  TOTAL_PASS=$((TOTAL_PASS + p))
+  TOTAL_FAIL=$((TOTAL_FAIL + f))
+  printf "  %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
+done
+
+{
+  printf '{\n'
+  printf '  "suites": {\n'
+  first=1
+  for s in "${SUITES[@]}"; do
+    if [ $first -eq 0 ]; then printf ',\n'; fi
+    printf '    "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
+    first=0
+  done
+  printf '\n  },\n'
+  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
+  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
+  printf '  "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
+  printf '}\n'
+} > "$OUT_JSON"
+
+{
+  printf '# commerce Conformance Scoreboard\n\n'
+  printf '_Generated by `lib/commerce/conformance.sh`_\n\n'
+  printf '| Suite | Pass | Fail | Total |\n'
+  printf '|-------|-----:|-----:|------:|\n'
+  for s in "${SUITES[@]}"; do
+    p=${SUITE_PASS[$s]}
+    f=${SUITE_FAIL[$s]}
+    printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
+  done
+  printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
+} > "$OUT_MD"
+
+echo "Wrote $OUT_JSON and $OUT_MD" >&2
+echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
+
+[ "$TOTAL_FAIL" -eq 0 ]

lib/commerce/ledger.sx

@@ -0,0 +1,176 @@
+;; lib/commerce/ledger.sx — the order ledger as a persist event stream.
+;;
+;; Each order is an append-only stream "order/<id>" in a persist backend.
+;; Order state is never stored directly — it is a projection (fold) over the
+;; events, so the ledger is the single source of truth and replays identically.
+;;
+;; Lifecycle events:
+;;   :created   quote snapshot {:subtotal :discount :tax :total :codes ...}
+;;   :reserved  stock reserved
+;;   :paid      {:amount :ref}  — recorded idempotently on the payment ref
+;;   :fulfilled order shipped/delivered
+;;   :cancelled / :refunded
+;;
+;; Idempotency: the SumUp webhook can fire twice for one payment. order-pay
+;; uses persist/append-once keyed by the payment ref, so a replayed webhook
+;; yields the SAME :paid event without double-recording. Reconciliation then
+;; detects genuine mismatches (paid != ordered) across the whole ledger.
+
+(define order-stream (fn (order-id) (str "order/" order-id)))
+
+;; --- writes ---
+
+(define
+  order-create
+  (fn
+    (b order-id at quote)
+    (persist/append b (order-stream order-id) :created at quote)))
+
+(define
+  order-reserve
+  (fn
+    (b order-id at data)
+    (persist/append b (order-stream order-id) :reserved at data)))
+
+;; Idempotent on payment ref — a replayed webhook does not double-record.
+(define
+  order-pay
+  (fn
+    (b order-id ref at amount)
+    (persist/append-once b (order-stream order-id) ref :paid at {:amount amount :ref ref})))
+
+(define
+  order-fulfil
+  (fn
+    (b order-id at data)
+    (persist/append b (order-stream order-id) :fulfilled at data)))
+
+(define
+  order-cancel
+  (fn
+    (b order-id at reason)
+    (persist/append b (order-stream order-id) :cancelled at {:reason reason})))
+
+(define
+  order-refund
+  (fn
+    (b order-id ref at amount)
+    (persist/append-once
+      b
+      (order-stream order-id)
+      (str "refund/" ref)
+      :refunded at
+      {:amount amount :ref ref})))
+
+;; --- reads ---
+
+(define
+  order-events
+  (fn (b order-id) (persist/read b (order-stream order-id))))
+
+;; --- projections over an event list ---
+
+(define
+  order-status-of
+  (fn
+    (events)
+    (reduce
+      (fn
+        (st e)
+        (let
+          ((t (persist/event-type e)))
+          (cond
+            ((= t :created) :pending)
+            ((= t :reserved) :reserved)
+            ((= t :paid) :paid)
+            ((= t :fulfilled) :fulfilled)
+            ((= t :cancelled) :cancelled)
+            ((= t :refunded) :refunded)
+            (:else st))))
+      :new events)))
+
+(define
+  order-total-of
+  (fn
+    (events)
+    (let
+      ((created (filter (fn (e) (= (persist/event-type e) :created)) events)))
+      (if
+        (empty? created)
+        0
+        (get (persist/event-data (first created)) :total)))))
+
+(define
+  order-paid-amount-of
+  (fn
+    (events)
+    (reduce
+      (fn
+        (acc e)
+        (if
+          (= (persist/event-type e) :paid)
+          (+ acc (get (persist/event-data e) :amount))
+          acc))
+      0
+      events)))
+
+(define
+  order-refunded-amount-of
+  (fn
+    (events)
+    (reduce
+      (fn
+        (acc e)
+        (if
+          (= (persist/event-type e) :refunded)
+          (+ acc (get (persist/event-data e) :amount))
+          acc))
+      0
+      events)))
+
+;; Net settled = paid - refunded. Reconciliation compares this to the order
+;; total, but only once a payment exists.
+(define
+  order-recon-of
+  (fn
+    (events)
+    (let
+      ((net (- (order-paid-amount-of events) (order-refunded-amount-of events)))
+        (total (order-total-of events))
+        (has-paid (some (fn (e) (= (persist/event-type e) :paid)) events)))
+      (cond
+        ((not has-paid) :unpaid)
+        ((= net total) :ok)
+        ((< net total) :underpaid)
+        (:else :overpaid)))))
+
+;; --- backend-level helpers ---
+
+(define
+  order-status
+  (fn (b order-id) (order-status-of (order-events b order-id))))
+(define
+  order-total
+  (fn (b order-id) (order-total-of (order-events b order-id))))
+(define
+  order-paid
+  (fn (b order-id) (order-paid-amount-of (order-events b order-id))))
+(define
+  order-recon
+  (fn (b order-id) (order-recon-of (order-events b order-id))))
+
+(define order-ids (fn (b) (persist/backend-streams b)))
+
+;; Streams whose net payment does not match the order total (true mismatches,
+;; excluding orders that are simply not yet paid).
+(define
+  ledger-mismatches
+  (fn
+    (b)
+    (filter
+      (fn
+        (s)
+        (let
+          ((r (order-recon-of (persist/read b s))))
+          (or (= r :underpaid) (= r :overpaid))))
+      (persist/backend-streams b))))

lib/commerce/price.sx

@@ -0,0 +1,110 @@
+;; lib/commerce/price.sx — deterministic subtotal + jurisdiction-relational tax.
+;;
+;; A pricing context bundles the inputs that make a total reproducible:
+;;   {:catalog CAT :tax-rules RULES :jurisdiction J :customer C}
+;; Same context + same cart => identical total, every run.
+;;
+;; Tax is NOT a hardcoded VAT rate. Rules are facts indexed by
+;;   (jurisdiction, product-class, customer-class) -> rate-bps
+;; where rate-bps is an integer in basis points (2000 = 20%). taxo queries
+;; them multidirectionally. Money stays in integer minor units; rounding is
+;; half-up per line via integer arithmetic only — never floats.
+
+(define
+  make-pricing-context
+  (fn (catalog tax-rules jurisdiction customer) {:customer customer :jurisdiction jurisdiction :catalog catalog :tax-rules tax-rules}))
+
+(define ctx-catalog (fn (ctx) (get ctx :catalog)))
+
+;; --- unit + line pricing ---
+
+;; Variant delta, defaulting to 0 when the (sku,variant) has no variant fact.
+(define
+  variant-delta
+  (fn
+    (cat sku variant)
+    (let
+      ((rs (run 1 d (varianto cat sku variant d))))
+      (if (empty? rs) 0 (first rs)))))
+
+;; Effective unit price = base price + variant delta. nil if sku unknown.
+(define
+  line-unit-price
+  (fn
+    (cat sku variant)
+    (let
+      ((base (catalog-price cat sku)))
+      (if (nil? base) nil (+ base (variant-delta cat sku variant))))))
+
+;; Extended (line) price = unit price * quantity.
+(define
+  line-extended
+  (fn
+    (cat line)
+    (*
+      (line-unit-price cat (line-sku line) (line-variant line))
+      (line-qty line))))
+
+(define
+  cart-subtotal
+  (fn
+    (cat cart)
+    (reduce (fn (acc l) (+ acc (line-extended cat l))) 0 cart)))
+
+;; --- tax (jurisdiction-relational) ---
+
+;; rules: (list (list jurisdiction class customer bps) ...)
+(define
+  taxo
+  (fn
+    (rules juris class cust bps)
+    (membero (list juris class cust bps) rules)))
+
+;; Deterministic rate lookup; 0 when no rule matches.
+(define
+  rate-bps
+  (fn
+    (rules juris class cust)
+    (let
+      ((rs (run 1 b (taxo rules juris class cust b))))
+      (if (empty? rs) 0 (first rs)))))
+
+;; Apply a basis-point rate to an integer amount, rounding half up.
+(define
+  apply-bps
+  (fn (amount bps) (quotient (+ (* amount bps) 5000) 10000)))
+
+(define
+  line-tax
+  (fn
+    (ctx line)
+    (let
+      ((cat (ctx-catalog ctx)))
+      (let
+        ((class (catalog-class cat (line-sku line))))
+        (apply-bps
+          (line-extended cat line)
+          (rate-bps
+            (get ctx :tax-rules)
+            (get ctx :jurisdiction)
+            class
+            (get ctx :customer)))))))
+
+(define
+  cart-tax
+  (fn
+    (ctx cart)
+    (reduce (fn (acc l) (+ acc (line-tax ctx l))) 0 cart)))
+
+;; --- total ---
+
+;; Returns {:subtotal :discounts :tax :total}. discounts is 0 until Phase 2.
+(define
+  cart-total
+  (fn
+    (ctx cart)
+    (let
+      ((cat (ctx-catalog ctx)))
+      (let
+        ((sub (cart-subtotal cat cart)) (tax (cart-tax ctx cart)))
+        {:subtotal sub :discounts 0 :total (+ sub tax) :tax tax}))))

lib/commerce/promo.sx

@@ -0,0 +1,153 @@
+;; lib/commerce/promo.sx — promotions as relations over the cart + catalog.
+;;
+;; A promo is a tagged tuple; the second field is always its code:
+;;   (:percent code class pct-bps)   pct-bps off every line of product-class
+;;   (:fixed   code threshold amount) amount off when subtotal >= threshold
+;;   (:bundle  code sku n)            every nth unit of sku is free
+;;   (:member  code class pct-bps)    like :percent, members only
+;;
+;; A ruleset is a list of promo tuples. The discount a promo yields on a
+;; given cart is a pure integer computation (minor units); the *enumeration*
+;; of which promos apply is relational, so promo-applieso runs forward
+;; ("which codes apply and for how much?") and backward ("which code yields
+;; this discount?"). Stacking precedence is a separate layer (stack.sx).
+
+(define promo-kind (fn (p) (nth p 0)))
+(define promo-code (fn (p) (nth p 1)))
+
+;; Extended price of all lines whose sku is in product-class `class`.
+(define
+  class-extended
+  (fn
+    (ctx cart class)
+    (let
+      ((cat (ctx-catalog ctx)))
+      (reduce
+        (fn
+          (acc l)
+          (if
+            (= (catalog-class cat (line-sku l)) class)
+            (+ acc (line-extended cat l))
+            acc))
+        0
+        cart))))
+
+(define
+  sku-qty
+  (fn
+    (cart sku)
+    (reduce
+      (fn (acc l) (if (= (line-sku l) sku) (+ acc (line-qty l)) acc))
+      0
+      cart)))
+
+;; --- per-type discount amounts (pure, integer minor units) ---
+
+(define
+  percent-amount
+  (fn
+    (ctx cart p)
+    (apply-bps
+      (class-extended ctx cart (nth p 2))
+      (nth p 3))))
+
+(define
+  fixed-amount
+  (fn
+    (ctx cart p)
+    (let
+      ((sub (cart-subtotal (ctx-catalog ctx) cart)))
+      (if
+        (>= sub (nth p 2))
+        (min (nth p 3) sub)
+        0))))
+
+(define
+  bundle-amount
+  (fn
+    (ctx cart p)
+    (let
+      ((sku (nth p 2)) (n (nth p 3)))
+      (let
+        ((free (quotient (sku-qty cart sku) n)))
+        (* free (catalog-price (ctx-catalog ctx) sku))))))
+
+(define
+  member-amount
+  (fn
+    (ctx cart p)
+    (if
+      (= (get ctx :customer) :member)
+      (apply-bps
+        (class-extended ctx cart (nth p 2))
+        (nth p 3))
+      0)))
+
+;; Discount this promo yields on this cart (0 if it does not apply).
+(define
+  promo-amount
+  (fn
+    (ctx cart p)
+    (let
+      ((k (promo-kind p)))
+      (cond
+        ((= k :percent) (percent-amount ctx cart p))
+        ((= k :fixed) (fixed-amount ctx cart p))
+        ((= k :bundle) (bundle-amount ctx cart p))
+        ((= k :member) (member-amount ctx cart p))
+        (:else 0)))))
+
+;; --- relational enumeration ---
+
+;; (code, amount) for every promo in the ruleset (amount may be 0).
+(define
+  promo-discounto
+  (fn
+    (ctx cart ruleset code amount)
+    (fresh
+      (p)
+      (membero p ruleset)
+      (project
+        (p)
+        (== code (promo-code p))
+        (== amount (promo-amount ctx cart p))))))
+
+;; (code, amount) restricted to promos that actually apply (amount > 0).
+(define
+  promo-applieso
+  (fn
+    (ctx cart ruleset code amount)
+    (fresh
+      (p)
+      (membero p ruleset)
+      (project
+        (p)
+        (if
+          (> (promo-amount ctx cart p) 0)
+          (mk-conj
+            (== code (promo-code p))
+            (== amount (promo-amount ctx cart p)))
+          fail)))))
+
+;; --- deterministic helpers ---
+
+;; List of (list code amount) for applicable promos, in ruleset order.
+(define
+  applicable-promos
+  (fn
+    (ctx cart ruleset)
+    (run*
+      pair
+      (fresh
+        (code amount)
+        (promo-applieso ctx cart ruleset code amount)
+        (== pair (list code amount))))))
+
+;; Discount for one code (0 if absent / inapplicable).
+(define
+  promo-amount-for
+  (fn
+    (ctx cart ruleset code)
+    (let
+      ((rs (run 1 a (promo-applieso ctx cart ruleset code a))))
+      (if (empty? rs) 0 (first rs)))))

lib/commerce/quote.sx

@@ -0,0 +1,36 @@
+;; lib/commerce/quote.sx — the final priced quote: price + promo + stacking.
+;;
+;; A quote is the deterministic composition of the pricing pipeline for a
+;; (context, cart, ruleset, exclusions) tuple:
+;;   {:subtotal S :discount D :tax T :total (S - D + T) :codes (...)}
+;;
+;; Tax policy (explicit, for the determinism contract): tax is computed on the
+;; GROSS per-line amounts (pre-discount), via price.sx cart-tax. The best
+;; promo stacking reduces the payable total but not the tax base. Same inputs
+;; always yield the same quote — this is the value the order flow carries.
+
+(define
+  cart-quote
+  (fn
+    (ctx cart ruleset exclusions)
+    (let
+      ((cat (ctx-catalog ctx)))
+      (let
+        ((sub (cart-subtotal cat cart))
+          (disc (best-promo-discount ctx cart ruleset exclusions))
+          (tax (cart-tax ctx cart))
+          (codes (best-promo-codes ctx cart ruleset exclusions)))
+        {:codes codes :subtotal sub :discount disc :total (+ (- sub disc) tax) :tax tax}))))
+
+(define quote-subtotal (fn (q) (get q :subtotal)))
+(define quote-discount (fn (q) (get q :discount)))
+(define quote-tax (fn (q) (get q :tax)))
+(define quote-total (fn (q) (get q :total)))
+(define quote-codes (fn (q) (get q :codes)))
+
+;; Session-level convenience (a session is {:ctx :cart}).
+(define
+  session-quote
+  (fn
+    (sess ruleset exclusions)
+    (cart-quote (get sess :ctx) (get sess :cart) ruleset exclusions)))

lib/commerce/scoreboard.json

@@ -0,0 +1,15 @@
+{
+  "suites": {
+    "catalog": {"pass": 16, "fail": 0},
+    "cart": {"pass": 18, "fail": 0},
+    "price": {"pass": 20, "fail": 0},
+    "api": {"pass": 12, "fail": 0},
+    "promo": {"pass": 17, "fail": 0},
+    "stack": {"pass": 16, "fail": 0},
+    "quote": {"pass": 13, "fail": 0},
+    "ledger": {"pass": 20, "fail": 0}
+  },
+  "total_pass": 132,
+  "total_fail": 0,
+  "total": 132
+}

lib/commerce/scoreboard.md

@@ -0,0 +1,15 @@
+# commerce Conformance Scoreboard
+
+_Generated by `lib/commerce/conformance.sh`_
+
+| Suite | Pass | Fail | Total |
+|-------|-----:|-----:|------:|
+| catalog | 16 | 0 | 16 |
+| cart | 18 | 0 | 18 |
+| price | 20 | 0 | 20 |
+| api | 12 | 0 | 12 |
+| promo | 17 | 0 | 17 |
+| stack | 16 | 0 | 16 |
+| quote | 13 | 0 | 13 |
+| ledger | 20 | 0 | 20 |
+| **Total** | **132** | **0** | **132** |

lib/commerce/stack.sx

@@ -0,0 +1,121 @@
+;; lib/commerce/stack.sx — promotion stacking precedence + best price.
+;;
+;; Per the miniKanren design rule, precedence is NOT encoded inside the promo
+;; rules. promo.sx enumerates which promos apply; this layer enumerates which
+;; *combinations* are legal and selects the best one by an explicit cost
+;; function (max total discount = min price).
+;;
+;; Exclusivity is a list of unordered code pairs that may not both apply:
+;;   exclusions = (list (list code-a code-b) ...)
+;; A stacking is a subset of applicable (code amount) pairs containing no
+;; excluded pair. valid-stackings enumerates them; best-stacking is the
+;; deterministic selection layer; stacking-by-totalo is the backward query
+;; ("which legal stacking yields this total discount?").
+
+(define
+  excluded-pair?
+  (fn
+    (exclusions a b)
+    (some
+      (fn
+        (p)
+        (or
+          (and (= (first p) a) (= (nth p 1) b))
+          (and (= (first p) b) (= (nth p 1) a))))
+      exclusions)))
+
+;; True when no two distinct codes in the list are mutually excluded.
+(define
+  compatible?
+  (fn
+    (exclusions codes)
+    (every?
+      (fn
+        (a)
+        (every?
+          (fn (b) (or (= a b) (not (excluded-pair? exclusions a b))))
+          codes))
+      codes)))
+
+;; All subsets of xs, preserving element order. 2^n entries.
+(define
+  powerset
+  (fn
+    (xs)
+    (if
+      (empty? xs)
+      (list (list))
+      (let
+        ((r (powerset (cdr xs))))
+        (append r (map (fn (s) (cons (first xs) s)) r))))))
+
+(define stacking-codes (fn (st) (map first st)))
+
+(define
+  stacking-total
+  (fn
+    (st)
+    (reduce (fn (acc pair) (+ acc (nth pair 1))) 0 st)))
+
+;; Every legal stacking of the applicable (code amount) pairs.
+(define
+  valid-stackings
+  (fn
+    (exclusions applicable)
+    (filter
+      (fn (st) (compatible? exclusions (stacking-codes st)))
+      (powerset applicable))))
+
+;; Deterministic selection: the legal stacking with the greatest total
+;; discount; ties keep the earlier (stable) candidate, so the result is a
+;; reproducible function of (exclusions, applicable).
+(define
+  best-stacking
+  (fn
+    (exclusions applicable)
+    (reduce
+      (fn
+        (best st)
+        (if (> (stacking-total st) (stacking-total best)) st best))
+      (list)
+      (valid-stackings exclusions applicable))))
+
+(define
+  best-discount
+  (fn
+    (exclusions applicable)
+    (stacking-total (best-stacking exclusions applicable))))
+
+(define
+  best-codes
+  (fn
+    (exclusions applicable)
+    (stacking-codes (best-stacking exclusions applicable))))
+
+;; Backward query: legal stackings (as code lists) whose total discount = D.
+(define
+  stacking-by-totalo
+  (fn
+    (stackings codes total)
+    (fresh
+      (st)
+      (membero st stackings)
+      (project
+        (st)
+        (mk-conj
+          (== codes (stacking-codes st))
+          (== total (stacking-total st)))))))
+
+;; --- top-level entry: best discount for a cart under a ruleset ---
+
+(define
+  best-promo-discount
+  (fn
+    (ctx cart ruleset exclusions)
+    (best-discount exclusions (applicable-promos ctx cart ruleset))))
+
+(define
+  best-promo-codes
+  (fn
+    (ctx cart ruleset exclusions)
+    (best-codes exclusions (applicable-promos ctx cart ruleset))))

lib/commerce/tests/api.sx

@@ -0,0 +1,73 @@
+;; lib/commerce/tests/api.sx — public commerce session surface.
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+
+(define
+  acat
+  (make-catalog
+    (list
+      (list "widget" 1000 :standard)
+      (list "book" 800 :zero-rated))
+    (list (list "widget" :small -200))
+    (list)))
+
+(define
+  arules
+  (list
+    (list :uk :standard :guest 2000)
+    (list :uk :zero-rated :guest 0)))
+
+(define actx (make-pricing-context acat arules :uk :guest))
+(define sess0 (commerce-session actx))
+
+;; --- empty session ---
+
+(commerce-test "new-session-empty" (commerce-cart sess0) empty-cart)
+(commerce-test "new-count" (commerce-count sess0) 0)
+(commerce-test "new-total" (commerce-total sess0) {:subtotal 0 :discounts 0 :total 0 :tax 0})
+
+;; --- add + total ---
+
+(define
+  sess1
+  (commerce-add
+    (commerce-add sess0 "widget" :small 2)
+    "book"
+    :none 1))
+
+(commerce-test "add-count" (commerce-count sess1) 3)
+(commerce-test
+  "add-lines"
+  (commerce-lines sess1)
+  (list (list "widget" :small 2) (list "book" :none 1)))
+(commerce-test "add-total" (commerce-total sess1) {:subtotal 2400 :discounts 0 :total 2720 :tax 320})
+
+;; --- mutate ---
+
+(commerce-test
+  "set-qty"
+  (commerce-lines (commerce-set-qty sess1 "widget" :small 1))
+  (list (list "widget" :small 1) (list "book" :none 1)))
+
+(commerce-test
+  "remove"
+  (commerce-lines (commerce-remove sess1 "book" :none))
+  (list (list "widget" :small 2)))
+
+;; --- validation ---
+
+(commerce-test "can-add-yes" (commerce-can-add? sess0 "widget") true)
+(commerce-test "can-add-no" (commerce-can-add? sess0 "ghost") false)
+
+;; --- audit breakdown ---
+
+(commerce-test
+  "explain"
+  (commerce-explain sess1)
+  (list {:sku "widget" :unit 800 :qty 2 :variant :small :extended 1600 :tax 320} {:sku "book" :unit 800 :qty 1 :variant :none :extended 800 :tax 0}))
+
+;; --- checkout stub ---
+
+(commerce-test
+  "checkout-stub"
+  (get (commerce-checkout sess1) :status)
+  :not-implemented)

lib/commerce/tests/cart.sx

@@ -0,0 +1,103 @@
+;; lib/commerce/tests/cart.sx — cart structure + line operations.
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+
+;; --- add ---
+
+(commerce-test
+  "add-to-empty"
+  (cart-add empty-cart "widget" :small 2)
+  (list (list "widget" :small 2)))
+
+(commerce-test
+  "add-merges-same-line"
+  (cart-add
+    (cart-add empty-cart "widget" :small 2)
+    "widget"
+    :small 3)
+  (list (list "widget" :small 5)))
+
+(commerce-test
+  "add-different-variant-separate"
+  (cart-add
+    (cart-add empty-cart "widget" :small 2)
+    "widget"
+    :large 1)
+  (list (list "widget" :small 2) (list "widget" :large 1)))
+
+(commerce-test
+  "add-different-sku-separate"
+  (cart-add
+    (cart-add empty-cart "widget" :small 2)
+    "gadget"
+    :std 1)
+  (list (list "widget" :small 2) (list "gadget" :std 1)))
+
+(commerce-test
+  "add-preserves-order"
+  (cart-skus
+    (cart-add
+      (cart-add (cart-add empty-cart "a" :v 1) "b" :v 1)
+      "c"
+      :v 1))
+  (list "a" "b" "c"))
+
+;; --- qty queries ---
+
+(define
+  c2
+  (cart-add
+    (cart-add empty-cart "widget" :small 2)
+    "gadget"
+    :std 4))
+
+(commerce-test "cart-qty-found" (cart-qty c2 "widget" :small) 2)
+(commerce-test "cart-qty-missing" (cart-qty c2 "widget" :large) 0)
+(commerce-test "cart-count" (cart-count c2) 6)
+(commerce-test "cart-empty-yes" (cart-empty? empty-cart) true)
+(commerce-test "cart-empty-no" (cart-empty? c2) false)
+
+;; --- set-qty ---
+
+(commerce-test
+  "set-qty-existing"
+  (cart-set-qty c2 "widget" :small 10)
+  (list (list "widget" :small 10) (list "gadget" :std 4)))
+
+(commerce-test
+  "set-qty-new-line"
+  (cart-set-qty empty-cart "book" :std 3)
+  (list (list "book" :std 3)))
+
+(commerce-test
+  "set-qty-zero-removes"
+  (cart-set-qty c2 "widget" :small 0)
+  (list (list "gadget" :std 4)))
+
+;; --- remove ---
+
+(commerce-test
+  "remove-line"
+  (cart-remove c2 "gadget" :std)
+  (list (list "widget" :small 2)))
+
+(commerce-test
+  "remove-missing-noop"
+  (cart-remove c2 "nope" :std)
+  (list (list "widget" :small 2) (list "gadget" :std 4)))
+
+;; --- relational view ---
+
+(commerce-test
+  "cart-lineo-forward"
+  (run* q (cart-lineo c2 "gadget" :std q))
+  (list 4))
+
+(commerce-test
+  "cart-lineo-sku-by-qty-backward"
+  (run* sk (fresh (v) (cart-lineo c2 sk v 4)))
+  (list "gadget"))
+
+(commerce-test
+  "cart-lineo-all-skus"
+  (run* sk (fresh (v q) (cart-lineo c2 sk v q)))
+  (list "widget" "gadget"))

lib/commerce/tests/catalog.sx

@@ -0,0 +1,93 @@
+;; lib/commerce/tests/catalog.sx — catalog facts + relational accessors.
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+;; Query vars avoid the name `s` (the run-n macro binds `s` internally).
+
+(define
+  cat
+  (make-catalog
+    (list
+      (list "widget" 1000 :standard)
+      (list "gadget" 2500 :standard)
+      (list "book" 800 :zero-rated)
+      (list "tea" 1000 :reduced))
+    (list
+      (list "widget" :small -200)
+      (list "widget" :large 500)
+      (list "gadget" :std 0))
+    (list
+      (list "widget" :small 5)
+      (list "widget" :large 0)
+      (list "gadget" :std 12))))
+
+;; --- forward lookups ---
+
+(commerce-test
+  "price-forward"
+  (run* p (priceo cat "widget" p))
+  (list 1000))
+(commerce-test
+  "class-forward"
+  (run* c (classo cat "book" c))
+  (list :zero-rated))
+(commerce-test
+  "product-forward"
+  (run* q (fresh (p c) (producto cat "gadget" p c) (== q (list p c))))
+  (list (list 2500 :standard)))
+
+;; --- backward lookups (the showcase) ---
+
+(commerce-test
+  "sku-by-price-backward"
+  (run* sk (priceo cat sk 1000))
+  (list "widget" "tea"))
+
+(commerce-test
+  "sku-by-class-backward"
+  (run* sk (classo cat sk :standard))
+  (list "widget" "gadget"))
+
+(commerce-test
+  "all-prices"
+  (run* p (fresh (sk) (priceo cat sk p)))
+  (list 1000 2500 800 1000))
+
+;; --- variants + effective unit price ---
+
+(commerce-test
+  "variant-delta-forward"
+  (run* d (varianto cat "widget" :small d))
+  (list -200))
+
+(commerce-test
+  "unit-price-small"
+  (run* p (unit-priceo cat "widget" :small p))
+  (list 800))
+
+(commerce-test
+  "unit-price-large"
+  (run* p (unit-priceo cat "widget" :large p))
+  (list 1500))
+
+(commerce-test
+  "variant-by-delta-backward"
+  (run* v (varianto cat "widget" v -200))
+  (list :small))
+
+;; --- stock ---
+
+(commerce-test
+  "stock-forward"
+  (run* q (stocko cat "widget" :small q))
+  (list 5))
+
+(commerce-test
+  "in-stock-skus-backward"
+  (run* sk (fresh (v q) (stocko cat sk v q) (lto-i 0 q)))
+  (list "widget" "gadget"))
+
+;; --- deterministic helpers ---
+
+(commerce-test "catalog-price-helper" (catalog-price cat "gadget") 2500)
+(commerce-test "catalog-class-helper" (catalog-class cat "tea") :reduced)
+(commerce-test "catalog-has-yes" (catalog-has? cat "book") true)
+(commerce-test "catalog-has-no" (catalog-has? cat "nonesuch") false)

lib/commerce/tests/ledger.sx

@@ -0,0 +1,80 @@
+;; lib/commerce/tests/ledger.sx — order ledger on persist + idempotent recon.
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+
+(define q1 {:codes (list) :subtotal 1000 :discount 0 :total 1200 :tax 200})
+
+;; --- lifecycle status projection ---
+
+(define b1 (persist/mem-backend))
+(define _c1 (order-create b1 "A1" 100 q1))
+(commerce-test "status-pending" (order-status b1 "A1") :pending)
+(define _r1 (order-reserve b1 "A1" 101 {:lines 2}))
+(commerce-test "status-reserved" (order-status b1 "A1") :reserved)
+(define _p1 (order-pay b1 "A1" "ref-1" 102 1200))
+(commerce-test "status-paid" (order-status b1 "A1") :paid)
+(define _f1 (order-fulfil b1 "A1" 103 {:carrier "post"}))
+(commerce-test "status-fulfilled" (order-status b1 "A1") :fulfilled)
+
+(commerce-test "total-projection" (order-total b1 "A1") 1200)
+(commerce-test "paid-projection" (order-paid b1 "A1") 1200)
+(commerce-test "recon-ok" (order-recon b1 "A1") :ok)
+(commerce-test "event-count" (len (order-events b1 "A1")) 4)
+
+;; --- idempotency: replayed webhook does not double-record ---
+
+(define b2 (persist/mem-backend))
+(define _c2 (order-create b2 "B1" 200 q1))
+(define _p2a (order-pay b2 "B1" "sumup-9" 201 1200))
+(define _p2b (order-pay b2 "B1" "sumup-9" 201 1200))
+(define _p2c (order-pay b2 "B1" "sumup-9" 201 1200))
+
+(commerce-test "idem-single-event" (len (order-events b2 "B1")) 2)
+(commerce-test "idem-paid-once" (order-paid b2 "B1") 1200)
+(commerce-test "idem-recon-ok" (order-recon b2 "B1") :ok)
+(commerce-test "idem-same-event" (= _p2a _p2c) true)
+
+;; --- mismatch detection ---
+
+(define bun (persist/mem-backend))
+(define _cu (order-create bun "U1" 300 q1))
+(commerce-test "unpaid-recon" (order-recon bun "U1") :unpaid)
+
+(define bup (persist/mem-backend))
+(define _cp (order-create bup "U2" 300 q1))
+(define _pp1 (order-pay bup "U2" "r-a" 301 1200))
+(define _pp2 (order-pay bup "U2" "r-b" 302 1200))
+(commerce-test "double-charge-overpaid" (order-recon bup "U2") :overpaid)
+(commerce-test "double-charge-amount" (order-paid bup "U2") 2400)
+
+(define bsh (persist/mem-backend))
+(define _cs (order-create bsh "U3" 400 q1))
+(define _ps (order-pay bsh "U3" "r-short" 401 1000))
+(commerce-test "underpaid-recon" (order-recon bsh "U3") :underpaid)
+
+;; --- refund (idempotent) reduces net ---
+
+(define brf (persist/mem-backend))
+(define _crf (order-create brf "R1" 500 q1))
+(define _prf (order-pay brf "R1" "p-1" 501 1200))
+(define _rf1 (order-refund brf "R1" "rf-1" 502 200))
+(define _rf2 (order-refund brf "R1" "rf-1" 502 200))
+(commerce-test "refund-idem-net" (order-recon brf "R1") :underpaid)
+(commerce-test "refund-idem-events" (len (order-events brf "R1")) 3)
+
+;; --- cross-ledger reconciliation ---
+
+(define bL (persist/mem-backend))
+(define _l1 (order-create bL "OK1" 600 q1))
+(define _l1p (order-pay bL "OK1" "ok-ref" 601 1200))
+(define _l2 (order-create bL "OVER1" 600 q1))
+(define _l2a (order-pay bL "OVER1" "o-a" 602 1200))
+(define _l2b (order-pay bL "OVER1" "o-b" 603 1200))
+(define _l3 (order-create bL "UNDER1" 600 q1))
+(define _l3p (order-pay bL "UNDER1" "u-ref" 604 900))
+(define _l4 (order-create bL "PENDING1" 600 q1))
+
+(commerce-test "ledger-order-count" (len (order-ids bL)) 4)
+(commerce-test
+  "ledger-mismatches"
+  (sort (ledger-mismatches bL))
+  (sort (list (order-stream "OVER1") (order-stream "UNDER1"))))

lib/commerce/tests/price.sx

@@ -0,0 +1,100 @@
+;; lib/commerce/tests/price.sx — subtotal + jurisdiction-relational tax.
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+
+(define
+  pcat
+  (make-catalog
+    (list
+      (list "widget" 1000 :standard)
+      (list "book" 800 :zero-rated)
+      (list "tea" 1000 :reduced))
+    (list
+      (list "widget" :small -200)
+      (list "widget" :large 500))
+    (list)))
+
+(define
+  rules
+  (list
+    (list :uk :standard :guest 2000)
+    (list :uk :reduced :guest 500)
+    (list :uk :zero-rated :guest 0)
+    (list :uk :standard :member 1000)
+    (list :ie :standard :guest 2300)))
+
+(define gctx (make-pricing-context pcat rules :uk :guest))
+(define mctx (make-pricing-context pcat rules :uk :member))
+
+;; --- unit + line pricing ---
+
+(commerce-test
+  "unit-price-variant"
+  (line-unit-price pcat "widget" :small)
+  800)
+(commerce-test
+  "unit-price-no-variant"
+  (line-unit-price pcat "widget" :none)
+  1000)
+(commerce-test "unit-price-unknown" (line-unit-price pcat "ghost" :none) nil)
+(commerce-test
+  "line-extended"
+  (line-extended pcat (list "widget" :small 2))
+  1600)
+
+;; --- subtotal ---
+
+(define
+  cart1
+  (list (list "widget" :small 2) (list "book" :none 1)))
+
+(commerce-test "subtotal" (cart-subtotal pcat cart1) 2400)
+(commerce-test "subtotal-empty" (cart-subtotal pcat empty-cart) 0)
+
+;; --- tax rate lookup (relational, both directions) ---
+
+(commerce-test
+  "rate-forward"
+  (rate-bps rules :uk :standard :guest)
+  2000)
+(commerce-test
+  "rate-missing"
+  (rate-bps rules :fr :standard :guest)
+  0)
+(commerce-test
+  "rate-juris-by-bps-backward"
+  (run* j (fresh (cust) (taxo rules j :standard cust 2300)))
+  (list :ie))
+(commerce-test
+  "rate-customer-by-bps-backward"
+  (run* cust (taxo rules :uk :standard cust 1000))
+  (list :member))
+
+;; --- apply-bps rounding (half up, integer only) ---
+
+(commerce-test "bps-exact" (apply-bps 1600 2000) 320)
+(commerce-test "bps-round-up" (apply-bps 799 2000) 160)
+(commerce-test "bps-zero" (apply-bps 800 0) 0)
+
+;; --- line + cart tax ---
+
+(commerce-test
+  "line-tax-standard"
+  (line-tax gctx (list "widget" :small 2))
+  320)
+(commerce-test
+  "line-tax-zero-rated"
+  (line-tax gctx (list "book" :none 1))
+  0)
+(commerce-test
+  "line-tax-member"
+  (line-tax mctx (list "widget" :small 2))
+  160)
+(commerce-test "cart-tax-guest" (cart-tax gctx cart1) 320)
+
+;; --- total dict (deterministic) ---
+
+(commerce-test "total-guest" (cart-total gctx cart1) {:subtotal 2400 :discounts 0 :total 2720 :tax 320})
+
+(commerce-test "total-member" (cart-total mctx cart1) {:subtotal 2400 :discounts 0 :total 2560 :tax 160})
+
+(commerce-test "total-empty" (cart-total gctx empty-cart) {:subtotal 0 :discounts 0 :total 0 :tax 0})

lib/commerce/tests/promo.sx

@@ -0,0 +1,142 @@
+;; lib/commerce/tests/promo.sx — promo rules + relational enumeration.
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+
+(define
+  pcat
+  (make-catalog
+    (list
+      (list "widget" 1000 :standard)
+      (list "book" 800 :zero-rated)
+      (list "tea" 1000 :reduced))
+    (list)
+    (list)))
+
+(define gctx (make-pricing-context pcat (list) :uk :guest))
+(define mctx (make-pricing-context pcat (list) :uk :member))
+
+(define
+  cart
+  (list
+    (list "widget" :none 3)
+    (list "book" :none 1)
+    (list "tea" :none 6)))
+
+(define
+  ruleset
+  (list
+    (list :percent "TEN" :standard 1000)
+    (list :fixed "FIVER" 5000 500)
+    (list :bundle "B3T" "tea" 3)
+    (list :member "MEM" :standard 1500)))
+
+;; --- per-type amounts ---
+
+(commerce-test
+  "percent-amount"
+  (promo-amount gctx cart (list :percent "TEN" :standard 1000))
+  300)
+
+(commerce-test
+  "fixed-amount-met"
+  (promo-amount gctx cart (list :fixed "FIVER" 5000 500))
+  500)
+
+(commerce-test
+  "fixed-amount-not-met"
+  (promo-amount
+    gctx
+    (list (list "widget" :none 1))
+    (list :fixed "FIVER" 5000 500))
+  0)
+
+(commerce-test
+  "fixed-amount-capped"
+  (promo-amount
+    gctx
+    (list (list "book" :none 1))
+    (list :fixed "BIG" 0 9999))
+  800)
+
+(commerce-test
+  "bundle-amount"
+  (promo-amount gctx cart (list :bundle "B3T" "tea" 3))
+  2000)
+
+(commerce-test
+  "member-amount-guest"
+  (promo-amount gctx cart (list :member "MEM" :standard 1500))
+  0)
+
+(commerce-test
+  "member-amount-member"
+  (promo-amount mctx cart (list :member "MEM" :standard 1500))
+  450)
+
+;; --- relational enumeration: forward ---
+
+(commerce-test
+  "discounto-all-guest"
+  (run*
+    pair
+    (fresh
+      (code amount)
+      (promo-discounto gctx cart ruleset code amount)
+      (== pair (list code amount))))
+  (list
+    (list "TEN" 300)
+    (list "FIVER" 500)
+    (list "B3T" 2000)
+    (list "MEM" 0)))
+
+(commerce-test
+  "applicable-guest"
+  (applicable-promos gctx cart ruleset)
+  (list
+    (list "TEN" 300)
+    (list "FIVER" 500)
+    (list "B3T" 2000)))
+
+(commerce-test
+  "applicable-member"
+  (applicable-promos mctx cart ruleset)
+  (list
+    (list "TEN" 300)
+    (list "FIVER" 500)
+    (list "B3T" 2000)
+    (list "MEM" 450)))
+
+;; --- relational enumeration: backward (the showcase) ---
+
+(commerce-test
+  "code-by-discount-2000"
+  (run* code (promo-applieso gctx cart ruleset code 2000))
+  (list "B3T"))
+
+(commerce-test
+  "code-by-discount-500"
+  (run* code (promo-applieso gctx cart ruleset code 500))
+  (list "FIVER"))
+
+(commerce-test
+  "code-by-discount-none"
+  (run* code (promo-applieso gctx cart ruleset code 9999))
+  (list))
+
+;; --- deterministic helpers ---
+
+(commerce-test
+  "amount-for-ten"
+  (promo-amount-for gctx cart ruleset "TEN")
+  300)
+(commerce-test
+  "amount-for-mem-guest"
+  (promo-amount-for gctx cart ruleset "MEM")
+  0)
+(commerce-test
+  "amount-for-mem-member"
+  (promo-amount-for mctx cart ruleset "MEM")
+  450)
+(commerce-test
+  "amount-for-absent"
+  (promo-amount-for gctx cart ruleset "NOPE")
+  0)

lib/commerce/tests/quote.sx

@@ -0,0 +1,108 @@
+;; lib/commerce/tests/quote.sx — composed priced quote (price+promo+stacking).
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+
+(define
+  pcat
+  (make-catalog
+    (list
+      (list "widget" 1000 :standard)
+      (list "book" 800 :zero-rated)
+      (list "tea" 1000 :reduced))
+    (list)
+    (list)))
+
+(define
+  tax-rules
+  (list
+    (list :uk :standard :guest 2000)
+    (list :uk :reduced :guest 500)
+    (list :uk :zero-rated :guest 0)
+    (list :uk :standard :member 2000)
+    (list :uk :reduced :member 500)
+    (list :uk :zero-rated :member 0)))
+
+(define gctx (make-pricing-context pcat tax-rules :uk :guest))
+(define mctx (make-pricing-context pcat tax-rules :uk :member))
+
+(define
+  cart
+  (list
+    (list "widget" :none 3)
+    (list "book" :none 1)
+    (list "tea" :none 6)))
+
+(define
+  ruleset
+  (list
+    (list :percent "TEN" :standard 1000)
+    (list :percent "TWENTY" :standard 2000)
+    (list :fixed "FIVER" 5000 500)
+    (list :bundle "B3T" "tea" 3)
+    (list :member "MEM" :standard 2500)))
+
+(define
+  exclusions
+  (list (list "TEN" "TWENTY") (list "TEN" "MEM") (list "TWENTY" "MEM")))
+
+;; subtotal: 3000 + 800 + 6000 = 9800
+;; tax (gross): widget 600 + tea 300 + book 0 = 900
+;; guest discount: TWENTY 600 + FIVER 500 + B3T 2000 = 3100
+;; guest total: 9800 - 3100 + 900 = 7600
+
+(define gq (cart-quote gctx cart ruleset exclusions))
+
+(commerce-test "quote-subtotal" (quote-subtotal gq) 9800)
+(commerce-test "quote-tax" (quote-tax gq) 900)
+(commerce-test "quote-discount-guest" (quote-discount gq) 3100)
+(commerce-test "quote-total-guest" (quote-total gq) 7600)
+(commerce-test
+  "quote-codes-guest"
+  (quote-codes gq)
+  (list "TWENTY" "FIVER" "B3T"))
+
+(commerce-test "quote-full-guest" gq {:codes (list "TWENTY" "FIVER" "B3T") :subtotal 9800 :discount 3100 :total 7600 :tax 900})
+
+;; member discount: MEM 750 + FIVER 500 + B3T 2000 = 3250
+;; member total: 9800 - 3250 + 900 = 7450
+(define mq (cart-quote mctx cart ruleset exclusions))
+
+(commerce-test "quote-discount-member" (quote-discount mq) 3250)
+(commerce-test "quote-total-member" (quote-total mq) 7450)
+(commerce-test
+  "quote-codes-member"
+  (quote-codes mq)
+  (list "FIVER" "B3T" "MEM"))
+
+;; --- determinism: same inputs, identical quote ---
+
+(commerce-test
+  "quote-deterministic"
+  (=
+    (cart-quote gctx cart ruleset exclusions)
+    (cart-quote gctx cart ruleset exclusions))
+  true)
+
+;; --- no promos: discount 0, total = subtotal + tax ---
+
+(commerce-test
+  "quote-no-promos"
+  (cart-quote gctx cart (list) (list))
+  {:codes (list) :subtotal 9800 :discount 0 :total 10700 :tax 900})
+
+;; --- empty cart ---
+
+(commerce-test
+  "quote-empty"
+  (cart-quote gctx empty-cart ruleset exclusions)
+  {:codes (list) :subtotal 0 :discount 0 :total 0 :tax 0})
+
+;; --- session convenience ---
+
+(define
+  sess
+  (commerce-add (commerce-session gctx) "widget" :none 3))
+
+(commerce-test
+  "session-quote"
+  (quote-total (session-quote sess ruleset exclusions))
+  3000)

lib/commerce/tests/stack.sx

@@ -0,0 +1,127 @@
+;; lib/commerce/tests/stack.sx — stacking precedence, exclusivity, best price.
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+
+(define
+  pcat
+  (make-catalog
+    (list
+      (list "widget" 1000 :standard)
+      (list "book" 800 :zero-rated)
+      (list "tea" 1000 :reduced))
+    (list)
+    (list)))
+
+(define gctx (make-pricing-context pcat (list) :uk :guest))
+(define mctx (make-pricing-context pcat (list) :uk :member))
+
+(define
+  cart
+  (list
+    (list "widget" :none 3)
+    (list "book" :none 1)
+    (list "tea" :none 6)))
+
+(define
+  ruleset
+  (list
+    (list :percent "TEN" :standard 1000)
+    (list :percent "TWENTY" :standard 2000)
+    (list :fixed "FIVER" 5000 500)
+    (list :bundle "B3T" "tea" 3)
+    (list :member "MEM" :standard 2500)))
+
+;; The three standard-class discounts are mutually exclusive.
+(define
+  exclusions
+  (list (list "TEN" "TWENTY") (list "TEN" "MEM") (list "TWENTY" "MEM")))
+
+;; --- exclusivity predicates ---
+
+(commerce-test
+  "excluded-pair-direct"
+  (excluded-pair? exclusions "TEN" "TWENTY")
+  true)
+(commerce-test
+  "excluded-pair-symmetric"
+  (excluded-pair? exclusions "TWENTY" "TEN")
+  true)
+(commerce-test
+  "excluded-pair-none"
+  (excluded-pair? exclusions "TEN" "FIVER")
+  false)
+(commerce-test
+  "compatible-yes"
+  (compatible? exclusions (list "FIVER" "B3T" "TWENTY"))
+  true)
+(commerce-test
+  "compatible-no"
+  (compatible? exclusions (list "TEN" "TWENTY" "B3T"))
+  false)
+
+;; --- powerset + valid stackings ---
+
+(commerce-test
+  "powerset-size"
+  (len (powerset (list 1 2 3 4)))
+  16)
+
+(define gappl (applicable-promos gctx cart ruleset))
+
+(commerce-test "applicable-guest-count" (len gappl) 4)
+
+;; 16 subsets minus the 4 containing both TEN and TWENTY = 12 legal.
+(commerce-test
+  "valid-stackings-count"
+  (len (valid-stackings exclusions gappl))
+  12)
+
+(commerce-test
+  "stacking-total"
+  (stacking-total (list (list "TWENTY" 600) (list "B3T" 2000)))
+  2600)
+
+;; --- best price (deterministic selection) ---
+
+(commerce-test
+  "best-discount-guest"
+  (best-promo-discount gctx cart ruleset exclusions)
+  3100)
+(commerce-test
+  "best-codes-guest"
+  (best-promo-codes gctx cart ruleset exclusions)
+  (list "TWENTY" "FIVER" "B3T"))
+
+;; exclusivity holds: the cheaper conflicting code is dropped.
+(commerce-test
+  "best-excludes-ten"
+  (some
+    (fn (c) (= c "TEN"))
+    (best-promo-codes gctx cart ruleset exclusions))
+  false)
+
+;; --- member vs guest ---
+
+(commerce-test
+  "best-discount-member"
+  (best-promo-discount mctx cart ruleset exclusions)
+  3250)
+(commerce-test
+  "best-codes-member"
+  (best-promo-codes mctx cart ruleset exclusions)
+  (list "FIVER" "B3T" "MEM"))
+
+;; --- best price backward query (the showcase) ---
+
+(commerce-test
+  "stacking-by-total-backward"
+  (run*
+    codes
+    (stacking-by-totalo (valid-stackings exclusions gappl) codes 3100))
+  (list (list "TWENTY" "FIVER" "B3T")))
+
+;; --- edge: no applicable promos ---
+
+(commerce-test
+  "best-empty"
+  (best-promo-discount gctx empty-cart ruleset exclusions)
+  0)

plans/agent-briefings/commerce-loop.md

@@ -0,0 +1,112 @@
+# commerce-on-sx loop agent (single agent, phase-ordered)
+
+Role: iterates `plans/commerce-on-sx.md` forever. **Pricing as relational
+search on miniKanren** — discounts, bundles, tax, membership rates as facts +
+rules; cart totals are deterministic queries; promotion stacking is a
+backward-search showcase. Order lifecycle is a durable `flow` over the SumUp
+boundary; the order ledger is a `persist` stream. **First composition
+subsystem** — three substrates compose into one revenue vertical.
+
+```
+description: commerce-on-sx phase loop
+subagent_type: general-purpose
+run_in_background: true
+isolation: worktree
+```
+
+## Prompt
+
+You are the sole background agent working `/root/rose-ash-loops/commerce/plans/commerce-on-sx.md`.
+Isolated worktree, forever, one commit per feature. Push to
+`origin/loops/commerce` after every commit. Never `main`, never `architecture`.
+
+## Restart baseline — check before iterating
+
+1. Read `plans/commerce-on-sx.md` — Phase queue + Progress log + Blockers.
+2. `ls lib/commerce/` — pick up from the most advanced file.
+3. If `lib/commerce/tests/*.sx` exist, run them via
+   `bash lib/commerce/conformance.sh`. Green before new work.
+4. Read `lib/minikanren/minikanren.sx` public API once — that's your engine.
+5. Check substrate readiness:
+   - `bash lib/minikanren/conformance.sh` — must be green
+   - `lib/persist/persist.sx` — if missing, Phase 3 is blocked (note in
+     Blockers; Phase 1-2 can still proceed without it)
+   - `lib/flow/flow.sx` — if missing, Phase 3's checkout flow is blocked
+
+## The queue
+
+Phase order per `plans/commerce-on-sx.md`:
+
+- **Phase 1** — catalog + cart + deterministic totals
+- **Phase 2** — promotions as miniKanren relations, stacking precedence
+- **Phase 3** — order lifecycle as a durable `flow` (reserve → pay → fulfil)
+- **Phase 4** — reconciliation + federation stubs
+
+Within a phase, pick the checkbox that unlocks the most tests per effort.
+
+Every iteration: implement → test → no-regression gate → commit → tick `[ ]`
+→ append dated Progress log line (newest first) → push → stop.
+
+## Ground rules (hard)
+
+- **Scope:** only `lib/commerce/**` and `plans/commerce-on-sx.md`. Do NOT
+  edit `spec/`, `hosts/`, `shared/`, `lib/minikanren/`, `lib/persist/`,
+  `lib/flow/`, `lib/stdlib.sx`, or `lib/` root. May **import** from
+  `lib/minikanren/`, and once they exist `lib/persist/` + `lib/flow/`.
+- **NEVER call `sx_build`.** 600s watchdog. If sx_server binary broken →
+  Blockers entry, stop.
+- **Money is integer minor units.** No floats anywhere. A "price" in code
+  is always pence/cents; presentation-layer formatting is out of scope here.
+- **Determinism is the contract.** Promotion stacking must have an
+  explicit, tested precedence. Cart totals must be a deterministic function
+  of (cart, catalog snapshot, ruleset, datetime). The same inputs must
+  produce identical outputs across runs.
+- **Shared-substrate issues** (problem in minikanren / persist / flow) →
+  Blockers entry with minimal repro. Do NOT patch around it.
+- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
+- **Worktree:** commit, push to `origin/loops/commerce`. Never touch `main`
+  or `architecture`.
+- **Commit granularity:** one feature per commit. Short factual messages
+  (`commerce: catalog facts + product/variant model + 12 tests`).
+- **Plan file:** update Progress log + tick boxes every commit.
+
+## Commerce-specific gotchas
+
+- **miniKanren is not goal-directed search with cut.** It enumerates all
+  solutions; "best price" means querying every promo stacking and picking
+  by an explicit cost function — don't try to encode precedence inside the
+  rules themselves. Use a separate selection layer.
+- **Tax is jurisdiction-relational.** Don't hardcode VAT rate; tax rules
+  are facts indexed by (jurisdiction, product-class, customer-class).
+- **Idempotency matters for orders.** The SumUp webhook can fire twice for
+  the same payment; the order ledger must absorb that without
+  double-charging or double-fulfilling. Idempotency keys live in `persist`.
+- **Flow suspension at payment boundary.** Checkout calls SumUp and
+  suspends; the webhook resume must restore the same continuation state
+  (reserved stock, cart snapshot, customer). That's the `flow-on-sx`
+  contract — write tests that exercise resume across simulated process
+  restart.
+- **Backward queries are the showcase.** "Which promo yields this total?"
+  and "Which line item triggered this discount?" should be miniKanren
+  queries with `run-1` / `run-all`, not separate code paths. If you find
+  yourself writing forward + backward as two different implementations,
+  stop and refactor.
+
+## General gotchas (all loops)
+
+- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
+- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples
+  in `begin`.
+- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks
+  scope chain).
+- `sx_validate` after every structural edit.
+- `list?` returns false on raw JS Arrays — host data must be SX-converted.
+
+## Style
+
+- No comments in `.sx` unless non-obvious.
+- No new planning docs — update `plans/commerce-on-sx.md` inline.
+- Short, factual commit messages.
+- One feature per iteration. Commit. Log. Push. Next.
+
+Go. Start by reading the plan; find the first unchecked `[ ]`; implement it.

plans/agent-briefings/content-loop.md

@@ -0,0 +1,115 @@
+# content-on-sx loop agent (single agent, phase-ordered)
+
+Role: iterates `plans/content-on-sx.md` forever. **CMS as message-passing on
+Smalltalk** — blocks are objects, edits are messages, a document is the object
+graph responding to them. Concurrent edits merge via a commutative CRDT so
+order doesn't matter. History is the `persist` event stream. External CMS
+(Ghost) sync is a thin injected adapter, not core.
+
+```
+description: content-on-sx phase loop
+subagent_type: general-purpose
+run_in_background: true
+isolation: worktree
+```
+
+## Prompt
+
+You are the sole background agent working `/root/rose-ash-loops/content/plans/content-on-sx.md`.
+Isolated worktree, forever, one commit per feature. Push to
+`origin/loops/content` after every commit. Never `main`, never `architecture`.
+
+## Restart baseline — check before iterating
+
+1. Read `plans/content-on-sx.md` — Phase queue + Progress log + Blockers.
+2. `ls lib/content/` — pick up from the most advanced file.
+3. If `lib/content/tests/*.sx` exist, run them via
+   `bash lib/content/conformance.sh`. Green before new work.
+4. Read `lib/smalltalk/smalltalk.sx` public API once — that's your object
+   model.
+5. Check substrate readiness:
+   - `bash lib/smalltalk/conformance.sh` — must be green
+   - `lib/persist/persist.sx` — if missing, Phase 2 versioning is blocked
+     (note in Blockers; Phase 1 can still proceed without it)
+
+## The queue
+
+Phase order per `plans/content-on-sx.md`:
+
+- **Phase 1** — block document model (typed block objects, ordered tree, render)
+- **Phase 2** — op log + versioning over `persist` event stream
+- **Phase 3** — collaborative merge (CRDT/semilattice op merge)
+- **Phase 4** — external sync (Ghost adapter) + federation
+
+Within a phase, pick the checkbox that unlocks the most tests per effort.
+
+Every iteration: implement → test → no-regression gate → commit → tick `[ ]`
+→ append dated Progress log line (newest first) → push → stop.
+
+## Ground rules (hard)
+
+- **Scope:** only `lib/content/**` and `plans/content-on-sx.md`. Do NOT
+  edit `spec/`, `hosts/`, `shared/`, `lib/smalltalk/`, `lib/persist/`,
+  `lib/stdlib.sx`, or `lib/` root. May **import** from `lib/smalltalk/`,
+  and once it exists `lib/persist/`.
+- **NEVER call `sx_build`.** 600s watchdog. If sx_server binary broken →
+  Blockers entry, stop.
+- **Determinism = merge commutativity + idempotence.** The CRDT property
+  isn't optional. Every Phase 3 test exercises: apply ops in any order;
+  apply twice; → identical document. If you can't prove that, the merge
+  function is wrong, not the test.
+- **Blocks are objects, not records.** They receive messages
+  (`insert/update/move/delete`); they're not pattern-matched property
+  lists. If you find yourself doing `case block of {heading, ...}`, you're
+  fighting the substrate. Smalltalk-on-SX gives you method dispatch — use
+  it.
+- **Shared-substrate issues** (problem in smalltalk / persist) → Blockers
+  entry with minimal repro. Do NOT patch around it.
+- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
+- **Worktree:** commit, push to `origin/loops/content`. Never touch `main`
+  or `architecture`.
+- **Commit granularity:** one feature per commit. Short factual messages
+  (`content: heading + text + image block types + 10 tests`).
+- **Plan file:** update Progress log + tick boxes every commit.
+
+## Content-specific gotchas
+
+- **Render is at the boundary.** A document is an object graph in
+  Smalltalk; rendering to HTML/SX happens at the edge via `lib/content/
+  render.sx`. The internal model doesn't carry presentation. Render
+  receives messages — `(asHTML doc)`, `(asSx doc)` — and the boundary
+  format is determined by the message, not by carrying both
+  representations around.
+- **CRDT is not "last-write-wins."** Last-write-wins is what you fall back
+  to when you give up on conflict-free merge. Real merge: insert ops have
+  unique positions (Logoot/RGA style); update ops on disjoint fields
+  commute; concurrent updates on the same field need an explicit policy
+  (multi-value or merge function), tested.
+- **Versioning is replay.** Any version of the document is the head of an
+  op stream up to a point. Don't store snapshots as primary state — they're
+  caches. The op log in `persist` is the source of truth.
+- **Ghost sync is an adapter, not a feature.** Treat it like a peripheral.
+  Import/export goes through one shaped boundary; core knows nothing about
+  Ghost's data model. If Ghost goes away, core doesn't change.
+- **Federated blocks need trust.** A peer-authored block carries provenance
+  (which actor, which signature). Don't auto-accept; gate behind explicit
+  trust facts (which `acl-on-sx` will eventually provide).
+
+## General gotchas (all loops)
+
+- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
+- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples
+  in `begin`.
+- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks
+  scope chain).
+- `sx_validate` after every structural edit.
+- `list?` returns false on raw JS Arrays — host data must be SX-converted.
+
+## Style
+
+- No comments in `.sx` unless non-obvious.
+- No new planning docs — update `plans/content-on-sx.md` inline.
+- Short, factual commit messages.
+- One feature per iteration. Commit. Log. Push. Next.
+
+Go. Start by reading the plan; find the first unchecked `[ ]`; implement it.

plans/agent-briefings/events-loop.md

@@ -0,0 +1,117 @@
+# events-on-sx loop agent (single agent, phase-ordered)
+
+Role: iterates `plans/events-on-sx.md` forever. **Calendar + ticketing as
+rule evaluation on Datalog** — events / availability / capacity as facts +
+rules; recurrence expands to occurrence facts within a window; bookings are
+transactions; reminders/digests are durable `flow`s over an injected
+notification transport. Pairs with `commerce-on-sx` for paid tickets.
+
+```
+description: events-on-sx phase loop
+subagent_type: general-purpose
+run_in_background: true
+isolation: worktree
+```
+
+## Prompt
+
+You are the sole background agent working `/root/rose-ash-loops/events/plans/events-on-sx.md`.
+Isolated worktree, forever, one commit per feature. Push to
+`origin/loops/events` after every commit. Never `main`, never `architecture`.
+
+## Restart baseline — check before iterating
+
+1. Read `plans/events-on-sx.md` — Phase queue + Progress log + Blockers.
+2. `ls lib/events/` — pick up from the most advanced file.
+3. If `lib/events/tests/*.sx` exist, run them via
+   `bash lib/events/conformance.sh`. Green before new work.
+4. Read `lib/datalog/datalog.sx` public API once — that's your engine.
+5. Check substrate readiness:
+   - `bash lib/datalog/conformance.sh` — must be green
+   - `lib/persist/persist.sx` — if missing, Phase 2 transactional booking
+     is blocked (note in Blockers; Phase 1 can still proceed without it)
+   - `lib/flow/flow.sx` — if missing, Phase 3 notification flows blocked
+
+## The queue
+
+Phase order per `plans/events-on-sx.md`:
+
+- **Phase 1** — calendar facts + RRULE expansion + availability rules
+- **Phase 2** — transactional booking (capacity-safe, persist-backed)
+- **Phase 3** — notification delivery flows (reminders, digests, retry)
+- **Phase 4** — federation: cross-instance calendars
+
+Within a phase, pick the checkbox that unlocks the most tests per effort.
+
+Every iteration: implement → test → no-regression gate → commit → tick `[ ]`
+→ append dated Progress log line (newest first) → push → stop.
+
+## Ground rules (hard)
+
+- **Scope:** only `lib/events/**` and `plans/events-on-sx.md`. Do NOT edit
+  `spec/`, `hosts/`, `shared/`, `lib/datalog/`, `lib/persist/`, `lib/flow/`,
+  `lib/stdlib.sx`, or `lib/` root. May **import** from `lib/datalog/`, and
+  once they exist `lib/persist/` + `lib/flow/`.
+- **NEVER call `sx_build`.** 600s watchdog. If sx_server binary broken →
+  Blockers entry, stop.
+- **Capacity safety is the contract.** Two concurrent bookings on the last
+  seat must NEVER both succeed. Test the race explicitly. The
+  capacity-check + append-event must be atomic at the persist boundary; if
+  persist doesn't expose that primitive, that's a substrate Blockers entry,
+  not a workaround.
+- **Recurrence is bounded.** Never expand an RRULE without a window. An
+  unbounded RRULE expansion is an infinite computation. Every API entry
+  that takes an event takes a (start, end) window too.
+- **Notifications are at-least-once.** Idempotency keys on every digest /
+  reminder. A retry must not double-deliver a sent message; the recipient
+  shouldn't see two "your event starts in 1h" pings.
+- **Shared-substrate issues** (problem in datalog / persist / flow) →
+  Blockers entry with minimal repro. Do NOT patch around it.
+- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
+- **Worktree:** commit, push to `origin/loops/events`. Never touch `main`
+  or `architecture`.
+- **Commit granularity:** one feature per commit. Short factual messages
+  (`events: weekly RRULE expansion + 14 tests`).
+- **Plan file:** update Progress log + tick boxes every commit.
+
+## Events-specific gotchas
+
+- **RRULE is well-trodden.** RFC 5545 defines the grammar; don't invent a
+  new recurrence DSL. Implement the subset rose-ash actually needs (daily,
+  weekly, monthly with byday, until/count) and explicitly defer the rest.
+- **Availability is constraint propagation.** Free/busy = forward-chained
+  Datalog: occurrence facts within window + booking facts + per-attendee
+  conflict rules. The same query answers "is X free?" and "when is X next
+  free?" (same rules, different bindings).
+- **Capacity ≠ availability.** Availability is per-actor; capacity is
+  per-event. A room with 50 seats has 50 capacity; the room "available" to
+  the 51st booker is `false` even though the room exists. Encode capacity
+  as a separate fact, not as an attribute of availability.
+- **Notification delivery is shared with feed/notify.** Don't build a
+  bespoke email/push transport — inject one and design the interface
+  generically. When `feed-on-sx` lands its notify path, the two consumers
+  should share a transport. Flag in Progress log when you build a shape
+  that's a candidate for `delivery-on-sx` extraction.
+- **Paid tickets cross subsystems.** A paid booking calls into
+  `commerce-on-sx` checkout flow. Don't import commerce here — define the
+  contract (request, callback shape) and have commerce import you (or both
+  import a contract module).
+
+## General gotchas (all loops)
+
+- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
+- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples
+  in `begin`.
+- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks
+  scope chain).
+- `sx_validate` after every structural edit.
+- `list?` returns false on raw JS Arrays — host data must be SX-converted.
+
+## Style
+
+- No comments in `.sx` unless non-obvious.
+- No new planning docs — update `plans/events-on-sx.md` inline.
+- Short, factual commit messages.
+- One feature per iteration. Commit. Log. Push. Next.
+
+Go. Start by reading the plan; find the first unchecked `[ ]`; implement it.

plans/agent-briefings/identity-loop.md

@@ -0,0 +1,128 @@
+# identity-on-sx loop agent (single agent, phase-ordered)
+
+Role: iterates `plans/identity-on-sx.md` forever. **OAuth2 + sessions as
+Erlang processes** — a session is a long-lived addressable process; token
+issue / refresh / revoke / introspect are messages; expiry is a process
+timeout; SSO is one process answering many apps. Pairs with `acl-on-sx`:
+identity proves "who is X"; acl decides "may X do Y".
+
+```
+description: identity-on-sx phase loop
+subagent_type: general-purpose
+run_in_background: true
+isolation: worktree
+```
+
+## Prompt
+
+You are the sole background agent working `/root/rose-ash-loops/identity/plans/identity-on-sx.md`.
+Isolated worktree, forever, one commit per feature. Push to
+`origin/loops/identity` after every commit. Never `main`, never
+`architecture`.
+
+## Restart baseline — check before iterating
+
+1. Read `plans/identity-on-sx.md` — Phase queue + Progress log + Blockers.
+2. `ls lib/identity/` — pick up from the most advanced file.
+3. If `lib/identity/tests/*.sx` exist, run them via
+   `bash lib/identity/conformance.sh`. Green before new work.
+4. Read `lib/erlang/runtime.sx` public API once — that's your process
+   substrate.
+5. Check substrate readiness:
+   - `bash lib/erlang/conformance.sh` — must be green
+   - `lib/persist/persist.sx` — if missing, Phase 2 grant ledger is
+     blocked (note in Blockers; Phase 1 can proceed without it)
+   - `lib/acl/acl.sx` — if missing, Phase 3 grant-checking is blocked
+
+## The queue
+
+Phase order per `plans/identity-on-sx.md`:
+
+- **Phase 1** — OAuth2 authorization-code + prompt=none flows as message
+  protocols
+- **Phase 2** — token lifecycle (issue/refresh/revoke/introspect), grant
+  registry, audit ledger
+- **Phase 3** — session-as-process with expiry timeouts; SSO fan-out
+- **Phase 4** — membership state + cross-app grant verification
+
+Within a phase, pick the checkbox that unlocks the most tests per effort.
+
+Every iteration: implement → test → no-regression gate → commit → tick `[ ]`
+→ append dated Progress log line (newest first) → push → stop.
+
+## Ground rules (hard)
+
+- **Scope:** only `lib/identity/**` and `plans/identity-on-sx.md`. Do NOT
+  edit `spec/`, `hosts/`, `shared/`, `lib/erlang/`, `lib/persist/`,
+  `lib/acl/`, `lib/stdlib.sx`, or `lib/` root. May **import** from
+  `lib/erlang/`, and once they exist `lib/persist/` + `lib/acl/`.
+- **NEVER call `sx_build`.** 600s watchdog. If sx_server binary broken →
+  Blockers entry, stop.
+- **Revocation must be real.** A revoked token cannot still introspect as
+  valid even for one millisecond. Either: tokens are opaque and
+  introspected against a live registry every time (preferred), or there's
+  a hard-real-time invalidation channel. Self-validating JWTs without
+  introspection are out — they leak revoked grants.
+- **Authorization is somewhere else.** identity DOES NOT decide
+  permissions. It proves who. Every "is this allowed?" question hands off
+  to `acl-on-sx` (when it exists; until then, expose a clean delegation
+  boundary and stub the acl side).
+- **Negative answers are explicit.** "Not authenticated" is a state. "I
+  don't know who you are" is a 401, not a 500, not a "well I guess so."
+  Tests cover the negative path as much as the happy path.
+- **Audit everything that changes a grant.** Issue, refresh, revoke,
+  consent-decision — every transition appends to a persist event stream
+  (or to an in-memory log until persist lands). The ledger is queryable.
+- **Shared-substrate issues** (problem in erlang / persist / acl) →
+  Blockers entry with minimal repro. Do NOT patch around it.
+- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
+- **Worktree:** commit, push to `origin/loops/identity`. Never touch `main`
+  or `architecture`.
+- **Commit granularity:** one feature per commit. Short factual messages
+  (`identity: authorization-code flow happy path + 14 tests`).
+- **Plan file:** update Progress log + tick boxes every commit.
+
+## Identity-specific gotchas
+
+- **OAuth2 is a state machine, not a function.** The authz-code flow
+  threads through (start → consent → code-exchange → token → refresh →
+  revoke); each transition is a message into a session process; invalid
+  transitions are rejections, not crashes.
+- **Silent SSO (`prompt=none`) is a fast-path through the same machine.**
+  Don't duplicate the implementation. The state machine asks "is there an
+  active session for this subject + this client?"; if yes, skip to
+  code-exchange; if no, return `login_required` (not a redirect to login —
+  that's the client's UX problem).
+- **Token storage is the registry, not the token.** Tokens are opaque
+  binaries; the registry is the source of truth. `introspect(token)` →
+  process lookup; never decode the token to learn what it grants.
+- **Session expiry is a timeout, not a cron.** Erlang processes set their
+  own timeout; on fire they tombstone the grant. Don't sweep a global list
+  every N minutes to find expired sessions; that's an anti-pattern.
+- **Per-app first-party cookies are an HTTP-layer concern, not core.**
+  Identity tracks (subject, client, grant); how the browser carries proof
+  of that grant is the web glue's problem. Don't tangle cookie SameSite
+  policy into the grant machine.
+- **OAuth2 is harder than it looks.** Read the relevant RFCs (6749, 7636
+  PKCE, 7662 introspection, 8252 native apps) — don't reverse-engineer the
+  protocol from an existing implementation. Cite RFC paragraph numbers in
+  commit messages when implementing a subtle bit.
+
+## General gotchas (all loops)
+
+- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
+- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples
+  in `begin`.
+- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks
+  scope chain).
+- `sx_validate` after every structural edit.
+- `list?` returns false on raw JS Arrays — host data must be SX-converted.
+
+## Style
+
+- No comments in `.sx` unless non-obvious.
+- No new planning docs — update `plans/identity-on-sx.md` inline.
+- Short, factual commit messages.
+- One feature per iteration. Commit. Log. Push. Next.
+
+Go. Start by reading the plan; find the first unchecked `[ ]`; implement it.

plans/commerce-on-sx.md

@@ -21,7 +21,7 @@ reconciliation — all auditable via the event log.
 
 ## Status (rolling)
 
-`bash lib/commerce/conformance.sh` → **0/0** (not yet started)
+`bash lib/commerce/conformance.sh` → **132/132** (8 suites: catalog, cart, price, api, promo, stack, quote, ledger) — Phases 1-2 done; Phase 3 ledger done
 
 ## Ground rules
 
@@ -55,20 +55,20 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
 ```
 
 ## Phase 1 — Catalog + cart + deterministic totals
-- [ ] `catalog.sx` — product/variant/stock as facts
+- [x] `catalog.sx` — product/variant/stock as facts
-- [ ] `cart.sx` — line items, add/remove/qty
+- [x] `cart.sx` — line items, add/remove/qty
-- [ ] `price.sx` — base pricing relation, subtotal; tax
+- [x] `price.sx` — base pricing relation, subtotal; tax
-- [ ] `api.sx` + tests + scoreboard + conformance.sh
+- [x] `api.sx` + tests + scoreboard + conformance.sh
 
 ## Phase 2 — Promotions (relational)
-- [ ] promo rules: percentage, fixed, bundle, member rate
+- [x] promo rules: percentage, fixed, bundle, member rate
-- [ ] explicit stacking precedence; "best price" backward query
+- [x] explicit stacking precedence; "best price" backward query
-- [ ] tests: stacking order, mutually-exclusive promos, member vs guest
+- [x] tests: stacking order, mutually-exclusive promos, member vs guest
 
 ## Phase 3 — Order lifecycle (flow + store)
 - [ ] order flow: reserve stock → await payment → fulfil
 - [ ] payment webhook resumes the suspended flow
-- [ ] order ledger as a `persist` stream; idempotent reconciliation
+- [x] order ledger as a `persist` stream; idempotent reconciliation
 
 ## Phase 4 — Reconciliation + federation
 - [ ] mismatch detection (paid≠ordered) as queries over the ledger
@@ -76,7 +76,64 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
 - [ ] tests: webhook replay, partial refund, double-charge guard
 
 ## Progress log
-(loop fills this in)
+- 2026-06-07 — `ledger.sx` (Phase 3 piece, checkbox 3): order ledger as a
+  persist event stream "order/<id>". Status/total/paid/recon are projections
+  (folds) over events — ledger is the single source of truth. `order-pay`/
+  `order-refund` are idempotent via `persist/append-once` keyed on the payment
+  ref, so a replayed SumUp webhook records once (no double-charge). `order-recon-of`
+  classifies :unpaid/:ok/:underpaid/:overpaid on net (paid−refunded) vs total;
+  `ledger-mismatches` finds genuine paid≠ordered across all streams. Verified
+  minikanren+scheme/flow+persist all coexist in one sx_server process. ledger
+  suite 20/20; total 132/132. Next: order flow (reserve→pay→fulfil) as a Scheme
+  flow-on-sx flow with webhook resume (checkboxes 1-2) — needs SX↔Scheme quote
+  marshalling.
+- 2026-06-07 — `quote.sx` (pricing capstone, bridges Phase 2→3): `cart-quote`
+  composes price+promo+stacking into the deterministic priced quote
+  `{:subtotal :discount :tax :total :codes}` with `total = subtotal - discount
+  + tax`. Explicit tax policy: tax on GROSS per-line amounts (discount reduces
+  payable, not tax base) — documented for the determinism contract. This quote
+  is the value the Phase-3 order flow will carry. quote suite 13/13; total
+  112/112.
+- 2026-06-07 — `stack.sx` (**Phase 2 complete**): stacking precedence as a
+  separate selection layer (precedence NOT in the rules, per the miniKanren
+  design rule). Exclusivity = unordered code pairs; `valid-stackings` enumerates
+  every legal subset of applicable promos (powerset ∖ excluded combos);
+  `best-stacking` is the deterministic max-total-discount selection (stable on
+  ties). `stacking-by-totalo` is the best-price backward query ("which legal
+  stacking yields total D?"). Member vs guest falls out of applicable-promos.
+  stack suite 16/16; total 99/99.
+- 2026-06-07 — `promo.sx` (Phase 2 piece 1): four promo types as tagged tuples
+  `(:percent code class bps)`/`(:fixed code threshold amount)`/`(:bundle code sku
+  n)`/`(:member code class bps)`. Per-promo discount is pure integer arithmetic;
+  `promo-discounto`/`promo-applieso` enumerate (code, amount) relationally —
+  forward ("which apply?") and backward ("which code yields 2000?" → run* over
+  applieso). `applicable-promos`/`promo-amount-for` deterministic helpers. promo
+  amounts via `project` to ground the membero-bound promo. promo suite 17/17;
+  total 83/83. Next: stacking precedence + best-price (stack.sx).
+- 2026-06-06 — `api.sx` (**Phase 1 complete**): session facade
+  `{:ctx :cart}` with `commerce-add`/`-remove`/`-set-qty`/`-total`/`-count`/
+  `-lines`, `commerce-can-add?` catalog validation, `commerce-explain` per-line
+  audit breakdown ({:sku :variant :qty :unit :extended :tax}), and a
+  `commerce-checkout` Phase-3 stub. api suite 12/12; total 66/66.
+- 2026-06-06 — `price.sx`: deterministic `cart-subtotal` (Σ unit×qty, variant
+  delta defaults 0) + jurisdiction-relational tax. `taxo` facts indexed by
+  (jurisdiction, product-class, customer-class)→bps, queried multidirectionally;
+  `apply-bps` rounds half-up with integer arithmetic only. `cart-total` returns
+  `{:subtotal :discounts :tax :total}` (discounts 0 until Phase 2), reproducible
+  from (context, cart). `=` does structural dict equality (order-independent), so
+  total dicts compare directly. price suite 20/20; total 54/54.
+- 2026-06-06 — `cart.sx`: cart as an ordered list of (sku variant qty) lines.
+  Pure ops `cart-add` (merges same line / appends), `cart-set-qty` (0 removes),
+  `cart-remove`, plus `cart-qty`/`cart-count`/`cart-skus`/`cart-empty?`.
+  `cart-lineo` is the relational view (membero over the cart) — forward and
+  backward. cart suite 18/18; total 34/34.
+- 2026-06-06 — `catalog.sx`: catalog snapshot (products/variants/stock as fact
+  tuples) + multidirectional accessor relations (`producto`/`varianto`/`stocko`,
+  derived `priceo`/`classo`/`unit-priceo`) + deterministic `catalog-price`/
+  `-class`/`-has?` helpers. `conformance.sh` harness + scoreboard. catalog suite
+  16/16. Gotcha: minikanren `run-n` macro binds `s` internally — query vars must
+  avoid `s`; tests compare reified results with `=` (not `equal?`, which fails on
+  reified lists). Money = integer minor units throughout.
 
 ## Blockers
-(loop fills this in)
+(none)