rose-ash/lib/host/tests/session.sx

;; 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)

;; ── lazy persistence: only a written (logged-in) session leaves a durable row ──
(host-se-test "session/create writes no row (anonymous leaves no durable trace)"
  (host/session-backend {:op "session/exists" :sid (host/session-backend {:op "session/create"})})
  false)
(host-se-test "session/set creates the row (a login persists)"
  (let ((sid (host/session-backend {:op "session/create"})))
    (begin
      (host/session-backend {:op "session/set" :sid sid :key :principal :val "bob"})
      (list (host/session-backend {:op "session/exists" :sid sid})
            (host/session-backend {:op "session/get" :sid sid :key :principal}))))
  (list true "bob"))

(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}))