giles
a4275c4944
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>
101 lines
2.7 KiB
Plaintext
101 lines
2.7 KiB
Plaintext
;; 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))))
|