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

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>
This commit is contained in:
2026-06-07 09:54:25 +00:00
parent 85b288d22b
commit a4275c4944
8 changed files with 411 additions and 9 deletions

View File

@@ -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)

109
lib/commerce/tests/recon.sx Normal file
View File

@@ -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)