;; lib/events/tests/ticket.sx — paid-ticket contract + settlement orchestration.

(define ev-tk-pass 0)
(define ev-tk-fail 0)
(define ev-tk-failures (list))

(define
  ev-tk-check!
  (fn
    (name got expected)
    (if
      (= got expected)
      (set! ev-tk-pass (+ ev-tk-pass 1))
      (do
        (set! ev-tk-fail (+ ev-tk-fail 1))
        (append!
          ev-tk-failures
          (str name "\n    expected: " expected "\n    got:      " got))))))

(define
  ev-tk-run-all!
  (fn
    ()
    (do
      (let
        ((req (ev/checkout-request "occ1" (quote nia) 1500 "GBP" "ref-1")))
        (do
          (ev-tk-check!
            "checkout-request is tagged"
            (ev/checkout-request? req)
            true)
          (ev-tk-check!
            "payment-result is not a checkout-request"
            (ev/checkout-request? (ev/payment-paid "o" (quote a) "r"))
            false)
          (ev-tk-check!
            "request occ-key accessor"
            (ev/req-occ-key req)
            "occ1")
          (ev-tk-check!
            "request actor accessor"
            (ev/req-actor req)
            (quote nia))
          (ev-tk-check!
            "request amount accessor"
            (ev/req-amount req)
            1500)
          (ev-tk-check!
            "request currency accessor"
            (ev/req-currency req)
            "GBP")
          (ev-tk-check! "request ref accessor" (ev/req-ref req) "ref-1")))
      (let
        ((res (ev/payment-paid "occ1" (quote nia) "ref-1")))
        (do
          (ev-tk-check!
            "payment-result is tagged"
            (ev/payment-result? res)
            true)
          (ev-tk-check! "result status accessor" (ev/result-status res) :paid)
          (ev-tk-check!
            "failed constructor carries status"
            (ev/result-status (ev/payment-failed "o" (quote a) "r"))
            :failed)
          (ev-tk-check!
            "expired constructor carries status"
            (ev/result-status (ev/payment-expired "o" (quote a) "r"))
            :expired)))
      (let
        ((b (persist/open)))
        (do
          (let
            ((r (ev/request-ticket! b "show" 1 (quote a) 2000 "GBP" "ref-a")))
            (do
              (ev-tk-check!
                "request-ticket awaiting-payment"
                (get r :status)
                :awaiting-payment)
              (ev-tk-check!
                "request-ticket returns a checkout-request"
                (ev/checkout-request? (get r :request))
                true)
              (ev-tk-check!
                "checkout-request carries the amount"
                (ev/req-amount (get r :request))
                2000)))
          (ev-tk-check!
            "held seat reserves capacity"
            (ev/seats-left b "show" 1)
            0)
          (ev-tk-check!
            "second buyer is full while payment pends"
            (get
              (ev/request-ticket!
                b
                "show"
                1
                (quote c)
                2000
                "GBP"
                "ref-c")
              :status)
            :full)
          (ev-tk-check!
            "held seat state pending"
            (ev/seat-state b "show" (quote a))
            :held)))
      (let
        ((b (persist/open)))
        (do
          (ev/request-ticket!
            b
            "gig"
            2
            (quote a)
            2000
            "GBP"
            "ref-a")
          (let
            ((s (ev/settle-payment! b (ev/payment-paid "gig" (quote a) "ref-a"))))
            (ev-tk-check! "settle paid confirms" (get s :status) :confirmed))
          (ev-tk-check!
            "confirmed seat state"
            (ev/seat-state b "gig" (quote a))
            :confirmed)
          (ev-tk-check!
            "redelivered paid is still confirmed (idempotent)"
            (get
              (ev/settle-payment!
                b
                (ev/payment-paid "gig" (quote a) "ref-a"))
              :status)
            :confirmed)
          (ev-tk-check!
            "still exactly one seat taken"
            (ev-booking-count b "gig")
            1)))
      (let
        ((b (persist/open)))
        (do
          (ev/request-ticket!
            b
            "fail"
            1
            (quote a)
            2000
            "GBP"
            "ref-a")
          (ev-tk-check!
            "seat held before failure"
            (ev/seats-left b "fail" 1)
            0)
          (let
            ((s (ev/settle-payment! b (ev/payment-failed "fail" (quote a) "ref-a"))))
            (ev-tk-check! "settle failed releases" (get s :status) :released))
          (ev-tk-check!
            "released seat frees capacity"
            (ev/seats-left b "fail" 1)
            1)
          (ev-tk-check!
            "redelivered failure is a noop"
            (get
              (ev/settle-payment!
                b
                (ev/payment-failed "fail" (quote a) "ref-a"))
              :status)
            :noop)
          (ev-tk-check!
            "freed seat available to next buyer"
            (get
              (ev/request-ticket!
                b
                "fail"
                1
                (quote c)
                2000
                "GBP"
                "ref-c")
              :status)
            :awaiting-payment)
          (ev/request-ticket!
            b
            "exp"
            1
            (quote a)
            2000
            "GBP"
            "ref-a")
          (ev-tk-check!
            "settle expired releases"
            (get
              (ev/settle-payment!
                b
                (ev/payment-expired "exp" (quote a) "ref-a"))
              :status)
            :released)))
      (let
        ((b (persist/open)))
        (do
          (ev/request-ticket!
            b
            "race"
            1
            (quote a)
            2000
            "GBP"
            "ref-a")
          (ev/settle-payment!
            b
            (ev/payment-expired "race" (quote a) "ref-a"))
          (ev-tk-check!
            "late paid for a vanished hold needs a refund"
            (get
              (ev/settle-payment!
                b
                (ev/payment-paid "race" (quote a) "ref-a"))
              :status)
            :paid-but-no-hold)
          (ev-tk-check!
            "no phantom seat created"
            (ev-booking-count b "race")
            0)))
      (let
        ((b (persist/open)))
        (do
          (let
            ((start (ev/request-ticket! b "e2e" 3 (quote nia) 2500 "GBP" "ref-nia")))
            (ev/settle-payment!
              b
              (ev/payment-paid
                (ev/req-occ-key (get start :request))
                (ev/req-actor (get start :request))
                (ev/req-ref (get start :request)))))
          (ev-tk-check!
            "e2e roster holds the buyer"
            (ev/roster b "e2e")
            (list (quote nia)))
          (ev-tk-check!
            "e2e seat confirmed"
            (ev/seat-state b "e2e" (quote nia))
            :confirmed))))))

(define
  ev-ticket-tests-run!
  (fn
    ()
    (do
      (set! ev-tk-pass 0)
      (set! ev-tk-fail 0)
      (set! ev-tk-failures (list))
      (ev-tk-run-all!)
      {:failures ev-tk-failures :total (+ ev-tk-pass ev-tk-fail) :passed ev-tk-pass :failed ev-tk-fail})))