;; 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) ;; ── return-to (?next=) after login ────────────────────────────────── (host-se-test "login page carries ?next in a hidden field" (contains? (dream-resp-body (host-se-app (dream-request "GET" "/login?next=/secure" {} ""))) "value=\"/secure\"") true) (host-se-test "login redirects to next on success" (dream-resp-header (host-se-app (dream-request "POST" "/login" {} "username=admin&password=secret&next=/secure")) "location") "/secure") (host-se-test "login rejects open-redirect next (//evil) -> /" (dream-resp-header (host-se-app (dream-request "POST" "/login" {} "username=admin&password=secret&next=//evil.com")) "location") "/") ;; ── 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}))