diff --git a/lib/commerce/conformance.sh b/lib/commerce/conformance.sh index 5ca015d7..860d256a 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) +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)") diff --git a/lib/commerce/ledger.sx b/lib/commerce/ledger.sx new file mode 100644 index 00000000..ffc5a40c --- /dev/null +++ b/lib/commerce/ledger.sx @@ -0,0 +1,176 @@ +;; lib/commerce/ledger.sx — the order ledger as a persist event stream. +;; +;; Each order is an append-only stream "order/" 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)))) diff --git a/lib/commerce/scoreboard.json b/lib/commerce/scoreboard.json index 75850718..b626e72b 100644 --- a/lib/commerce/scoreboard.json +++ b/lib/commerce/scoreboard.json @@ -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 } diff --git a/lib/commerce/scoreboard.md b/lib/commerce/scoreboard.md index 889ada5f..bd85a6f8 100644 --- a/lib/commerce/scoreboard.md +++ b/lib/commerce/scoreboard.md @@ -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** | diff --git a/lib/commerce/tests/ledger.sx b/lib/commerce/tests/ledger.sx new file mode 100644 index 00000000..a06d45f6 --- /dev/null +++ b/lib/commerce/tests/ledger.sx @@ -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")))) diff --git a/plans/commerce-on-sx.md b/plans/commerce-on-sx.md index 65f9af3a..1b90d8ff 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` → **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/". 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