giles
ef7de817bb
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 3m32s
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
90 lines
4.0 KiB
Plaintext
90 lines
4.0 KiB
Plaintext
;; lib/host/tests/ledger.sx — the strangler migration ledger: entry shape,
|
|
;; status/domain queries, find, distinct domains, and coverage maths.
|
|
|
|
(define host-lg-pass 0)
|
|
(define host-lg-fail 0)
|
|
(define host-lg-fails (list))
|
|
|
|
(define
|
|
host-lg-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! host-lg-pass (+ host-lg-pass 1))
|
|
(begin
|
|
(set! host-lg-fail (+ host-lg-fail 1))
|
|
(append! host-lg-fails {:name name :actual actual :expected expected})))))
|
|
|
|
;; ── entry constructor ───────────────────────────────────────────────
|
|
(define host-lg-e (host/ledger-entry "feed" "GET" "/feed" "feed:timeline" "migrated" "host/feed-timeline"))
|
|
(host-lg-test "entry domain" (get host-lg-e :domain) "feed")
|
|
(host-lg-test "entry path" (get host-lg-e :path) "/feed")
|
|
(host-lg-test "entry status" (get host-lg-e :status) "migrated")
|
|
(host-lg-test "entry handler" (get host-lg-e :handler) "host/feed-timeline")
|
|
|
|
;; ── find ────────────────────────────────────────────────────────────
|
|
(host-lg-test
|
|
"find GET /feed -> migrated"
|
|
(get (host/ledger-find host/ledger "GET" "/feed") :status)
|
|
"migrated")
|
|
(host-lg-test
|
|
"find GET /feed -> handler"
|
|
(get (host/ledger-find host/ledger "GET" "/feed") :handler)
|
|
"host/feed-timeline")
|
|
(host-lg-test
|
|
"find POST /feed -> create"
|
|
(get (host/ledger-find host/ledger "POST" "/feed") :handler)
|
|
"host/feed-create")
|
|
(host-lg-test "find missing -> nil" (host/ledger-find host/ledger "GET" "/nope") nil)
|
|
|
|
;; ── status queries ──────────────────────────────────────────────────
|
|
(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 2)
|
|
(host-lg-test "native count" (len (host/ledger-native host/ledger)) 1)
|
|
(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 8)
|
|
|
|
;; ── served? predicate ───────────────────────────────────────────────
|
|
(host-lg-test
|
|
"served? migrated"
|
|
(host/ledger-served? (host/ledger-find host/ledger "GET" "/feed"))
|
|
true)
|
|
(host-lg-test
|
|
"served? native"
|
|
(host/ledger-served? (host/ledger-find host/ledger "GET" "/health"))
|
|
true)
|
|
(host-lg-test
|
|
"served? proxied false"
|
|
(host/ledger-served? (host/ledger-find host/ledger "POST" "/internal/actions/relate"))
|
|
false)
|
|
|
|
;; ── domain queries ──────────────────────────────────────────────────
|
|
(host-lg-test "relations domain count" (len (host/ledger-by-domain host/ledger "relations")) 4)
|
|
(host-lg-test "likes domain count" (len (host/ledger-by-domain host/ledger "likes")) 4)
|
|
(host-lg-test "domains count" (len (host/ledger-domains host/ledger)) 4)
|
|
(host-lg-test
|
|
"domains has relations"
|
|
(some (fn (d) (= d "relations")) (host/ledger-domains host/ledger))
|
|
true)
|
|
(host-lg-test
|
|
"domains has feed"
|
|
(some (fn (d) (= d "feed")) (host/ledger-domains host/ledger))
|
|
true)
|
|
|
|
;; ── coverage ────────────────────────────────────────────────────────
|
|
(define host-lg-cov (host/ledger-coverage host/ledger))
|
|
(host-lg-test "coverage total" (get host-lg-cov :total) 11)
|
|
(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 2)
|
|
(host-lg-test "coverage proxied" (get host-lg-cov :proxied) 8)
|
|
(host-lg-test "coverage native" (get host-lg-cov :native) 1)
|
|
(host-lg-test "coverage served" (get host-lg-cov :served) 3)
|
|
(host-lg-test "coverage percent" (get host-lg-cov :percent) 27)
|
|
|
|
(define
|
|
host-lg-tests-run!
|
|
(fn
|
|
()
|
|
{:total (+ host-lg-pass host-lg-fail)
|
|
:passed host-lg-pass
|
|
:failed host-lg-fail
|
|
:fails host-lg-fails}))
|