commerce: provider-neutral payment-request envelope (8 tests) — Phase 5 ext

payment.sx — payment-request materialises {:order :amount :currency :return-url} at the IO edge (amount from the ledger, currency/return-url host-supplied), so lib/commerce stays vendor-agnostic; SumUp/Stripe adapters live in the orders service and order-settle!(ref, amount) is the resume seam. pending-payments enumerates suspended orders + envelopes (host poller seam). Gotcha handled: a Scheme string flow-payload round-trips back wrapped as {:scm-string ...} — unwrapped via scm->string. Total 209/209 across 13 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
commerce: line-level discount attribution (16 tests) — Phase 5 ext
2026-06-07 11:04:16 +00:00 · 2026-06-07 10:30:38 +00:00 · 2026-06-07 10:02:54 +00:00 · 2026-06-07 09:55:12 +00:00 · 2026-06-07 09:54:25 +00:00 · 2026-06-07 09:20:04 +00:00
33 changed files with 2887 additions and 306 deletions
--- a/hosts/ocaml/bin/sx_server.ml
+++ b/hosts/ocaml/bin/sx_server.ml
@@ -855,164 +855,6 @@ let setup_evaluator_bridge env =
      done;
      Nil
    | _ -> raise (Eval_error "http-listen: (port handler)"));
  (* fed-sx Milestone 1 client direction (Phase J). NATIVE ONLY —
     Unix sockets + DNS; absent from the WASM kernel. HTTP/1.1
     request: TCP connect, write request line + headers + body,
     read status + headers + body, return {:status :headers :body}.
     URL must be http://...; HTTPS is a later phase (needs TLS).
     Body read: Content-Length first, else read to EOF (we send
     Connection: close). Transfer-Encoding: chunked is rejected —
     fed-sx Phase 8 wires this for inter-server POSTs which will
     all carry Content-Length. *)
  Sx_primitives.register "http-request" (fun args ->
    let strip_cr s =
      let n = String.length s in
      if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
    in
    match args with
    | [String meth; String url; headers_v; body_v] ->
      let body = match body_v with
        | String s -> s
        | Nil -> ""
        | v -> Sx_types.value_to_string v in
      let prefix = "http://" in
      let plen = String.length prefix in
      let ulen = String.length url in
      if ulen < plen || String.sub url 0 plen <> prefix
      then raise (Eval_error "http-request: URL must start with http://");
      let rest = String.sub url plen (ulen - plen) in
      let host_port, path =
        match String.index_opt rest '/' with
        | Some i ->
          String.sub rest 0 i,
          String.sub rest i (String.length rest - i)
        | None -> rest, "/" in
      if host_port = "" then
        raise (Eval_error "http-request: missing host");
      let host, port =
        match String.index_opt host_port ':' with
        | Some i ->
          let h = String.sub host_port 0 i in
          let ps = String.sub host_port (i + 1)
                     (String.length host_port - i - 1) in
          (h,
           (try int_of_string ps with _ ->
              raise (Eval_error "http-request: bad port")))
        | None -> host_port, 80 in
      let addr =
        (try (Unix.gethostbyname host).h_addr_list.(0)
         with Not_found ->
           raise (Eval_error ("http-request: dns: " ^ host))) in
      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
      let cleanup () = try Unix.close sock with _ -> () in
      let result =
        (try
          (try Unix.connect sock (Unix.ADDR_INET (addr, port))
           with Unix.Unix_error (e, _, _) ->
             raise (Eval_error
                      ("http-request: connect: " ^ Unix.error_message e)));
          let oc = Unix.out_channel_of_descr sock in
          let ic = Unix.in_channel_of_descr sock in
          let buf = Buffer.create 256 in
          Buffer.add_string buf
            (Printf.sprintf "%s %s HTTP/1.1\r\n" meth path);
          let host_hdr_sent = ref false in
          let clen_sent = ref false in
          let conn_sent = ref false in
          (match headers_v with
           | Dict h ->
             Hashtbl.iter (fun k v ->
               let kl = String.lowercase_ascii k in
               if kl = "host" then host_hdr_sent := true;
               if kl = "content-length" then clen_sent := true;
               if kl = "connection" then conn_sent := true;
               let vs = match v with
                 | String s -> s
                 | x -> Sx_types.value_to_string x in
               Buffer.add_string buf
                 (Printf.sprintf "%s: %s\r\n" k vs)) h
           | Nil -> ()
           | _ -> raise (Eval_error "http-request: headers must be dict"));
          if not !host_hdr_sent then
            Buffer.add_string buf
              (Printf.sprintf "Host: %s\r\n" host_port);
          if not !clen_sent then
            Buffer.add_string buf
              (Printf.sprintf "Content-Length: %d\r\n"
                 (String.length body));
          if not !conn_sent then
            Buffer.add_string buf "Connection: close\r\n";
          Buffer.add_string buf "\r\n";
          Buffer.add_string buf body;
          output_string oc (Buffer.contents buf);
          flush oc;
          let sl =
            (try strip_cr (input_line ic)
             with End_of_file ->
               raise (Eval_error
                        "http-request: connection closed before status")) in
          let status =
            match String.split_on_char ' ' sl with
            | _ver :: code :: _ ->
              (try int_of_string code with _ ->
                 raise (Eval_error "http-request: bad status code"))
            | _ -> raise (Eval_error "http-request: bad status line") in
          let rhdrs = Sx_types.make_dict () in
          let clen = ref (-1) in
          let chunked = ref false in
          let rec rdh () =
            let h =
              (try strip_cr (input_line ic)
               with End_of_file -> "") in
            if h = "" then ()
            else begin
              (match String.index_opt h ':' with
               | Some i ->
                 let name =
                   String.lowercase_ascii
                     (String.trim (String.sub h 0 i)) in
                 let value =
                   String.trim
                     (String.sub h (i + 1)
                        (String.length h - i - 1)) in
                 Hashtbl.replace rhdrs name (String value);
                 if name = "content-length" then
                   (try clen := int_of_string value with _ -> ())
                 else if name = "transfer-encoding" &&
                         String.lowercase_ascii value = "chunked"
                 then chunked := true
               | None -> ());
              rdh ()
            end in
          rdh ();
          if !chunked then
            raise (Eval_error
                     "http-request: chunked transfer-encoding not supported");
          let rbody =
            if !clen >= 0 then begin
              let b = Bytes.create !clen in
              really_input ic b 0 !clen;
              Bytes.unsafe_to_string b
            end else begin
              let b = Buffer.create 256 in
              (try
                 while true do
                   Buffer.add_channel b ic 4096
                 done; assert false
               with End_of_file -> ());
              Buffer.contents b
            end in
          let resp = Sx_types.make_dict () in
          Hashtbl.replace resp "status" (Integer status);
          Hashtbl.replace resp "headers" (Dict rhdrs);
          Hashtbl.replace resp "body" (String rbody);
          Dict resp
        with e -> cleanup (); raise e) in
      cleanup ();
      result
    | _ -> raise (Eval_error "http-request: (method url headers body)"));
  bind "trampoline" (fun args ->
    match args with
    | [v] ->
--- a/hosts/ocaml/bin/test_http_client.sh
+++ b/hosts/ocaml/bin/test_http_client.sh
@@ -1,80 +0,0 @@
 #!/usr/bin/env bash
 # Phase J test — native-only http-request client primitive.
 # Reuses Phase H's http-listen to spin up an echo server, then drives
 # a separate sx_server via the epoch protocol to issue http-request
 # calls and assert response shape + headers + body.
 set -u
 cd "$(dirname "$0")/.."
 SRV=_build/default/bin/sx_server.exe
 PORT=${HTTP_CLIENT_TEST_PORT:-8921}
 PASS=0
 FAIL=0
 ok()  { echo "  PASS: $1"; PASS=$((PASS+1)); }
 bad() { echo "  FAIL: $1 — $2"; FAIL=$((FAIL+1)); }
 if [ ! -x "$SRV" ]; then
  echo "build sx_server.exe first (dune build bin/sx_server.exe)"; exit 1
 fi
 # /echo echoes method/path/query/body and reflects request X-Custom
 # back as response X-Got; /missing-test → 404.
 H='(begin (define (h req) (if (= (get req "path") "/echo") {:status 200 :headers {"X-Echo" (get req "method") "X-Got" (get (get req "headers") "x-custom")} :body (str "M=" (get req "method") " P=" (get req "path") " Q=" (get req "query") " B=" (get req "body"))} (if (= (get req "path") "/missing-test") {:status 404 :body "nope"} {:status 500 :body "err"}))) (http-listen '"$PORT"' h))'
 ESC=${H//\"/\\\"}
 { printf '(epoch 1)\n(eval "%s")\n' "$ESC"; sleep 60; } | "$SRV" >/tmp/test_http_client_srv.out 2>&1 &
 SVPID=$!
 trap 'kill $SVPID 2>/dev/null; wait 2>/dev/null' EXIT
 up=0
 for _ in $(seq 1 50); do
  curl -s -o /dev/null "http://127.0.0.1:$PORT/echo" 2>/dev/null && { up=1; break; }
  sleep 0.2
 done
 [ "$up" = 1 ] || { echo "  FAIL: server did not start"; cat /tmp/test_http_client_srv.out; exit 1; }
 emit() {
  # $1 = epoch num, $2 = raw SX form. Wraps in (eval "...") with quotes escaped.
  local esc=${2//\"/\\\"}
  printf '(epoch %s)\n(eval "%s")\n' "$1" "$esc"
 }
 DRV_OUT=/tmp/test_http_client_drv.out
 {
  emit 1 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo?x=1" {} ""))) (str "S=" (get r "status") " E=" (get (get r "headers") "x-echo") " B=" (get r "body")))'
  emit 2 '(let ((r (http-request "POST" "http://127.0.0.1:'"$PORT"'/echo" {} "hello"))) (str "S=" (get r "status") " B=" (get r "body")))'
  emit 3 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/missing-test" {} ""))) (str "S=" (get r "status") " B=" (get r "body")))'
  emit 4 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo" {"X-Custom" "myval"} ""))) (get (get r "headers") "x-got"))'
  emit 5 '(http-request "GET" "ftp://nope" {} "")'
  emit 6 '(let ((r (http-request "GET" "http://127.0.0.1:'"$PORT"'/echo" {} ""))) (get r "status"))'
 } | "$SRV" >"$DRV_OUT" 2>&1
 # eval results come back as (ok-len N L)\n<body>\n — grep the body content.
 grep -q '^"S=200 E=GET B=M=GET P=/echo Q=x=1 B="$' "$DRV_OUT" \
  && ok "GET status + echo header + body" \
  || bad "GET" "$(grep -A1 '^(ok-len 1 ' "$DRV_OUT" | tail -1)"
 grep -q '^"S=200 B=M=POST P=/echo Q= B=hello"$' "$DRV_OUT" \
  && ok "POST body roundtrip" \
  || bad "POST" "$(grep -A1 '^(ok-len 2 ' "$DRV_OUT" | tail -1)"
 grep -q '^"S=404 B=nope"$' "$DRV_OUT" \
  && ok "404 status + body" \
  || bad "404" "$(grep -A1 '^(ok-len 3 ' "$DRV_OUT" | tail -1)"
 grep -q '^"myval"$' "$DRV_OUT" \
  && ok "custom request header reaches server" \
  || bad "custom-header" "$(grep -A1 '^(ok-len 4 ' "$DRV_OUT" | tail -1)"
 R5=$(grep '^(error 5 ' "$DRV_OUT" | head -1)
 echo "$R5" | grep -q 'URL must start with http' \
  && ok "non-http scheme rejected" \
  || bad "bad-url" "$R5"
 # Status is an Integer (200), serialized bare without quotes.
 grep -q '^200$' "$DRV_OUT" \
  && ok "response status is integer 200" \
  || bad "status-integer" "$(grep -A1 '^(ok-len 6 ' "$DRV_OUT" | tail -1)"
 echo "Results: $PASS passed, $FAIL failed"
 [ "$FAIL" = 0 ]
--- a/lib/commerce/api.sx
+++ b/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}))
--- a/lib/commerce/attribution.sx
+++ b/lib/commerce/attribution.sx
@@ -0,0 +1,100 @@
 ;; lib/commerce/attribution.sx — line-level discount attribution.
 ;;
 ;; The briefing's marquee backward query: "which line item triggered this
 ;; discount?". promo.sx computes discount amounts at the class/order level;
 ;; this layer answers the *scope* question relationally and in both directions:
 ;;   forward  — which lines does code C touch?   (lines-for-code)
 ;;   backward — which codes touch this line?     (codes-for-line)
 ;; Both are the same relation promo-toucheso run with different vars bound.
 ;;
 ;; A :fixed promo is order-level (touches no single line); query those with
 ;; order-level-codes. Only promos that actually apply (amount > 0) touch lines.
 ;; Lines whose sku is in product-class `cls`.
 (define
  class-lines
  (fn
    (ctx cart cls)
    (filter
      (fn (l) (= (catalog-class (ctx-catalog ctx) (line-sku l)) cls))
      cart)))
 ;; The lines a promo applies to (its scope). :fixed is order-level → no lines.
 (define
  promo-lines
  (fn
    (ctx cart p)
    (let
      ((k (promo-kind p)))
      (cond
        ((= k :percent) (class-lines ctx cart (nth p 2)))
        ((= k :member)
          (if
            (= (get ctx :customer) :member)
            (class-lines ctx cart (nth p 2))
            (list)))
        ((= k :bundle)
          (filter (fn (l) (= (line-sku l) (nth p 2))) cart))
        (:else (list))))))
 ;; Relation: promo `code` touches `line`. Only applying promos (amount > 0)
 ;; touch anything, so an inapplicable promo contributes no pairs.
 (define
  promo-toucheso
  (fn
    (ctx cart ruleset code line)
    (fresh
      (p)
      (membero p ruleset)
      (project
        (p)
        (if
          (> (promo-amount ctx cart p) 0)
          (mk-conj
            (== code (promo-code p))
            (membero line (promo-lines ctx cart p)))
          fail)))))
 ;; --- query helpers ---
 (define
  lines-for-code
  (fn
    (ctx cart ruleset code)
    (run* line (promo-toucheso ctx cart ruleset code line))))
 (define
  codes-for-line
  (fn
    (ctx cart ruleset line)
    (run* code (promo-toucheso ctx cart ruleset code line))))
 (define
  line-touched-by?
  (fn
    (ctx cart ruleset code line)
    (not
      (empty?
        (run
          1
          c
          (mk-conj (promo-toucheso ctx cart ruleset code line) (== c true)))))))
 ;; Applying order-level (:fixed) promos — discounts with no single line.
 (define
  order-level-codes
  (fn
    (ctx cart ruleset)
    (run*
      code
      (fresh
        (p)
        (membero p ruleset)
        (project
          (p)
          (if
            (and
              (> (promo-amount ctx cart p) 0)
              (= (promo-kind p) :fixed))
            (== code (promo-code p))
            fail))))))
--- a/lib/commerce/cart.sx
+++ b/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)))
--- a/lib/commerce/catalog.sx
+++ b/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)))))
--- a/lib/commerce/conformance.sh
+++ b/lib/commerce/conformance.sh
@@ -0,0 +1,149 @@
 #!/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 order recon federation attribution payment)
 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/guest/lex.sx")
 (load "lib/guest/reflective/env.sx")
 (load "lib/guest/reflective/quoting.sx")
 (load "lib/scheme/parser.sx")
 (load "lib/scheme/eval.sx")
 (load "lib/scheme/runtime.sx")
 (load "lib/flow/spec.sx")
 (load "lib/flow/store.sx")
 (load "lib/flow/remote.sx")
 (load "lib/flow/host.sx")
 (load "lib/flow/api.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")
 (load "lib/commerce/order.sx")
 (load "lib/commerce/payment.sx")
 (load "lib/commerce/recon.sx")
 (load "lib/commerce/federation.sx")
 (load "lib/commerce/attribution.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 560 "$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 ]
--- a/lib/commerce/federation.sx
+++ b/lib/commerce/federation.sx
@@ -0,0 +1,86 @@
 ;; lib/commerce/federation.sx — cross-instance catalog (federated marketplace).
 ;;
 ;; STUB: instances are registered in-process; there is no real network or
 ;; ActivityPub transport here (that lives in the federation service). The point
 ;; is the relational model: a federated catalog is just the UNION of each
 ;; instance's product facts, tagged with origin, so the same miniKanren
 ;; relations answer cross-instance questions — "which instances sell this sku?",
 ;; "which is cheapest?" — as backward queries, no new query engine.
 (define federation-stub? true)
 (define make-federation (fn (instance cat) {:instances (list (list instance cat))}))
 (define
  federation-add
  (fn
    (fed instance cat)
    (assoc
      fed
      :instances (append (get fed :instances) (list (list instance cat))))))
 (define federation-instances (fn (fed) (map first (get fed :instances))))
 ;; Flatten to (instance sku price class) origin-tagged tuples.
 (define
  fed-products
  (fn
    (fed)
    (reduce
      (fn
        (acc pair)
        (let
          ((instance (first pair)) (cat (nth pair 1)))
          (append
            acc
            (map (fn (p) (cons instance p)) (get cat :products)))))
      (list)
      (get fed :instances))))
 ;; --- relations over the federated catalog (multidirectional) ---
 (define
  fed-producto
  (fn
    (fed instance sku price class)
    (membero (list instance sku price class) (fed-products fed))))
 (define
  fed-priceo
  (fn
    (fed instance sku price)
    (fresh (c) (fed-producto fed instance sku price c))))
 ;; --- query helpers ---
 ;; Which instances carry a sku? (backward query)
 (define
  instances-with-sku
  (fn (fed sku) (run* inst (fresh (p c) (fed-producto fed inst sku p c)))))
 ;; All (price instance) offers for a sku, in federation order.
 (define
  sku-offers
  (fn
    (fed sku)
    (run*
      pair
      (fresh
        (inst p c)
        (fed-producto fed inst sku p c)
        (== pair (list p inst))))))
 ;; Cheapest (price instance) for a sku — the deterministic selection layer.
 (define
  cheapest-offer
  (fn
    (fed sku)
    (let
      ((offers (sku-offers fed sku)))
      (if
        (empty? offers)
        nil
        (reduce
          (fn (best x) (if (< (first x) (first best)) x best))
          (first offers)
          offers)))))
--- a/lib/commerce/ledger.sx
+++ b/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))))
--- a/lib/commerce/order.sx
+++ b/lib/commerce/order.sx
@@ -0,0 +1,119 @@
 ;; lib/commerce/order.sx — order lifecycle as a durable flow-on-sx flow.
 ;;
 ;; The lifecycle (reserve -> await payment -> fulfil) is a Scheme flow running
 ;; in the flow-on-sx guest (lib/flow). The flow is PURE ORCHESTRATION: it
 ;; carries only the order-id and enforces step ordering + the suspension at the
 ;; payment IO boundary. All IO/state lives in SX: the SX driver here services
 ;; each flow request by appending to the persist ledger (ledger.sx).
 ;;
 ;;   reserve  -> SX appends :reserved, resumes  (synchronous host effect)
 ;;   payment  -> flow stays SUSPENDED until the SumUp webhook resumes it
 ;;   fulfil   -> SX appends :fulfilled, resumes (synchronous host effect)
 ;;
 ;; Durability: the flow's replay log is plain data (flow-store-export), so a
 ;; suspended order survives a process restart — order-flow-restart! simulates
 ;; that entirely Scheme-side. Idempotency: order-settle! only resumes a flow
 ;; still waiting on payment, so a replayed webhook is a no-op at the flow level,
 ;; and order-pay is idempotent at the ledger level.
 ;; The flow definition (Scheme source). oid is in scope throughout the begin.
 (define
  order-flow-src
  "(defflow order-lifecycle (lambda (oid) (begin (request (quote reserve) oid) (request (quote payment) oid) (request (quote fulfil) oid))))")
 ;; Build a flow env with the order flow registered. Never returns the env from
 ;; an eval boundary (the env is large/cyclic — serializing it hangs).
 (define
  order-make-env
  (fn
    ()
    (let
      ((env (flow-make-env)))
      (begin (flow-run-in env order-flow-src) env))))
 ;; --- thin Scheme bridge (string-interpolated flow ops) ---
 (define
  order-flow-start
  (fn
    (env oid)
    (flow-run-in env (str "(flow/start order-lifecycle \"" oid "\")"))))
 (define
  order-flow-resume
  (fn
    (env id sym)
    (flow-run-in env (str "(flow/resume " id " (quote " sym "))"))))
 (define
  order-flow-status
  (fn (env id) (flow-run-in env (str "(flow/status " id ")"))))
 (define
  order-flow-result
  (fn (env id) (flow-run-in env (str "(flow/result " id ")"))))
 ;; The request kind the flow with this id is waiting on, or nil if it is not
 ;; suspended on a host request (done / cancelled / unknown).
 (define
  order-flow-waiting
  (fn
    (env id)
    (let
      ((reqs (flow-run-in env "(flow-host-requests)")))
      (let
        ((mine (filter (fn (r) (= (first r) id)) reqs)))
        (if (empty? mine) nil (nth (first mine) 1))))))
 ;; Id out of a (flow-suspended id tag) start/resume result.
 (define order-susp-id (fn (susp) (nth susp 1)))
 ;; --- high-level lifecycle (flow + ledger composed) ---
 ;; Create the order, start the flow, service the reserve step, and leave the
 ;; flow suspended at payment. Returns the flow id (needed to settle later).
 (define
  order-begin!
  (fn
    (env b oid at quote)
    (begin
      (order-create b oid at quote)
      (let
        ((id (order-susp-id (order-flow-start env oid))))
        (begin
          (order-reserve b oid (+ at 1) {})
          (order-flow-resume env id :reserved)
          id)))))
 ;; Settle a payment: record it, resume the flow past payment, service fulfil.
 ;; Idempotent — only acts when the flow is still waiting on payment, so a
 ;; replayed webhook returns :already-settled without double-charging.
 (define
  order-settle!
  (fn
    (env b id oid ref at amount)
    (if
      (= (order-flow-waiting env id) "payment")
      (begin
        (order-pay b oid ref at amount)
        (order-flow-resume env id :paid)
        (order-fulfil b oid (+ at 1) {})
        (order-flow-resume env id :fulfilled)
        :settled)
      :already-settled)))
 ;; Simulate a process restart: export the flow store, reset the runtime, reload
 ;; the flow definition, reimport the store. Done entirely Scheme-side so the
 ;; (large) store is never marshalled across the boundary. The persist ledger is
 ;; a separate store and is unaffected. Suspended flows resume afterwards.
 (define
  order-flow-restart!
  (fn
    (env)
    (flow-run-in
      env
      (str
        "(begin (define _saved (flow-store-export)) "
        flow-reset-src
        " "
        order-flow-src
        " (flow-store-import! _saved) #t)"))))
--- a/lib/commerce/payment.sx
+++ b/lib/commerce/payment.sx
@@ -0,0 +1,41 @@
 ;; lib/commerce/payment.sx — provider-neutral payment-request envelope.
 ;;
 ;; The order flow (order.sx) suspends on `(request 'payment oid)` — it carries
 ;; ONLY the order-id and calls no provider. This layer materialises, at the IO
 ;; edge, the envelope a provider adapter needs to initiate payment:
 ;;
 ;;   {:order oid :amount <ledger total> :currency C :return-url U}
 ;;
 ;; amount comes from the ledger (the :created quote total); currency + return-url
 ;; are host/provider config (legitimately host-supplied). The engine stays
 ;; vendor-agnostic: SumUp/Stripe/etc. adapters consume this envelope, and
 ;; order-settle!(ref, amount) is the vendor-neutral resume seam. No provider
 ;; SDK, HTTP, or webhook parsing lives here — that is the orders service's job.
 (define payment-request (fn (b oid currency return-url) {:order oid :amount (order-total b oid) :return-url return-url :currency currency}))
 (define payment-request-order (fn (pr) (get pr :order)))
 (define payment-request-amount (fn (pr) (get pr :amount)))
 (define payment-request-currency (fn (pr) (get pr :currency)))
 (define payment-request-return-url (fn (pr) (get pr :return-url)))
 ;; A Scheme string carried as a flow payload round-trips back to SX wrapped as
 ;; {:scm-string "..."}; unwrap it to the bare order-id.
 (define
  scm->string
  (fn
    (v)
    (if (and (dict? v) (has-key? v :scm-string)) (get v :scm-string) v)))
 ;; Host poller seam: every order currently suspended awaiting payment, each with
 ;; its envelope. A provider adapter iterates these, initiates payment, and later
 ;; calls order-settle! when the webhook arrives. Needs the flow env.
 (define
  pending-payments
  (fn
    (env b currency return-url)
    (let
      ((reqs (flow-run-in env "(flow-host-requests)")))
      (map
        (fn (r) {:id (first r) :request (payment-request b (scm->string (nth r 2)) currency return-url)})
        (filter (fn (r) (= (nth r 1) "payment")) reqs)))))
--- a/lib/commerce/price.sx
+++ 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}))))
--- a/lib/commerce/promo.sx
+++ b/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)))))
--- a/lib/commerce/quote.sx
+++ b/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)))
--- a/lib/commerce/recon.sx
+++ b/lib/commerce/recon.sx
@@ -0,0 +1,100 @@
 ;; lib/commerce/recon.sx — reconciliation as relational queries over the ledger.
 ;;
 ;; The ledger (ledger.sx) is the source of truth; reconciliation projects it
 ;; into per-order summary tuples and then asks miniKanren questions about them.
 ;; "Which orders are overpaid?" / "which order settled to net N?" are backward
 ;; queries (run*) over the same relation, not separate code paths.
 ;;
 ;; A summary tuple is positional:
 ;;   (order-stream total paid refunded net status)
 ;; net = paid - refunded; status = :unpaid|:ok|:underpaid|:overpaid.
 (define
  order-summary
  (fn
    (b stream)
    (let
      ((events (persist/read b stream)))
      (let
        ((total (order-total-of events))
          (paid (order-paid-amount-of events))
          (refunded (order-refunded-amount-of events)))
        (list
          stream
          total
          paid
          refunded
          (- paid refunded)
          (order-recon-of events))))))
 (define
  ledger-summaries
  (fn (b) (map (fn (s) (order-summary b s)) (persist/backend-streams b))))
 ;; --- relations over the summary set ---
 (define
  summaryo
  (fn
    (summaries id total paid refunded net status)
    (membero (list id total paid refunded net status) summaries)))
 (define
  recon-statuso
  (fn
    (summaries id status)
    (fresh (t p r n) (summaryo summaries id t p r n status))))
 (define
  neto
  (fn
    (summaries id net)
    (fresh (t p r status) (summaryo summaries id t p r net status))))
 ;; A mismatch is any order whose money does not reconcile (over or under).
 (define
  mismatcho
  (fn
    (summaries id)
    (fresh
      (status)
      (recon-statuso summaries id status)
      (conde ((== status :underpaid)) ((== status :overpaid))))))
 ;; --- deterministic query helpers (run* over the live ledger) ---
 (define
  orders-with-status
  (fn (b status) (run* id (recon-statuso (ledger-summaries b) id status))))
 (define overpaid-orders (fn (b) (orders-with-status b :overpaid)))
 (define underpaid-orders (fn (b) (orders-with-status b :underpaid)))
 (define settled-orders (fn (b) (orders-with-status b :ok)))
 (define unpaid-orders (fn (b) (orders-with-status b :unpaid)))
 (define
  mismatched-orders
  (fn (b) (run* id (mismatcho (ledger-summaries b) id))))
 ;; Backward: which order(s) settled to a given net amount?
 (define
  orders-with-net
  (fn (b net) (run* id (neto (ledger-summaries b) id net))))
 ;; Total signed discrepancy across the ledger (net - total over paid orders);
 ;; 0 when every settled order reconciles exactly.
 (define
  ledger-discrepancy
  (fn
    (b)
    (reduce
      (fn
        (acc s)
        (let
          ((status (nth s 5)))
          (if
            (= status :unpaid)
            acc
            (+ acc (- (nth s 4) (nth s 1))))))
      0
      (ledger-summaries b))))
--- a/lib/commerce/scoreboard.json
+++ b/lib/commerce/scoreboard.json
@@ -0,0 +1,20 @@
 {
  "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},
    "order": {"pass": 22, "fail": 0},
    "recon": {"pass": 20, "fail": 0},
    "federation": {"pass": 12, "fail": 0},
    "attribution": {"pass": 16, "fail": 0},
    "payment": {"pass": 7, "fail": 0}
  },
  "total_pass": 209,
  "total_fail": 0,
  "total": 209
 }
--- a/lib/commerce/scoreboard.md
+++ b/lib/commerce/scoreboard.md
@@ -0,0 +1,20 @@
 # 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 |
 | order | 22 | 0 | 22 |
 | recon | 20 | 0 | 20 |
 | federation | 12 | 0 | 12 |
 | attribution | 16 | 0 | 16 |
 | payment | 7 | 0 | 7 |
 | **Total** | **209** | **0** | **209** |
--- a/lib/commerce/stack.sx
+++ b/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))))
--- a/lib/commerce/tests/api.sx
+++ b/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)
--- a/lib/commerce/tests/attribution.sx
+++ b/lib/commerce/tests/attribution.sx
@@ -0,0 +1,124 @@
 ;; lib/commerce/tests/attribution.sx — line-level discount attribution.
 ;; Uses (commerce-test name got expected) provided by conformance.sh.
 (define
  pcat
  (make-catalog
    (list
      (list "widget" 1000 :standard)
      (list "gizmo" 2000 :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 2)
    (list "gizmo" :none 1)
    (list "book" :none 1)
    (list "tea" :none 6)))
 (define
  ruleset
  (list
    (list :percent "TEN" :standard 1000)
    (list :percent "TWENTY" :standard 2000)
    (list :bundle "B3T" "tea" 3)
    (list :fixed "FIVE" 0 500)
    (list :member "MEM" :standard 1500)))
 (define w-line (list "widget" :none 2))
 (define t-line (list "tea" :none 6))
 (define bk-line (list "book" :none 1))
 ;; --- scope helpers ---
 (commerce-test
  "class-lines-standard"
  (class-lines gctx cart :standard)
  (list (list "widget" :none 2) (list "gizmo" :none 1)))
 (commerce-test
  "promo-lines-bundle"
  (promo-lines gctx cart (list :bundle "B3T" "tea" 3))
  (list (list "tea" :none 6)))
 (commerce-test
  "promo-lines-fixed-none"
  (promo-lines gctx cart (list :fixed "FIVE" 0 500))
  (list))
 ;; --- forward: which lines does a code touch? ---
 (commerce-test
  "lines-for-ten"
  (lines-for-code gctx cart ruleset "TEN")
  (list (list "widget" :none 2) (list "gizmo" :none 1)))
 (commerce-test
  "lines-for-bundle"
  (lines-for-code gctx cart ruleset "B3T")
  (list (list "tea" :none 6)))
 (commerce-test
  "lines-for-fixed-empty"
  (lines-for-code gctx cart ruleset "FIVE")
  (list))
 (commerce-test
  "lines-for-mem-guest-empty"
  (lines-for-code gctx cart ruleset "MEM")
  (list))
 ;; --- backward: which codes touch this line? (the showcase) ---
 (commerce-test
  "codes-for-widget-guest"
  (codes-for-line gctx cart ruleset w-line)
  (list "TEN" "TWENTY"))
 (commerce-test
  "codes-for-tea"
  (codes-for-line gctx cart ruleset t-line)
  (list "B3T"))
 (commerce-test
  "codes-for-book-none"
  (codes-for-line gctx cart ruleset bk-line)
  (list))
 ;; member sees the member rate too
 (commerce-test
  "codes-for-widget-member"
  (codes-for-line mctx cart ruleset w-line)
  (list "TEN" "TWENTY" "MEM"))
 (commerce-test
  "lines-for-mem-member"
  (lines-for-code mctx cart ruleset "MEM")
  (list (list "widget" :none 2) (list "gizmo" :none 1)))
 ;; --- predicate ---
 (commerce-test
  "touched-yes"
  (line-touched-by? gctx cart ruleset "TEN" w-line)
  true)
 (commerce-test
  "touched-no-wrong-class"
  (line-touched-by? gctx cart ruleset "B3T" w-line)
  false)
 (commerce-test
  "touched-no-guest-mem"
  (line-touched-by? gctx cart ruleset "MEM" w-line)
  false)
 ;; --- order-level (fixed) codes ---
 (commerce-test
  "order-level"
  (order-level-codes gctx cart ruleset)
  (list "FIVE"))
--- a/lib/commerce/tests/cart.sx
+++ b/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"))
--- a/lib/commerce/tests/catalog.sx
+++ b/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)
--- a/lib/commerce/tests/federation.sx
+++ b/lib/commerce/tests/federation.sx
@@ -0,0 +1,88 @@
 ;; lib/commerce/tests/federation.sx — federated catalog (out-of-scope stub).
 ;; Uses (commerce-test name got expected) provided by conformance.sh.
 (define
  cat-a
  (make-catalog
    (list
      (list "widget" 1000 :standard)
      (list "book" 800 :zero-rated))
    (list)
    (list)))
 (define
  cat-b
  (make-catalog
    (list
      (list "widget" 900 :standard)
      (list "tea" 1200 :reduced))
    (list)
    (list)))
 (define
  cat-c
  (make-catalog (list (list "widget" 1100 :standard)) (list) (list)))
 (define
  fed
  (federation-add
    (federation-add (make-federation :alpha cat-a) :beta cat-b)
    :gamma cat-c))
 ;; --- structure ---
 (commerce-test "is-stub" federation-stub? true)
 (commerce-test
  "instances"
  (federation-instances fed)
  (list :alpha :beta :gamma))
 (commerce-test "product-count" (len (fed-products fed)) 5)
 ;; --- forward query ---
 (commerce-test
  "price-at-instance"
  (run* p (fed-priceo fed :beta "widget" p))
  (list 900))
 ;; --- backward queries (the showcase) ---
 (commerce-test
  "instances-with-widget"
  (instances-with-sku fed "widget")
  (list :alpha :beta :gamma))
 (commerce-test
  "instances-with-book"
  (instances-with-sku fed "book")
  (list :alpha))
 (commerce-test
  "instances-with-tea"
  (instances-with-sku fed "tea")
  (list :beta))
 (commerce-test
  "instance-by-price-backward"
  (run* inst (fresh (c) (fed-producto fed inst "widget" 1100 c)))
  (list :gamma))
 ;; --- offers + cheapest (deterministic selection) ---
 (commerce-test
  "widget-offers"
  (sku-offers fed "widget")
  (list
    (list 1000 :alpha)
    (list 900 :beta)
    (list 1100 :gamma)))
 (commerce-test
  "cheapest-widget"
  (cheapest-offer fed "widget")
  (list 900 :beta))
 (commerce-test
  "cheapest-book"
  (cheapest-offer fed "book")
  (list 800 :alpha))
 (commerce-test "cheapest-missing" (cheapest-offer fed "ghost") nil)
--- a/lib/commerce/tests/ledger.sx
+++ b/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"))))
--- a/lib/commerce/tests/order.sx
+++ b/lib/commerce/tests/order.sx
@@ -0,0 +1,74 @@
 ;; lib/commerce/tests/order.sx — order lifecycle as a flow-on-sx flow.
 ;; Uses (commerce-test name got expected) provided by conformance.sh.
 ;; Builds the (expensive) flow env once; all assertions share it.
 (define env (order-make-env))
 (define b (persist/mem-backend))
 (define q1 {:codes (list) :subtotal 1000 :discount 0 :total 1200 :tax 200})
 ;; --- happy path: begin suspends at payment ---
 (define id1 (order-begin! env b "O1" 100 q1))
 (commerce-test "begin-status-reserved" (order-status b "O1") :reserved)
 (commerce-test "begin-waiting-payment" (order-flow-waiting env id1) "payment")
 (commerce-test "begin-not-yet-paid" (order-paid b "O1") 0)
 ;; --- settle: payment webhook drives fulfilment ---
 (define s1 (order-settle! env b id1 "O1" "ref-1" 102 1200))
 (commerce-test "settle-result" s1 :settled)
 (commerce-test "settle-status-fulfilled" (order-status b "O1") :fulfilled)
 (commerce-test "settle-flow-done" (order-flow-status env id1) "done")
 (commerce-test "settle-recon-ok" (order-recon b "O1") :ok)
 (commerce-test "settle-event-count" (len (order-events b "O1")) 4)
 ;; --- webhook replay: a second settle is a no-op ---
 (define s1b (order-settle! env b id1 "O1" "ref-1" 102 1200))
 (commerce-test "replay-already-settled" s1b :already-settled)
 (commerce-test
  "replay-no-extra-events"
  (len (order-events b "O1"))
  4)
 (commerce-test "replay-recon-still-ok" (order-recon b "O1") :ok)
 ;; --- a second order gets its own flow id and suspends independently ---
 (define id2 (order-begin! env b "O2" 200 q1))
 (commerce-test "second-distinct-id" (not (= id1 id2)) true)
 (commerce-test
  "second-waiting-payment"
  (order-flow-waiting env id2)
  "payment")
 (commerce-test "first-unaffected" (order-status b "O1") :fulfilled)
 ;; --- durability: a suspended order survives a process restart ---
 (define id3 (order-begin! env b "O3" 300 q1))
 (commerce-test "pre-restart-waiting" (order-flow-waiting env id3) "payment")
 (define _restart (order-flow-restart! env))
 (commerce-test
  "post-restart-still-waiting"
  (order-flow-waiting env id3)
  "payment")
 (commerce-test "post-restart-ledger-intact" (order-status b "O3") :reserved)
 (define s3 (order-settle! env b id3 "O3" "ref-3" 302 1200))
 (commerce-test "post-restart-settled" s3 :settled)
 (commerce-test "post-restart-status" (order-status b "O3") :fulfilled)
 (commerce-test "post-restart-recon-ok" (order-recon b "O3") :ok)
 (commerce-test "post-restart-flow-done" (order-flow-status env id3) "done")
 ;; --- payment-request envelope (provider-neutral) for the still-suspended O2 ---
 (commerce-test
  "pending-payments-lists-suspended"
  (pending-payments env b :GBP "https://shop/return")
  (list {:id id2 :request {:order "O2" :amount 1200 :return-url "https://shop/return" :currency :GBP}}))
--- a/lib/commerce/tests/payment.sx
+++ b/lib/commerce/tests/payment.sx
@@ -0,0 +1,43 @@
 ;; lib/commerce/tests/payment.sx — provider-neutral payment-request envelope.
 ;; Uses (commerce-test name got expected) provided by conformance.sh.
 ;; Envelope construction is ledger-only (no flow env); pending-payments (which
 ;; needs the flow env) is exercised in the order suite.
 (define q1 {:codes (list) :subtotal 1000 :discount 0 :total 1200 :tax 200})
 (define q2 {:codes (list) :subtotal 5000 :discount 500 :total 4500 :tax 0})
 (define b (persist/mem-backend))
 (define _c1 (order-create b "P1" 1 q1))
 (define _c2 (order-create b "P2" 1 q2))
 (commerce-test
  "envelope"
  (payment-request b "P1" :GBP "https://shop/return")
  {:order "P1" :amount 1200 :return-url "https://shop/return" :currency :GBP})
 (commerce-test
  "envelope-amount"
  (payment-request-amount (payment-request b "P1" :GBP "x"))
  1200)
 (commerce-test
  "envelope-currency"
  (payment-request-currency (payment-request b "P1" :GBP "x"))
  :GBP)
 (commerce-test
  "envelope-order"
  (payment-request-order (payment-request b "P1" :GBP "x"))
  "P1")
 (commerce-test
  "envelope-return-url"
  (payment-request-return-url (payment-request b "P1" :GBP "https://r"))
  "https://r")
 ;; amount tracks the ledger total, currency is per-call (provider/instance config)
 (commerce-test
  "envelope-amount-2"
  (payment-request-amount (payment-request b "P2" :EUR "x"))
  4500)
 (commerce-test
  "envelope-currency-2"
  (payment-request-currency (payment-request b "P2" :EUR "x"))
  :EUR)
--- a/lib/commerce/tests/price.sx
+++ b/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})
--- a/lib/commerce/tests/promo.sx
+++ b/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)
--- a/lib/commerce/tests/quote.sx
+++ b/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)
--- a/lib/commerce/tests/recon.sx
+++ b/lib/commerce/tests/recon.sx
@@ -0,0 +1,109 @@
 ;; lib/commerce/tests/recon.sx — reconciliation as relational ledger queries.
 ;; Uses (commerce-test name got expected) provided by conformance.sh.
 (define q1 {:codes (list) :subtotal 1000 :discount 0 :total 1200 :tax 200})
 (define b (persist/mem-backend))
 ;; OK1 — clean payment
 (define _ok (order-create b "OK1" 1 q1))
 (define _okp (order-pay b "OK1" "ok-ref" 2 1200))
 ;; OVER1 — double charge under two different refs
 (define _ov (order-create b "OVER1" 1 q1))
 (define _ova (order-pay b "OVER1" "ov-a" 2 1200))
 (define _ovb (order-pay b "OVER1" "ov-b" 3 1200))
 ;; UNDER1 — short payment
 (define _un (order-create b "UNDER1" 1 q1))
 (define _unp (order-pay b "UNDER1" "un-ref" 2 900))
 ;; PART1 — paid in full, then partially refunded
 (define _pa (order-create b "PART1" 1 q1))
 (define _pap (order-pay b "PART1" "pa-ref" 2 1200))
 (define _par (order-refund b "PART1" "pa-rf" 3 200))
 ;; REPLAY1 — webhook fires twice with the same ref (idempotent)
 (define _rp (order-create b "REPLAY1" 1 q1))
 (define _rpa (order-pay b "REPLAY1" "rp-ref" 2 1200))
 (define _rpb (order-pay b "REPLAY1" "rp-ref" 2 1200))
 ;; PEND1 — created, not yet paid
 (define _pe (order-create b "PEND1" 1 q1))
 ;; --- summaries ---
 (commerce-test "summary-count" (len (ledger-summaries b)) 6)
 (commerce-test
  "summary-ok1"
  (order-summary b "order/OK1")
  (list "order/OK1" 1200 1200 0 1200 :ok))
 (commerce-test
  "summary-part1"
  (order-summary b "order/PART1")
  (list "order/PART1" 1200 1200 200 1000 :underpaid))
 ;; --- forward status query ---
 (commerce-test
  "status-forward-ok"
  (run* st (recon-statuso (ledger-summaries b) "order/OK1" st))
  (list :ok))
 ;; --- backward status queries (the showcase) ---
 (commerce-test
  "settled"
  (sort (settled-orders b))
  (sort (list "order/OK1" "order/REPLAY1")))
 (commerce-test "overpaid" (overpaid-orders b) (list "order/OVER1"))
 (commerce-test
  "underpaid"
  (sort (underpaid-orders b))
  (sort (list "order/UNDER1" "order/PART1")))
 (commerce-test "unpaid" (unpaid-orders b) (list "order/PEND1"))
 (commerce-test
  "mismatched"
  (sort (mismatched-orders b))
  (sort (list "order/OVER1" "order/UNDER1" "order/PART1")))
 ;; --- backward net-amount query ---
 (commerce-test
  "net-1200"
  (sort (orders-with-net b 1200))
  (sort (list "order/OK1" "order/REPLAY1")))
 (commerce-test
  "net-2400"
  (orders-with-net b 2400)
  (list "order/OVER1"))
 (commerce-test
  "net-900"
  (orders-with-net b 900)
  (list "order/UNDER1"))
 ;; --- discrepancy: +1200 (over) - 300 (under) - 200 (refund) = 700 ---
 (commerce-test "discrepancy" (ledger-discrepancy b) 700)
 ;; --- double-charge guard ---
 (commerce-test "double-charge-detected" (order-recon b "OVER1") :overpaid)
 (commerce-test "double-charge-amount" (order-paid b "OVER1") 2400)
 ;; --- partial refund ---
 (commerce-test "partial-refund-net" (order-recon b "PART1") :underpaid)
 (commerce-test
  "partial-refund-amount"
  (order-refunded-amount-of (order-events b "PART1"))
  200)
 ;; --- webhook replay: same ref twice records once ---
 (commerce-test
  "replay-single-event"
  (len (order-events b "REPLAY1"))
  2)
 (commerce-test "replay-paid-once" (order-paid b "REPLAY1") 1200)
 (commerce-test "replay-settled" (order-recon b "REPLAY1") :ok)
--- a/lib/commerce/tests/stack.sx
+++ b/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)
--- a/plans/commerce-on-sx.md
+++ b/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` → **209/209** (13 suites; + payment) — **roadmap complete; Phase 5 extensions in progress**
 ## Ground rules
@@ -55,28 +55,179 @@ 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
+- [x] order flow: reserve stock → await payment → fulfil
- [ ] payment webhook resumes the suspended flow
+- [x] 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
+- [x] mismatch detection (paid≠ordered) as queries over the ledger
- [ ] cross-instance catalog (federated marketplace) — out-of-scope stub
+- [x] cross-instance catalog (federated marketplace) — out-of-scope stub
- [ ] tests: webhook replay, partial refund, double-charge guard
+- [x] tests: webhook replay, partial refund, double-charge guard
 ## Phase 5 — Extensions (backlog; base roadmap complete)
 Thesis-aligned deepenings of the relational/composition showcase. Pick the one
 that unlocks the most tests per effort each iteration.
 - [x] line-level discount attribution — "which line item triggered this discount?"
  as a backward miniKanren query (`attribution.sx`: `promo-toucheso` relation,
  `lines-for-code`/`codes-for-line` both directions, `order-level-codes` for fixed).
 - [ ] time-windowed promotions — promos gated by a validity window; quote takes a
  datetime, determinism preserved. (quote.sx already documents datetime intent.)
 - [ ] discount-aware tax policy — alternative `cart-quote` computing tax on the
  net (post-discount) base via proportional class allocation; explicit + tested.
 - [ ] refund as a flow — refund lifecycle (request → approve → settle) as a second
  flow-on-sx flow, recorded in the ledger; idempotent.
 - [ ] stock-constrained reservation — order-begin! fails (railway `fail`) when
  requested qty exceeds stocko availability; reservation decrements a stock view.
 - [x] provider-neutral payment-request envelope — `payment.sx`: `payment-request`
  materialises `{:order :amount :currency :return-url}` at the IO edge (amount from
  the ledger, currency/return-url host-supplied); `pending-payments` enumerates
  suspended orders with their envelopes (host poller seam). Engine stays vendor-
  agnostic; `order-settle!(ref, amount)` is the resume seam.
 ## Progress log
-(loop fills this in)
+- 2026-06-07 — `payment.sx` (Phase 5 ext, the item the user asked about):
  provider-neutral payment-request envelope, materialised at the IO edge from the
  ledger amount + host-supplied currency/return-url — keeps lib/commerce vendor-
  agnostic (SumUp/Stripe adapters live in the orders service). `payment-request`
  builds the `{:order :amount :currency :return-url}` envelope; `pending-payments`
  is the host-poller seam listing suspended orders + their envelopes. Gotcha: a
  Scheme **string** carried as a flow payload round-trips back to SX wrapped as
  `{:scm-string "..."}` (numbers come back clean) — unwrap via `scm->string`
  before using it as the oid. payment suite 7/7 + 1 order-suite integration test;
  total 209/209 (13 suites).
 - 2026-06-07 — `attribution.sx` (Phase 5 ext): line-level discount attribution —
  the briefing's marquee "which line item triggered this discount?" query.
  `promo-lines` is the pure per-promo scope (percent/member → class lines, bundle
  → sku lines, fixed → order-level/none); `promo-toucheso` relates (code, line)
  for applying promos, run forward (`lines-for-code`) and backward
  (`codes-for-line`). `order-level-codes` lists applying fixed promos; predicate
  `line-touched-by?`. Additive — promo.sx amounts unchanged. attribution suite
  16/16; total 201/201 (12 suites).
 - 2026-06-07 — `recon.sx` + `federation.sx` (**Phase 4 complete — roadmap done**).
  `recon.sx`: reconciliation as relational queries over the ledger. Per-order
  summary tuples (id total paid refunded net status); `recon-statuso`/`neto`/
  `mismatcho` are miniKanren relations, so "which orders are overpaid?",
  "settled to net N?" are backward `run*` queries. Helpers: overpaid/underpaid/
  settled/unpaid-orders, mismatched-orders, orders-with-net, ledger-discrepancy.
  Tests cover double-charge guard (two refs → :overpaid), partial refund (net <
  total → :underpaid), webhook replay (same ref twice → single :paid, :ok). 20/20.
  `federation.sx` (out-of-scope stub): a federated catalog is the UNION of each
  instance's product facts, so the SAME relations query cross-instance —
  `fed-producto`/`fed-priceo`, `instances-with-sku`, `sku-offers`, deterministic
  `cheapest-offer`. In-process mock, no real network/ActivityPub. 12/12.
  Total 185/185 across 11 suites.
 - 2026-06-07 — `order.sx` (**Phase 3 complete**, checkboxes 1-2): order lifecycle
  as a flow-on-sx flow `(lambda (oid) (begin (request 'reserve oid) (request
  'payment oid) (request 'fulfil oid)))` — pure orchestration carrying only the
  order-id; the SX driver services each request by appending to the persist
  ledger. `order-begin!` creates+reserves and leaves the flow SUSPENDED at
  payment; `order-settle!` (the webhook) resumes → fulfils, and is idempotent
  (only acts while waiting on payment, so a replayed webhook → :already-settled).
  `order-flow-restart!` simulates a process restart entirely Scheme-side
  (export→reset→reload→import) and the suspended order resumes correctly
  afterwards with the persist ledger intact. Composes all three substrates
  (minikanren pricing → flow lifecycle → persist ledger). order suite 21/21;
  total 153/153. Gotchas: flow ids start at 1; never return flow-make-env across
  the eval boundary (serializer hangs on the cyclic env); guest Scheme rejects
  `:ok` keyword as a value — use `#t`. Flow env build ~150s CPU; order suite runs
  single-process with timeout 560.
 - 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.
 ## Phase 3 flow-integration notes (for the next iteration)
 Order flow = checkboxes 1-2 (reserve→pay→fulfil as a flow-on-sx flow + webhook
 resume). Design is settled; the remaining work is mechanical but slow to iterate.
 - **flow is the Scheme-on-SX guest layer**, not the SX/minikanren host. Load
  order: `lib/guest/{lex,reflective/env,reflective/quoting}` + `lib/scheme/{parser,
  eval,runtime}` + `lib/flow/{spec,store,remote,host,api}`. Confirmed it coexists
  with the minikanren + persist stacks in one sx_server process.
 - **Driver API (SX side):** `(flow-make-env)` builds the env once; `(flow-run-in
  env "<scheme-src>")` evaluates a Scheme program string. Flows/driving are all
  Scheme: `(flow/start flow input)`, `(flow/resume id val)`, `(flow/pending)`,
  `(flow/status id)`, `(flow/result id)`. Host ABI (host.sx): `(request kind
  payload)` suspends with a typed envelope; `(flow-host-requests)` lists pending.
 - **Settled design:** the Scheme flow carries ONLY the order-id (a string) and is
  pure orchestration: `(defflow ordf (lambda (oid) (begin (request 'reserve oid)
  (request 'payment oid) (request 'fulfil oid))))`. All IO/ledger work stays in
  SX — the SX driver services each request by appending to the persist ledger
  (ledger.sx) and resuming with a marker. Payment stays suspended until the
  webhook calls flow/resume. Marshalling is trivial (just strings).
 - **GOTCHA (cost me a turn):** `flow-make-env` returns a large/likely-cyclic env
  object; returning it from `(eval "...")` makes the harness serializer hang (got
  exit 0 with NO epoch-2 output). NEVER return the env — wrap as `(begin (define
  env (flow-make-env)) :ok)`. Structure the flow suite like `lib/flow/conformance.sh`:
  load once, build env once, run all assertions in ONE process returning small
  count values. Budget a long timeout (flow's own suite uses 540s); env build is
  ~150s CPU and balloons under sibling-agent CPU contention.
 ## Blockers
-(loop fills this in)
+(none)
--- a/plans/fed-sx-host-primitives.md
+++ b/plans/fed-sx-host-primitives.md
@@ -145,44 +145,6 @@ check** → tests → commit → tick box → Progress-log line → push.
 - **Acceptance:** curl test script green; WASM build untouched (prim not in lib).
  Satisfies fed-sx Step 8 transport.
 ### Phase J — HTTP/1.1 client, **native-only** (`bin/sx_server.ml`) ✅ DONE
 - Mirror of Phase H, inverse direction. TCP connect via `Unix.gethostbyname` +
  `Unix.socket`/`Unix.connect`. Write request line + headers + body, read
  response status line + headers + body (Content-Length first; chunked
  encoding optional v2 — flag as Blockers if a fed-sx need hits it).
 - Primitive `(http-request method url headers body) -> response-dict`
  registered ONLY in `bin/sx_server.ml`. Response dict shape:
  `{:status :headers :body}` (mirror of server's request dict). URL must be
  `http://...` for v1; HTTPS is a separate later phase (needs TLS lib).
 - Tests: `bin/test_http_client.sh` — start a tiny python HTTP server in a
  subprocess (or reuse Phase H's SX server), drive GET / POST / 404 /
  custom-header roundtrip via `(http-request ...)` from the epoch protocol,
  assert response dict shape + body, kill server.
 - **Acceptance:** test script green; WASM build untouched (prim not in lib);
  Erlang conformance unchanged. Unblocks Erlang Phase 8 `httpc:request/4` BIF
  wiring and fed-sx Milestone 2 federation `POST /inbox` outbound.
 ### Phase K — URL parser, pure OCaml, WASM-safe (`lib/sx_url.ml`)
 - `(url-parse "http://host:port/path?q=1") -> {:scheme :host :port :path :query}`
  — small recursive-descent parser. No external deps. Port is integer when
  present, absent key otherwise (or default per scheme: 80/443).
 - `(url-encode-component string) -> string` /
  `(url-decode-component string) -> string` — percent-encoding per RFC 3986
  (reserved/unreserved sets).
 - Tests: `bin/test_url.ml` — full URL, port-less, path-only, query string with
  multiple pairs, empty path, percent-encoding round-trips, malformed inputs
  (return error-shaped result, not exception).
 - **Acceptance:** WASM boot green (pure lib); supports fed-sx kernel actor URL
  parsing and Phase J HTTP-client url handling.
 ### Phase L — (open) further client prims as fed-sx kernel needs surface
 - Add new phases here as the kernel loop or design conversations identify
  needs: chunked HTTP transfer encoding, HTTPS / TLS verify (likely opam-dep
  Blockers), webfinger HTTP shape, DNS (probably folded into `http-request`).
 - Each new phase: define test vectors / contract → implement → WASM-check
  (skip for native-only) → commit → Progress log. Same iteration discipline as
  A–I.
 ### Phase I — handoff ✅ DONE
 - Flip the `plans/erlang-on-sx.md` Blockers entry "SX runtime lacks platform
  primitives …" to **RESOLVED**, listing the exact SX primitive names so the
@@ -264,20 +226,6 @@ should leave `httpc`/`sqlite` BIFs blocked with that note.
 _Newest first._
 - 2026-05-26 — Phase J: `http-request` primitive in `bin/sx_server.ml`
  (NATIVE ONLY — `Unix.gethostbyname` + `Unix.connect`; HTTP/1.1 with
  inline `http://` URL parser; sends Connection: close + Host +
  Content-Length unless caller supplies them; reads status line +
  headers + body via Content-Length, falling back to read-to-EOF;
  Transfer-Encoding: chunked rejected with explicit error per plan).
  Test `bin/test_http_client.sh` spins up a Phase-H echo server in a
  background sx_server and drives a second sx_server with epoch
  `(eval …)` calls: GET+query, POST+body, 404, custom request
  header reflected back, non-http scheme rejected (error path),
  integer status — 6/6 pass. NOT in lib/ so WASM boot untouched
  (green); Erlang conformance 530/530 unchanged; run_tests
  unchanged. Unblocks Erlang Phase 8 `httpc:request/4` BIF wiring
  and fed-sx Milestone 2 federation `POST /inbox` outbound.
 - 2026-05-18 — Phase I: handoff. `erlang-on-sx.md` Blockers gained one
  RESOLVED entry (no "SX runtime lacks…" entry pre-existed; it read
  "_(none yet)_") mapping every delivered primitive → its Phase 8 BIF,
Author	SHA1	Message	Date
giles	eb7e6be147	commerce: provider-neutral payment-request envelope (8 tests) — Phase 5 ext Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 1m10s Details payment.sx — payment-request materialises {:order :amount :currency :return-url} at the IO edge (amount from the ledger, currency/return-url host-supplied), so lib/commerce stays vendor-agnostic; SumUp/Stripe adapters live in the orders service and order-settle!(ref, amount) is the resume seam. pending-payments enumerates suspended orders + envelopes (host poller seam). Gotcha handled: a Scheme string flow-payload round-trips back wrapped as {:scm-string ...} — unwrapped via scm->string. Total 209/209 across 13 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 11:04:16 +00:00
giles	563fac9e62	commerce: line-level discount attribution (16 tests) — Phase 5 ext Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 1m5s Details attribution.sx — the briefing's marquee "which line item triggered this discount?" backward query. promo-lines gives each promo's pure scope (percent/member -> class lines, bundle -> sku lines, fixed -> order-level); promo-toucheso relates (code, line) for applying promos, run forward (lines-for-code) and backward (codes-for-line). Additive; promo amounts unchanged. Total 201/201 across 12 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 10:30:38 +00:00
giles	1312a16111	commerce: add provider-neutral payment-request envelope to Phase 5 backlog Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 52s Details Carries {:order :amount :currency :return-url} on the 'payment suspension so any provider's host adapter can initiate payment without the engine knowing the vendor; order-settle!(ref, amount) stays the vendor-neutral resume seam. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 10:02:54 +00:00
giles	498b61e9b3	commerce: mark roadmap complete + record Phase 5 extension backlog Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 1m11s Details Base roadmap (Phases 1-4) done at 185/185. Records thesis-aligned extension candidates (line-level discount attribution, time-windowed promos, discount-aware tax, refund flow, stock-constrained reservation) for subsequent loop iterations. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 09:55:12 +00:00
giles	a4275c4944	commerce: reconciliation queries + federated-catalog stub (32 tests) — Phase 4 done Some checks failed Test, Build, and Deploy / test-build-deploy (push) Has been cancelled Details recon.sx — reconciliation as relational queries over the ledger: per-order summary tuples + recon-statuso/neto/mismatcho miniKanren relations, so overpaid/underpaid/settled and "settled to net N" are backward run* queries. Tests cover double-charge guard, partial refund, webhook replay. federation.sx (out-of-scope stub) — a federated catalog is the union of each instance's product facts, so the same relations query cross-instance (instances-with-sku, sku-offers, cheapest-offer). In-process mock, no network. Completes the commerce-on-sx roadmap (Phases 1-4). Total 185/185 across 11 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 09:54:25 +00:00
giles	85b288d22b	commerce: order lifecycle as a durable flow-on-sx flow (21 tests) — Phase 3 done Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 57s Details order.sx — reserve -> await-payment -> fulfil as a flow-on-sx flow carrying only the order-id; the SX driver services each request by appending to the persist ledger. order-begin! creates+reserves and suspends at payment; order-settle! (webhook) resumes -> fulfils, idempotent on replay (:already-settled). order-flow-restart! simulates a process restart Scheme-side and the suspended order resumes with the ledger intact. Composes all three substrates: minikanren pricing -> flow lifecycle -> persist ledger. Total 153/153 across 9 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 09:20:04 +00:00
giles	cda35a1ed8	commerce: record Phase 3 flow-integration design + gotchas for next iteration Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 1m7s Details Settled design for order flow (checkboxes 1-2): Scheme flow carries only the order-id, SX driver does all ledger IO. Key gotcha captured: never return flow-make-env from eval (serializer hangs on the cyclic env); run the flow suite single-process like flow's own conformance with a long timeout. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 08:59:22 +00:00
giles	a5ac0818c2	commerce: order ledger on persist + idempotent reconciliation (20 tests) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 56s Details 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>	2026-06-07 00:59:09 +00:00
giles	57066a9ed0	commerce: composed priced quote (price+promo+stacking) (13 tests) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 34s Details quote.sx — cart-quote composes the pipeline into a deterministic {:subtotal :discount :tax :total :codes} with total = subtotal - discount + tax. Explicit tax policy: tax on gross per-line amounts (discount reduces payable, not the tax base). This quote is the value the Phase-3 order flow carries. Total 112/112 across 7 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 00:26:21 +00:00
giles	f71af498cf	commerce: stacking precedence + best-price selection + backward query (16 tests) — Phase 2 done Some checks are pending Test, Build, and Deploy / test-build-deploy (push) Waiting to run Details stack.sx — precedence as a separate selection layer, not in the rules. Exclusivity = unordered code pairs; valid-stackings enumerates every legal subset of applicable promos; best-stacking deterministically picks max total discount (stable on ties); stacking-by-totalo answers "which legal stacking yields total D?" backward. Member vs guest falls out of applicable-promos. Completes Phase 2. Total 99/99 across 6 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 00:21:48 +00:00
giles	79fa28e55d	commerce: promo rules (percent/fixed/bundle/member) as relations (17 tests) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 57s Details promo.sx — four promo types as tagged tuples; per-promo discount is pure integer arithmetic, but enumeration is relational: promo-discounto and promo-applieso run forward ("which codes apply, for how much?") and backward ("which code yields this discount?"). project grounds the membero-bound promo. applicable-promos / promo-amount-for deterministic helpers. Total 83/83. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-07 00:17:26 +00:00
giles	a0f3a1177e	commerce: public session API + per-line audit + checkout stub (12 tests) — Phase 1 done Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 45s Details api.sx — session facade {:ctx :cart}: commerce-add/remove/set-qty/total/ count/lines, commerce-can-add? catalog validation, commerce-explain per-line audit breakdown, commerce-checkout Phase-3 stub. Completes Phase 1 (catalog + cart + deterministic totals). Total 66/66 across 4 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-06 23:46:51 +00:00
giles	29955831be	commerce: deterministic subtotal + jurisdiction-relational tax (20 tests) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 56s Details price.sx — cart-subtotal (unit price = base + variant delta, default 0), taxo facts indexed by (jurisdiction, product-class, customer-class) -> bps queried both directions, apply-bps half-up integer rounding, cart-total returning {:subtotal :discounts :tax :total} reproducible from (context, cart). Total 54/54. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-06 23:45:05 +00:00
giles	35957d779f	commerce: cart line items + add/remove/set-qty + relational view (18 tests) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 55s Details cart.sx — cart as an ordered list of (sku variant qty) lines. Pure operations: cart-add (merge-or-append), cart-set-qty (0 removes), cart-remove, with cart-qty/count/skus/empty? accessors. cart-lineo exposes lines relationally via membero. Total 34/34. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-06 23:42:49 +00:00
giles	25f3734eab	commerce: catalog facts + multidirectional relations + conformance harness (16 tests) Some checks failed Test, Build, and Deploy / test-build-deploy (push) Failing after 48s Details catalog.sx — catalog snapshot (products/variants/stock as fact tuples), relational accessors (producto/varianto/stocko, derived priceo/classo/ unit-priceo) usable forward and backward, deterministic catalog-price/ -class/-has? helpers. Money is integer minor units. conformance.sh runs suites on the miniKanren stack and emits scoreboard.{json,md}. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>	2026-06-06 23:41:04 +00:00