From 85aea61f3cd9bb0ffe18e5a4357e3c0258647625 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 15:16:29 +0000 Subject: [PATCH] =?UTF-8?q?dream:=20auth=20=E2=80=94=20pure-SX=20base64=20?= =?UTF-8?q?+=20HTTP=20Basic=20+=20Bearer-token=20middleware=20+=2023=20tes?= =?UTF-8?q?ts?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/dream/auth.sx | 172 +++++++++++++++++++++++++++++++++++++++ lib/dream/conformance.sh | 2 + lib/dream/tests/auth.sx | 109 +++++++++++++++++++++++++ plans/dream-on-sx.md | 7 ++ 4 files changed, 290 insertions(+) create mode 100644 lib/dream/auth.sx create mode 100644 lib/dream/tests/auth.sx diff --git a/lib/dream/auth.sx b/lib/dream/auth.sx new file mode 100644 index 00000000..16c5dd61 --- /dev/null +++ b/lib/dream/auth.sx @@ -0,0 +1,172 @@ +;; lib/dream/auth.sx — Dream-on-SX authentication helpers. +;; HTTP Basic auth (with a pure-SX base64 codec) and Bearer-token guards. +;; Depends on types.sx. + +;; ── base64 (pure SX; arithmetic, no bitwise) ─────────────────────── +(define + dr/b64-alpha + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") +(define dr/b64-char (fn (n) (char-at dr/b64-alpha n))) +(define dr/b64-index (fn (c) (index-of dr/b64-alpha c))) + +(define + dr/b64-encode-loop + (fn + (s i n acc) + (if + (>= i n) + acc + (let + ((b0 (char-code (char-at s i))) (rem (- n i))) + (cond + ((>= rem 3) + (let + ((triple (+ (* b0 65536) (* (char-code (char-at s (+ i 1))) 256) (char-code (char-at s (+ i 2)))))) + (dr/b64-encode-loop + s + (+ i 3) + n + (str + acc + (dr/b64-char (mod (quotient triple 262144) 64)) + (dr/b64-char (mod (quotient triple 4096) 64)) + (dr/b64-char (mod (quotient triple 64) 64)) + (dr/b64-char (mod triple 64)))))) + ((= rem 2) + (let + ((triple (+ (* b0 65536) (* (char-code (char-at s (+ i 1))) 256)))) + (str + acc + (dr/b64-char (mod (quotient triple 262144) 64)) + (dr/b64-char (mod (quotient triple 4096) 64)) + (dr/b64-char (mod (quotient triple 64) 64)) + "="))) + (else + (let + ((triple (* b0 65536))) + (str + acc + (dr/b64-char (mod (quotient triple 262144) 64)) + (dr/b64-char (mod (quotient triple 4096) 64)) + "==")))))))) + +(define + dream-base64-encode + (fn (s) (dr/b64-encode-loop s 0 (string-length s) ""))) + +(define + dr/b64-decode-loop + (fn + (s i n acc) + (if + (>= i n) + acc + (let + ((p2 (char-at s (+ i 2))) + (p3 (char-at s (+ i 3)))) + (let + ((c0 (dr/b64-index (char-at s i))) + (c1 (dr/b64-index (char-at s (+ i 1)))) + (c2 (if (= p2 "=") 0 (dr/b64-index p2))) + (c3 (if (= p3 "=") 0 (dr/b64-index p3)))) + (let + ((triple (+ (* c0 262144) (* c1 4096) (* c2 64) c3))) + (dr/b64-decode-loop + s + (+ i 4) + n + (str + acc + (char-from-code + (mod (quotient triple 65536) 256)) + (if + (= p2 "=") + "" + (char-from-code + (mod (quotient triple 256) 256))) + (if (= p3 "=") "" (char-from-code (mod triple 256))))))))))) + +(define + dream-base64-decode + (fn + (s) + (if (= s "") "" (dr/b64-decode-loop s 0 (string-length s) "")))) + +;; ── Authorization header parsing ─────────────────────────────────── +(define dream-authorization (fn (req) (dream-header req "authorization"))) + +(define + dream-bearer-token + (fn + (req) + (let + ((a (dream-authorization req))) + (if (and a (starts-with? a "Bearer ")) (substr a 7) nil)))) + +(define + dream-basic-credentials + (fn + (req) + (let + ((a (dream-authorization req))) + (if + (and a (starts-with? a "Basic ")) + (let + ((decoded (dream-base64-decode (substr a 6)))) + (let + ((colon (index-of decoded ":"))) + (if (< colon 0) nil {:pass (substr decoded (+ colon 1)) :user (substr decoded 0 colon)}))) + nil)))) + +;; ── Basic auth middleware ────────────────────────────────────────── +;; check is (fn (user pass) -> bool). On success the request gains :dream-user. +(define + dr/www-authenticate + (fn + (realm) + (dream-add-header + (dream-response 401 {:content-type "text/plain; charset=utf-8"} "Unauthorized") + "www-authenticate" + (str "Basic realm=\"" realm "\"")))) + +(define + dream-basic-auth + (fn + (realm check) + (fn + (next) + (fn + (req) + (let + ((creds (dream-basic-credentials req))) + (if + (and creds (check (get creds :user) (get creds :pass))) + (next (assoc req :dream-user (get creds :user))) + (dr/www-authenticate realm))))))) + +(define dream-user (fn (req) (get req :dream-user))) + +;; ── Bearer-token middleware ──────────────────────────────────────── +;; check is (fn (token) -> principal | nil). On success the request gains +;; :dream-principal. Missing/invalid -> 401. +(define + dream-require-bearer + (fn + (check) + (fn + (next) + (fn + (req) + (let + ((tok (dream-bearer-token req))) + (let + ((principal (if tok (check tok) nil))) + (if + (nil? principal) + (dream-add-header + (dream-response 401 {:content-type "text/plain; charset=utf-8"} "Unauthorized") + "www-authenticate" + "Bearer") + (next (assoc req :dream-principal principal))))))))) + +(define dream-principal (fn (req) (get req :dream-principal))) diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 0d634986..2aae5fca 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -33,6 +33,7 @@ MODULES=( "lib/dream/error.sx" "lib/dream/cors.sx" "lib/dream/json.sx" + "lib/dream/auth.sx" "lib/dream/run.sx" "lib/dream/api.sx" "lib/dream/demos/hello.sx" @@ -54,6 +55,7 @@ SUITES=( "error dream-er-tests-run! lib/dream/tests/error.sx" "cors dream-co-tests-run! lib/dream/tests/cors.sx" "json dream-js-tests-run! lib/dream/tests/json.sx" + "auth dream-au-tests-run! lib/dream/tests/auth.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" "api dream-ap-tests-run! lib/dream/tests/api.sx" "demos dream-dm-tests-run! lib/dream/tests/demos.sx" diff --git a/lib/dream/tests/auth.sx b/lib/dream/tests/auth.sx new file mode 100644 index 00000000..f5cb9806 --- /dev/null +++ b/lib/dream/tests/auth.sx @@ -0,0 +1,109 @@ +;; 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})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 913d4cb7..55db180e 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -130,6 +130,12 @@ with extensions + hardening below. `dream-serve`/`dream-serve-port`. `lib/dream/README.md` documents the full public surface, quickstart, the dependency-injection testing story, and caveats. **All planned extensions complete — 367/367 across 14 suites.** +- **2026-06-07 — Ext: auth** (`lib/dream/auth.sx`, 23 tests, 390 total). Pure-SX base64 + codec (`dream-base64-encode`/`-decode`, arithmetic via `quotient`/`mod` — no bitwise), + verified against RFC vectors (Man/Ma/M padding). `dream-basic-auth realm check` → + 401 + `WWW-Authenticate: Basic realm=…`, attaches `:dream-user` on success; + `dream-basic-credentials` / `dream-authorization` accessors. `dream-require-bearer + check` → attaches `:dream-principal` or 401; `dream-bearer-token` accessor. ## Extensions (post-roadmap) @@ -144,6 +150,7 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **JSON helpers** (encode + recursive-descent parse, pure SX). - [x] **Query/header convenience** (`dream-queries`, `*-or` defaults, `dream-accepts?`). - [x] **`api.sx` facade + README** — `dream-make-app` / `dream-serve` + `README.md`. +- [x] **Auth** — base64 (pure SX), HTTP Basic auth + Bearer-token middleware. ## Stdlib additions Dream will need