;; lib/events/tests/booking.sx — capacity-safe transactional booking.

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

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

;; Take a consistent (roster, last-seq) snapshot of an occurrence's stream.
(define ev-bk-snap (fn (b k) (ev-booked-actors b k)))
(define ev-bk-seq (fn (b k) (persist/last-seq b (ev-booking-stream k))))

(define
  ev-bk-run-all!
  (fn
    ()
    (do
      (let
        ((b (persist/open)))
        (do
          (ev-bk-check!
            "first booking takes seat 1"
            (get (ev/book! b "o1" 3 (quote a)) :seat)
            1)
          (ev-bk-check!
            "second booking takes seat 2"
            (get (ev/book! b "o1" 3 (quote c)) :seat)
            2)
          (ev-bk-check!
            "booked status reported"
            (get (ev/book! b "o1" 3 (quote d)) :status)
            :booked)
          (ev-bk-check!
            "roster is oldest-first"
            (ev/roster b "o1")
            (list (quote a) (quote c) (quote d)))
          (ev-bk-check!
            "seats-left is zero when full"
            (ev/seats-left b "o1" 3)
            0)))
      (let
        ((b (persist/open)))
        (do
          (ev/book! b "o2" 1 (quote a))
          (ev-bk-check!
            "booking past capacity is refused"
            (get (ev/book! b "o2" 1 (quote c)) :status)
            :full)
          (ev-bk-check!
            "full does not grow the roster"
            (ev/roster b "o2")
            (list (quote a)))
          (ev-bk-check!
            "seats-left zero at capacity"
            (ev/seats-left b "o2" 1)
            0)))
      (let
        ((b (persist/open)))
        (do
          (ev/book! b "o3" 5 (quote a))
          (ev-bk-check!
            "re-booking the same actor is idempotent"
            (get (ev/book! b "o3" 5 (quote a)) :status)
            :already)
          (ev-bk-check!
            "idempotent re-book reports existing seat"
            (get (ev/book! b "o3" 5 (quote a)) :seat)
            1)
          (ev-bk-check!
            "roster unchanged after re-book"
            (ev/roster b "o3")
            (list (quote a)))
          (ev-bk-check!
            "count unchanged after re-book"
            (ev-booking-count b "o3")
            1)))
      (let
        ((b (persist/open)))
        (do
          (ev/book! b "last" 2 (quote x))
          (let
            ((snap (ev-bk-snap b "last")) (exp (ev-bk-seq b "last")))
            (let
              ((ra (ev/book-with-observed b "last" 2 (quote a) snap exp))
                (rb
                  (ev/book-with-observed
                    b
                    "last"
                    2
                    (quote bee)
                    snap
                    exp)))
              (do
                (ev-bk-check!
                  "race winner is booked"
                  (get ra :status)
                  :booked)
                (ev-bk-check!
                  "race winner takes the last seat"
                  (get ra :seat)
                  2)
                (ev-bk-check!
                  "race loser is rejected with a conflict"
                  (get rb :status)
                  :conflict)
                (ev-bk-check!
                  "conflict reports the advanced seq"
                  (get rb :actual)
                  (+ exp 1))
                (ev-bk-check!
                  "no overbooking: exactly two on roster"
                  (ev-booking-count b "last")
                  2)
                (ev-bk-check!
                  "race loser is NOT on the roster"
                  (ev-bk-member? (quote bee) (ev/roster b "last"))
                  false)
                (ev-bk-check!
                  "race loser retrying gets full"
                  (get (ev/book! b "last" 2 (quote bee)) :status)
                  :full))))))
      (let
        ((b (persist/open)))
        (do
          (ev/book! b "room" 3 (quote x))
          (let
            ((snap (ev-bk-snap b "room")) (exp (ev-bk-seq b "room")))
            (let
              ((ra (ev/book-with-observed b "room" 3 (quote a) snap exp))
                (rb
                  (ev/book-with-observed
                    b
                    "room"
                    3
                    (quote bee)
                    snap
                    exp)))
              (do
                (ev-bk-check!
                  "room winner booked seat 2"
                  (get ra :seat)
                  2)
                (ev-bk-check!
                  "room loser first conflicts"
                  (get rb :status)
                  :conflict)
                (ev-bk-check!
                  "room loser retry books seat 3"
                  (get (ev/book! b "room" 3 (quote bee)) :seat)
                  3)
                (ev-bk-check!
                  "room roster is x,a,bee"
                  (ev/roster b "room")
                  (list (quote x) (quote a) (quote bee)))
                (ev-bk-check!
                  "room is now full"
                  (ev/seats-left b "room" 3)
                  0)))))))))

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