From a4275c4944a05d4bb6677406edadc318f1d2337d Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 09:54:25 +0000 Subject: [PATCH] =?UTF-8?q?commerce:=20reconciliation=20queries=20+=20fede?= =?UTF-8?q?rated-catalog=20stub=20(32=20tests)=20=E2=80=94=20Phase=204=20d?= =?UTF-8?q?one?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- lib/commerce/conformance.sh | 4 +- lib/commerce/federation.sx | 86 ++++++++++++++++++++++++ lib/commerce/recon.sx | 100 ++++++++++++++++++++++++++++ lib/commerce/scoreboard.json | 8 ++- lib/commerce/scoreboard.md | 4 +- lib/commerce/tests/federation.sx | 88 +++++++++++++++++++++++++ lib/commerce/tests/recon.sx | 109 +++++++++++++++++++++++++++++++ plans/commerce-on-sx.md | 21 ++++-- 8 files changed, 411 insertions(+), 9 deletions(-) create mode 100644 lib/commerce/federation.sx create mode 100644 lib/commerce/recon.sx create mode 100644 lib/commerce/tests/federation.sx create mode 100644 lib/commerce/tests/recon.sx diff --git a/lib/commerce/conformance.sh b/lib/commerce/conformance.sh index 5ab42f86..2a1b022d 100755 --- a/lib/commerce/conformance.sh +++ b/lib/commerce/conformance.sh @@ -17,7 +17,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(catalog cart price api promo stack quote ledger order) +SUITES=(catalog cart price api promo stack quote ledger order recon federation) OUT_JSON="lib/commerce/scoreboard.json" OUT_MD="lib/commerce/scoreboard.md" @@ -68,6 +68,8 @@ run_suite() { (load "lib/commerce/quote.sx") (load "lib/commerce/ledger.sx") (load "lib/commerce/order.sx") +(load "lib/commerce/recon.sx") +(load "lib/commerce/federation.sx") (epoch 2) (eval "(define ct-pass 0)") (eval "(define ct-fail 0)") diff --git a/lib/commerce/federation.sx b/lib/commerce/federation.sx new file mode 100644 index 00000000..f9caa836 --- /dev/null +++ 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))))) diff --git a/lib/commerce/recon.sx b/lib/commerce/recon.sx new file mode 100644 index 00000000..61aa5151 --- /dev/null +++ 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)))) diff --git a/lib/commerce/scoreboard.json b/lib/commerce/scoreboard.json index 71796a6b..ace44643 100644 --- a/lib/commerce/scoreboard.json +++ b/lib/commerce/scoreboard.json @@ -8,9 +8,11 @@ "stack": {"pass": 16, "fail": 0}, "quote": {"pass": 13, "fail": 0}, "ledger": {"pass": 20, "fail": 0}, - "order": {"pass": 21, "fail": 0} + "order": {"pass": 21, "fail": 0}, + "recon": {"pass": 20, "fail": 0}, + "federation": {"pass": 12, "fail": 0} }, - "total_pass": 153, + "total_pass": 185, "total_fail": 0, - "total": 153 + "total": 185 } diff --git a/lib/commerce/scoreboard.md b/lib/commerce/scoreboard.md index 407ad0ac..2fe4b738 100644 --- a/lib/commerce/scoreboard.md +++ b/lib/commerce/scoreboard.md @@ -13,4 +13,6 @@ _Generated by `lib/commerce/conformance.sh`_ | quote | 13 | 0 | 13 | | ledger | 20 | 0 | 20 | | order | 21 | 0 | 21 | -| **Total** | **153** | **0** | **153** | +| recon | 20 | 0 | 20 | +| federation | 12 | 0 | 12 | +| **Total** | **185** | **0** | **185** | diff --git a/lib/commerce/tests/federation.sx b/lib/commerce/tests/federation.sx new file mode 100644 index 00000000..4beaa074 --- /dev/null +++ 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) diff --git a/lib/commerce/tests/recon.sx b/lib/commerce/tests/recon.sx new file mode 100644 index 00000000..537d54fd --- /dev/null +++ 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) diff --git a/plans/commerce-on-sx.md b/plans/commerce-on-sx.md index 0a2c96c3..4a53cf04 100644 --- 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` → **153/153** (9 suites: catalog, cart, price, api, promo, stack, quote, ledger, order) — Phases 1-3 done +`bash lib/commerce/conformance.sh` → **185/185** (11 suites: catalog, cart, price, api, promo, stack, quote, ledger, order, recon, federation) — **Phases 1-4 done (roadmap complete)** ## Ground rules @@ -71,11 +71,24 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout) - [x] order ledger as a `persist` stream; idempotent reconciliation ## Phase 4 — Reconciliation + federation -- [ ] mismatch detection (paid≠ordered) as queries over the ledger -- [ ] cross-instance catalog (federated marketplace) — out-of-scope stub -- [ ] tests: webhook replay, partial refund, double-charge guard +- [x] mismatch detection (paid≠ordered) as queries over the ledger +- [x] cross-instance catalog (federated marketplace) — out-of-scope stub +- [x] tests: webhook replay, partial refund, double-charge guard ## Progress log +- 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