giles
a5ac0818c2
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>
81 lines
3.2 KiB
Plaintext
81 lines
3.2 KiB
Plaintext
;; 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"))))
|