rose-ash/lib/commerce/ledger.sx

;; 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))))