giles
3b8e1dfe2e
Unblock the guarded blog write routes for browsers: a login form sets a signed session cookie that the same routes accept (alongside Bearer), so publishing works end-to-end on blog.rose-ash.com without Quart. - kernel: http-listen emit serialises a response :set-cookies LIST as one Set-Cookie header each (a headers dict can't hold more than one). Purely additive — responses without :set-cookies are unchanged. - server.sx: host/-dream->native forwards :set-cookies to the native resp. - lib/host/session.sx: durable, signed sessions on the persist KV (session/create|exists|get|set|clear), wired via dream-sessions-signed. - lib/host/auth.sx: GET/POST /login + POST /logout; host/require-user accepts a session principal OR a Bearer token. - router.sx: host/make-app wraps the whole app in the session middleware and auto-mounts /login + /logout — the front door always has sessions. - blog.sx: write routes use host/require-user; serve.sh flips POST /new from the experimental UNGUARDED route to the guarded write routes, with admin creds + signing secret + ACL grant from the container env. - session conformance suite (12): login->cookie->guarded write 201; no cookie/forged/logged-out -> 401; Bearer fallback still works. Verified live on blog.rose-ash.com: 401 unauthenticated, 303 login, 303 publish, anonymous read renders, post persists across container recreate. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
118 lines
5.3 KiB
Plaintext
118 lines
5.3 KiB
Plaintext
;; lib/host/tests/session.sx — the live-write story end-to-end: a browser logs in
|
|
;; (POST /login) → signed session cookie → guarded write succeeds; no cookie → 401;
|
|
;; the Bearer path still works for API clients; logout drops the principal.
|
|
;; make-app auto-mounts /login + /logout and wraps everything in host/sessions, so
|
|
;; these tests drive the WHOLE app handler (session middleware + router) the way
|
|
;; the native server does.
|
|
|
|
(define host-se-pass 0)
|
|
(define host-se-fail 0)
|
|
(define host-se-fails (list))
|
|
|
|
(define host-se-test
|
|
(fn (name actual expected)
|
|
(if (= actual expected)
|
|
(set! host-se-pass (+ host-se-pass 1))
|
|
(begin
|
|
(set! host-se-fail (+ host-se-fail 1))
|
|
(append! host-se-fails {:name name :actual actual :expected expected})))))
|
|
|
|
;; ── fixtures ────────────────────────────────────────────────────────
|
|
(acl/load! (list (acl-grant "admin" "edit" "blog")))
|
|
(host/auth-set-admin! "admin" "secret")
|
|
(host/session-set-secret! "test-session-secret")
|
|
|
|
;; bearer fallback for API clients (session is the browser path)
|
|
(define host-se-resolve (fn (tok) (if (= tok "apitoken") "admin" nil)))
|
|
|
|
;; a guarded write route isolating the session mechanism from blog specifics:
|
|
;; same pipeline shape as host/blog--protect (wrap-errors + require-user + ACL).
|
|
(define host-se-secure-h
|
|
(host/pipeline
|
|
(list
|
|
host/wrap-errors
|
|
(host/require-user host-se-resolve)
|
|
(host/require-permission "edit" (fn (req) "blog")))
|
|
(fn (req) (host/ok-status 201 (host/principal req)))))
|
|
|
|
(define host-se-app
|
|
(host/make-app (list (list (dream-post "/secure" host-se-secure-h)))))
|
|
|
|
;; ── helpers ─────────────────────────────────────────────────────────
|
|
(define host-se-login
|
|
(fn (user pass)
|
|
(host-se-app
|
|
(dream-request "POST" "/login" {}
|
|
(str "username=" user "&password=" pass)))))
|
|
|
|
;; the name=value pair from the Set-Cookie (drop the "; Path=…" attributes)
|
|
(define host-se-cookie-of
|
|
(fn (resp)
|
|
(let ((c (first (dream-resp-cookies resp))))
|
|
(if (nil? c) nil (substr c 0 (index-of c ";"))))))
|
|
|
|
(define host-se-secure
|
|
(fn (cookie)
|
|
(host-se-app
|
|
(dream-request "POST" "/secure" (if cookie {:cookie cookie} {}) ""))))
|
|
|
|
(define host-se-secure-bearer
|
|
(fn (tok)
|
|
(host-se-app
|
|
(dream-request "POST" "/secure" {:authorization (str "Bearer " tok)} ""))))
|
|
|
|
;; ── login ───────────────────────────────────────────────────────────
|
|
(host-se-test "login good creds -> 303 redirect"
|
|
(dream-status (host-se-login "admin" "secret")) 303)
|
|
(host-se-test "login good creds sets a session cookie"
|
|
(not (nil? (host-se-cookie-of (host-se-login "admin" "secret")))) true)
|
|
(host-se-test "login bad creds -> 401"
|
|
(dream-status (host-se-login "admin" "wrong")) 401)
|
|
|
|
;; ── session-authed write ────────────────────────────────────────────
|
|
(host-se-test "logged-in session passes the guarded write -> 201"
|
|
(dream-status (host-se-secure (host-se-cookie-of (host-se-login "admin" "secret"))))
|
|
201)
|
|
(host-se-test "principal threaded from the session to the handler"
|
|
(contains?
|
|
(dream-resp-body (host-se-secure (host-se-cookie-of (host-se-login "admin" "secret"))))
|
|
"\"data\":\"admin\"")
|
|
true)
|
|
|
|
;; ── unauthenticated / forged ────────────────────────────────────────
|
|
(host-se-test "no cookie -> 401"
|
|
(dream-status (host-se-secure nil)) 401)
|
|
(host-se-test "bad-cred login leaves an anonymous session (no principal) -> 401"
|
|
(dream-status (host-se-secure (host-se-cookie-of (host-se-login "admin" "wrong"))))
|
|
401)
|
|
(host-se-test "forged cookie -> 401"
|
|
(dream-status (host-se-secure "dream.session=s1|forged")) 401)
|
|
|
|
;; ── bearer fallback (API path still works) ──────────────────────────
|
|
(host-se-test "valid bearer token -> 201"
|
|
(dream-status (host-se-secure-bearer "apitoken")) 201)
|
|
(host-se-test "invalid bearer token -> 401"
|
|
(dream-status (host-se-secure-bearer "nope")) 401)
|
|
|
|
;; ── logout ──────────────────────────────────────────────────────────
|
|
;; log in, get the cookie, log out with it, then the same cookie no longer authes.
|
|
(define host-se-logout
|
|
(fn (cookie)
|
|
(host-se-app
|
|
(dream-request "POST" "/logout" (if cookie {:cookie cookie} {}) ""))))
|
|
(define host-se-live-cookie (host-se-cookie-of (host-se-login "admin" "secret")))
|
|
(host-se-test "logout returns 303"
|
|
(dream-status (host-se-logout host-se-live-cookie)) 303)
|
|
(host-se-test "after logout the cookie no longer authes -> 401"
|
|
(begin
|
|
(host-se-logout host-se-live-cookie)
|
|
(dream-status (host-se-secure host-se-live-cookie)))
|
|
401)
|
|
|
|
(define host-se-tests-run!
|
|
(fn ()
|
|
{:total (+ host-se-pass host-se-fail)
|
|
:passed host-se-pass
|
|
:failed host-se-fail
|
|
:fails host-se-fails}))
|