rose-ash/lib/events/ticket.sx

;; lib/events/ticket.sx — paid-ticket contract between events and commerce.
;;
;; A paid booking spans two subsystems. events does NOT import commerce; instead
;; this module defines the CONTRACT — the two messages on the wire — and the
;; events-side orchestration over provisional holds (booking.sx). commerce
;; imports these shapes; the dependency only points one way.
;;
;;   checkout-request   events -> commerce   "take payment for this seat"
;;     {:kind :events.checkout :occ-key :actor :amount :currency :ref}
;;
;;   payment-result     commerce -> events   "here's how payment went"
;;     {:kind :events.payment  :occ-key :actor :ref :status}
;;        :status ∈ :paid | :failed | :expired
;;
;; Flow: ev/request-ticket! places a capacity-safe HOLD (reserving the seat so
;; it can't be oversold while payment pends) and returns a checkout-request to
;; hand to commerce. When commerce reports back, ev/settle-payment! confirms the
;; hold on :paid or releases it otherwise. Settlement is idempotent — an
;; at-least-once redelivery of the same result is safe. `ref` is the opaque
;; correlation/idempotency id; occ-key + actor locate the hold, so settlement
;; needs no side table.

;; ---- contract: checkout request (events -> commerce) ----

(define
  ev/checkout-request
  (fn (occ-key actor amount currency ref) {:actor actor :amount amount :kind :events.checkout :ref ref :currency currency :occ-key occ-key}))

(define
  ev/checkout-request?
  (fn (m) (and (dict? m) (= (get m :kind) :events.checkout))))

(define ev/req-occ-key (fn (r) (get r :occ-key)))
(define ev/req-actor (fn (r) (get r :actor)))
(define ev/req-amount (fn (r) (get r :amount)))
(define ev/req-currency (fn (r) (get r :currency)))
(define ev/req-ref (fn (r) (get r :ref)))

;; ---- contract: payment result (commerce -> events) ----

(define ev/payment-result (fn (occ-key actor ref status) {:actor actor :kind :events.payment :status status :ref ref :occ-key occ-key}))

(define
  ev/payment-result?
  (fn (m) (and (dict? m) (= (get m :kind) :events.payment))))

(define ev/result-occ-key (fn (r) (get r :occ-key)))
(define ev/result-actor (fn (r) (get r :actor)))
(define ev/result-ref (fn (r) (get r :ref)))
(define ev/result-status (fn (r) (get r :status)))

(define
  ev/payment-paid
  (fn (occ-key actor ref) (ev/payment-result occ-key actor ref :paid)))
(define
  ev/payment-failed
  (fn (occ-key actor ref) (ev/payment-result occ-key actor ref :failed)))
(define
  ev/payment-expired
  (fn (occ-key actor ref) (ev/payment-result occ-key actor ref :expired)))

;; ---- orchestration ----

;; Begin a paid booking: place a capacity-safe hold and, if reserved, return a
;; checkout-request for commerce. :full when no seat; :already when the actor
;; already holds/booked this occurrence (no duplicate request).
(define
  ev/request-ticket!
  (fn
    (b occ-key capacity actor amount currency ref)
    (let
      ((h (ev/hold! b occ-key capacity actor)))
      (cond
        ((= (get h :status) :held) {:seat (get h :seat) :request (ev/checkout-request occ-key actor amount currency ref) :status :awaiting-payment})
        ((= (get h :status) :already) {:seat (get h :seat) :status :already})
        (else {:capacity capacity :status :full})))))

;; Settle a payment result from commerce. :paid confirms the hold; :failed /
;; :expired release it. Idempotent: a redelivered :paid stays :confirmed, a
;; redelivered release is a :noop. If a :paid arrives for a hold that is already
;; gone (released/expired first), returns :paid-but-no-hold so the caller can
;; trigger a refund.
(define
  ev/settle-payment!
  (fn
    (b result)
    (let
      ((occ-key (ev/result-occ-key result))
        (actor (ev/result-actor result))
        (ref (ev/result-ref result)))
      (if
        (= (ev/result-status result) :paid)
        (let
          ((c (ev/confirm! b occ-key actor)))
          (cond
            ((= (get c :status) :confirmed) {:actor actor :status :confirmed :ref ref})
            ((= (get c :status) :already-confirmed) {:actor actor :status :confirmed :ref ref})
            (else {:actor actor :status :paid-but-no-hold :ref ref})))
        (let
          ((r (ev/release! b occ-key actor)))
          (if (= (get r :status) :released) {:actor actor :status :released :ref ref} {:actor actor :status :noop :ref ref}))))))