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:
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))))
|
||||
Reference in New Issue
Block a user