rose-ash/lib/persist/tests/durable.sx

; Phase 4 — durable backend over the IO-suspension boundary, tested with a mock
; transport (the mock-IO harness for the durable protocol). The whole facet
; stack must run unchanged on mock-durable, and a "crash/restart" (drop the
; backend, keep the disk) must recover state by replay.

(define dur-count (fn (acc e) (+ acc 1)))

; ---------- request encoders ----------
(persist-test
  "req-append encodes op + args"
  (persist/req-append "s" {:k 1})
  {:op "persist/append" :args (list "s" {:k 1})})
(persist-test
  "req-kv-put encodes op + args"
  (persist/req-kv-put "k" 7)
  {:op "persist/kv-put" :args (list "k" 7)})

; ---------- serve round-trips against a disk ----------
(persist-test
  "serve append then serve read"
  (let
    ((disk (persist/mem-backend)))
    (begin
      (persist/serve
        disk
        (persist/req-append
          "s"
          (persist/event "s" 1 "x" 0 {:n 1})))
      (get
        (persist/event-data
          (first (persist/serve disk (persist/req-read "s"))))
        :n)))
  1)
(persist-test
  "serve kv-put then kv-get"
  (let
    ((disk (persist/mem-backend)))
    (begin
      (persist/serve disk (persist/req-kv-put "k" 42))
      (persist/serve disk (persist/req-kv-get "k"))))
  42)
(persist-test
  "serve unknown op is a clear error"
  (let
    ((disk (persist/mem-backend)))
    (guard (e (true "errored")) (persist/serve disk {:op "persist/bogus" :args (list)})))
  "errored")

; ---------- full facet stack on mock-durable ----------
(persist-test
  "log facet works on mock-durable"
  (let
    ((db (persist/mock-durable (persist/mem-backend))))
    (begin
      (persist/append db "s" "x" 0 {})
      (persist/append db "s" "x" 0 {})
      (persist/count db "s")))
  2)
(persist-test
  "seq assignment works on mock-durable"
  (let
    ((db (persist/mock-durable (persist/mem-backend))))
    (begin
      (persist/append db "s" "x" 0 {})
      (persist/event-seq (persist/append db "s" "x" 0 {}))))
  2)
(persist-test
  "kv facet works on mock-durable"
  (let
    ((db (persist/mock-durable (persist/mem-backend))))
    (begin (persist/kv-put db "k" 5) (persist/kv-get db "k")))
  5)
(persist-test
  "projection works on mock-durable"
  (let
    ((db (persist/mock-durable (persist/mem-backend))))
    (begin
      (persist/append db "s" "x" 0 {})
      (persist/append db "s" "x" 0 {})
      (persist/append db "s" "x" 0 {})
      (persist/project-fold db "s" dur-count 0)))
  3)
(persist-test
  "snapshot + replay work on mock-durable"
  (let
    ((db (persist/mock-durable (persist/mem-backend))))
    (begin
      (persist/append db "s" "x" 0 {})
      (persist/append db "s" "x" 0 {})
      (persist/checkpoint db "s" "snap" dur-count 0)
      (persist/append db "s" "x" 0 {})
      (persist/project-value
        (persist/replay db "s" "snap" dur-count 0))))
  3)
(persist-test
  "compaction works on mock-durable"
  (let
    ((db (persist/mock-durable (persist/mem-backend))))
    (begin
      (persist/append db "s" "x" 0 {})
      (persist/append db "s" "x" 0 {})
      (persist/compact db "s" "snap" dur-count 0)
      (list (persist/count db "s") (persist/last-seq db "s"))))
  (list 0 2))

; ---------- crash / restart replay ----------
(persist-test
  "restart recovers log state from the disk"
  (let
    ((disk (persist/mem-backend)))
    (begin
      (let
        ((db (persist/mock-durable disk)))
        (begin
          (persist/append db "s" "x" 0 {})
          (persist/append db "s" "x" 0 {})))
      (let
        ((db2 (persist/mock-durable disk)))
        (persist/project-fold db2 "s" dur-count 0))))
  2)
(persist-test
  "restart continues the seq counter"
  (let
    ((disk (persist/mem-backend)))
    (begin
      (let
        ((db (persist/mock-durable disk)))
        (begin
          (persist/append db "s" "x" 0 {})
          (persist/append db "s" "x" 0 {})))
      (let
        ((db2 (persist/mock-durable disk)))
        (persist/event-seq (persist/append db2 "s" "x" 0 {})))))
  3)
(persist-test
  "restart recovers a kv value"
  (let
    ((disk (persist/mem-backend)))
    (begin
      (let
        ((db (persist/mock-durable disk)))
        (persist/kv-put db "cfg" "on"))
      (let ((db2 (persist/mock-durable disk))) (persist/kv-get db2 "cfg"))))
  "on")
(persist-test
  "restart from snapshot equals full replay"
  (let
    ((disk (persist/mem-backend)))
    (begin
      (let
        ((db (persist/mock-durable disk)))
        (begin
          (persist/append db "s" "x" 0 {})
          (persist/append db "s" "x" 0 {})
          (persist/checkpoint db "s" "snap" dur-count 0)
          (persist/append db "s" "x" 0 {})))
      (let
        ((db2 (persist/mock-durable disk)))
        (equal?
          (persist/project-value
            (persist/replay db2 "s" "snap" dur-count 0))
          (persist/project-fold db2 "s" dur-count 0)))))
  true)