commerce: order ledger on persist + idempotent reconciliation (20 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
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>
This commit is contained in:
@@ -17,7 +17,7 @@ if [ ! -x "$SX_SERVER" ]; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
SUITES=(catalog cart price api promo stack quote)
|
||||
SUITES=(catalog cart price api promo stack quote ledger)
|
||||
|
||||
OUT_JSON="lib/commerce/scoreboard.json"
|
||||
OUT_MD="lib/commerce/scoreboard.md"
|
||||
@@ -43,6 +43,11 @@ run_suite() {
|
||||
(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/commerce/catalog.sx")
|
||||
(load "lib/commerce/cart.sx")
|
||||
(load "lib/commerce/price.sx")
|
||||
@@ -50,6 +55,7 @@ run_suite() {
|
||||
(load "lib/commerce/promo.sx")
|
||||
(load "lib/commerce/stack.sx")
|
||||
(load "lib/commerce/quote.sx")
|
||||
(load "lib/commerce/ledger.sx")
|
||||
(epoch 2)
|
||||
(eval "(define ct-pass 0)")
|
||||
(eval "(define ct-fail 0)")
|
||||
|
||||
176
lib/commerce/ledger.sx
Normal file
176
lib/commerce/ledger.sx
Normal file
@@ -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))))
|
||||
@@ -6,9 +6,10 @@
|
||||
"api": {"pass": 12, "fail": 0},
|
||||
"promo": {"pass": 17, "fail": 0},
|
||||
"stack": {"pass": 16, "fail": 0},
|
||||
"quote": {"pass": 13, "fail": 0}
|
||||
"quote": {"pass": 13, "fail": 0},
|
||||
"ledger": {"pass": 20, "fail": 0}
|
||||
},
|
||||
"total_pass": 112,
|
||||
"total_pass": 132,
|
||||
"total_fail": 0,
|
||||
"total": 112
|
||||
"total": 132
|
||||
}
|
||||
|
||||
@@ -11,4 +11,5 @@ _Generated by `lib/commerce/conformance.sh`_
|
||||
| promo | 17 | 0 | 17 |
|
||||
| stack | 16 | 0 | 16 |
|
||||
| quote | 13 | 0 | 13 |
|
||||
| **Total** | **112** | **0** | **112** |
|
||||
| ledger | 20 | 0 | 20 |
|
||||
| **Total** | **132** | **0** | **132** |
|
||||
|
||||
80
lib/commerce/tests/ledger.sx
Normal file
80
lib/commerce/tests/ledger.sx
Normal file
@@ -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"))))
|
||||
@@ -21,7 +21,7 @@ reconciliation — all auditable via the event log.
|
||||
|
||||
## Status (rolling)
|
||||
|
||||
`bash lib/commerce/conformance.sh` → **112/112** (7 suites: catalog, cart, price, api, promo, stack, quote) — Phases 1-2 done + priced-quote capstone
|
||||
`bash lib/commerce/conformance.sh` → **132/132** (8 suites: catalog, cart, price, api, promo, stack, quote, ledger) — Phases 1-2 done; Phase 3 ledger done
|
||||
|
||||
## Ground rules
|
||||
|
||||
@@ -68,7 +68,7 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
|
||||
## Phase 3 — Order lifecycle (flow + store)
|
||||
- [ ] order flow: reserve stock → await payment → fulfil
|
||||
- [ ] 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
|
||||
@@ -76,6 +76,17 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
|
||||
- [ ] tests: webhook replay, partial refund, double-charge guard
|
||||
|
||||
## Progress log
|
||||
- 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
|
||||
|
||||
Reference in New Issue
Block a user