giles
85aea61f3c
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m11s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
110 lines
4.1 KiB
Plaintext
110 lines
4.1 KiB
Plaintext
;; lib/dream/tests/auth.sx — base64, basic auth, bearer tokens.
|
|
|
|
(define dream-au-pass 0)
|
|
(define dream-au-fail 0)
|
|
(define dream-au-fails (list))
|
|
|
|
(define
|
|
dream-au-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! dream-au-pass (+ dream-au-pass 1))
|
|
(begin
|
|
(set! dream-au-fail (+ dream-au-fail 1))
|
|
(append! dream-au-fails {:name name :actual actual :expected expected})))))
|
|
|
|
;; ── base64 ─────────────────────────────────────────────────────────
|
|
(dream-au-test "encode Man" (dream-base64-encode "Man") "TWFu")
|
|
(dream-au-test "encode Ma" (dream-base64-encode "Ma") "TWE=")
|
|
(dream-au-test "encode M" (dream-base64-encode "M") "TQ==")
|
|
(dream-au-test
|
|
"encode user:pass"
|
|
(dream-base64-encode "user:pass")
|
|
"dXNlcjpwYXNz")
|
|
(dream-au-test "decode Man" (dream-base64-decode "TWFu") "Man")
|
|
(dream-au-test "decode Ma" (dream-base64-decode "TWE=") "Ma")
|
|
(dream-au-test "decode M" (dream-base64-decode "TQ==") "M")
|
|
(dream-au-test
|
|
"decode user:pass"
|
|
(dream-base64-decode "dXNlcjpwYXNz")
|
|
"user:pass")
|
|
(dream-au-test
|
|
"roundtrip phrase"
|
|
(dream-base64-decode (dream-base64-encode "Hello, World!"))
|
|
"Hello, World!")
|
|
(dream-au-test
|
|
"roundtrip empty"
|
|
(dream-base64-decode (dream-base64-encode ""))
|
|
"")
|
|
|
|
;; ── header parsing ─────────────────────────────────────────────────
|
|
(dream-au-test
|
|
"bearer token"
|
|
(dream-bearer-token (dream-request "GET" "/" {:Authorization "Bearer abc.123"} ""))
|
|
"abc.123")
|
|
(dream-au-test
|
|
"no bearer"
|
|
(dream-bearer-token (dream-request "GET" "/" {} ""))
|
|
nil)
|
|
(dream-au-test
|
|
"basic creds"
|
|
(dream-basic-credentials (dream-request "GET" "/" {:Authorization "Basic dXNlcjpwYXNz"} ""))
|
|
{:pass "pass" :user "user"})
|
|
(dream-au-test
|
|
"no basic"
|
|
(dream-basic-credentials (dream-request "GET" "/" {} ""))
|
|
nil)
|
|
|
|
;; ── basic auth middleware ──────────────────────────────────────────
|
|
(define dream-au-check (fn (u p) (and (= u "admin") (= p "secret"))))
|
|
(define
|
|
dream-au-app
|
|
((dream-basic-auth "Admin Area" dream-au-check)
|
|
(fn (req) (dream-text (str "hi " (dream-user req))))))
|
|
|
|
(define dream-au-ok (dream-au-app (dream-request "GET" "/" {:Authorization (str "Basic " (dream-base64-encode "admin:secret"))} "")))
|
|
(dream-au-test "basic ok reaches" (dream-resp-body dream-au-ok) "hi admin")
|
|
(dream-au-test "basic ok status" (dream-status dream-au-ok) 200)
|
|
|
|
(define dream-au-bad (dream-au-app (dream-request "GET" "/" {:Authorization (str "Basic " (dream-base64-encode "admin:wrong"))} "")))
|
|
(dream-au-test "basic wrong 401" (dream-status dream-au-bad) 401)
|
|
(dream-au-test
|
|
"basic wrong www-authenticate"
|
|
(contains? (dream-resp-header dream-au-bad "www-authenticate") "Admin Area")
|
|
true)
|
|
(dream-au-test
|
|
"basic missing 401"
|
|
(dream-status (dream-au-app (dream-request "GET" "/" {} "")))
|
|
401)
|
|
|
|
;; ── bearer middleware ──────────────────────────────────────────────
|
|
(define dream-au-tokens {:t-ada "ada" :t-bob "bob"})
|
|
(define dream-au-lookup (fn (tok) (get dream-au-tokens tok)))
|
|
(define
|
|
dream-au-bapp
|
|
((dream-require-bearer dream-au-lookup)
|
|
(fn (req) (dream-text (dream-principal req)))))
|
|
|
|
(dream-au-test
|
|
"bearer valid principal"
|
|
(dream-resp-body (dream-au-bapp (dream-request "GET" "/" {:Authorization "Bearer t-ada"} "")))
|
|
"ada")
|
|
(dream-au-test
|
|
"bearer invalid 401"
|
|
(dream-status (dream-au-bapp (dream-request "GET" "/" {:Authorization "Bearer nope"} "")))
|
|
401)
|
|
(dream-au-test
|
|
"bearer missing 401"
|
|
(dream-status (dream-au-bapp (dream-request "GET" "/" {} "")))
|
|
401)
|
|
(dream-au-test
|
|
"bearer 401 header"
|
|
(dream-resp-header
|
|
(dream-au-bapp (dream-request "GET" "/" {} ""))
|
|
"www-authenticate")
|
|
"Bearer")
|
|
|
|
(define dream-au-tests-run! (fn () {:total (+ dream-au-pass dream-au-fail) :passed dream-au-pass :failed dream-au-fail :fails dream-au-fails}))
|