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
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:
88
lib/commerce/tests/federation.sx
Normal file
88
lib/commerce/tests/federation.sx
Normal 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
109
lib/commerce/tests/recon.sx
Normal 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)
|
||||
Reference in New Issue
Block a user