host: browser auth redirects to login (no more raw JSON 401), with return-to
Clicking "edit" while logged out returned a raw JSON 401
{"ok":false,"error":"unauthorized"} — a dead end in the browser. HTML routes
now redirect to a usable login page and return you afterwards.
- host/require-login: browser-shaped guard. Same session-or-bearer check as
host/require-user, but on failure REDIRECTS to /login?next=<path> instead of
JSON 401. (host/require-user stays for JSON/API routes.)
- host/-principal-of: shared session-then-bearer resolution.
- login honours ?next=: GET /login renders a hidden next field; POST /login
redirects there on success and re-renders the form (with next) on failure.
- host/-safe-next: only same-site absolute paths are honoured — //evil.com and
http://… fall back to "/", closing the open-redirect.
- blog: host/blog--protect-html (require-login) guards the browser routes —
POST /new, GET/POST /:slug/edit; the JSON /posts routes keep host/require-user.
Do we need login? Yes — it's the write/edit auth boundary; without it anyone
could edit or delete posts. The bug was the dead-end 401, not the gate. Now
logged-out edit -> login -> back to edit is a clean flow.
Tests: blog no-auth write routes assert 303 + Location /login(+next); session
suite gains next round-trip + open-redirect-guard cases. 218/218.
Verified live: /welcome/edit logged out -> 303 /login?next=/welcome/edit;
login -> 303 back to /welcome/edit -> 200.
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -29,37 +29,49 @@
|
||||
(= user host/admin-user)
|
||||
(= pass host/admin-password))))
|
||||
|
||||
;; ── GET /login — minimal SX login form ──────────────────────────────
|
||||
;; A return-to target is only honoured if it's a same-site absolute PATH — guards
|
||||
;; against an open-redirect (//evil.com, http://…) smuggled through ?next=.
|
||||
(define host/-safe-next
|
||||
(fn (n)
|
||||
(if (and n (not (= n "")) (starts-with? n "/") (not (starts-with? n "//")))
|
||||
n "/")))
|
||||
|
||||
;; The login form, parameterised by where to return after success.
|
||||
(define host/-login-form
|
||||
(fn (next-path message)
|
||||
(host/-auth-page "Log in"
|
||||
(quasiquote
|
||||
(div
|
||||
(h1 "Log in")
|
||||
(unquote (if message (quasiquote (p :style "color:#b00" (unquote message))) ""))
|
||||
(form :method "post" :action "/login"
|
||||
(input :type "hidden" :name "next" :value (unquote next-path))
|
||||
(p (input :name "username" :placeholder "username"))
|
||||
(p (input :name "password" :type "password" :placeholder "password"))
|
||||
(p (button :type "submit" "Log in"))))))))
|
||||
|
||||
;; ── GET /login — login form, honouring ?next= (where to go after login) ─────
|
||||
(define host/login-page
|
||||
(fn (req)
|
||||
(dream-html
|
||||
(host/-auth-page "Log in"
|
||||
(quasiquote
|
||||
(div
|
||||
(h1 "Log in")
|
||||
(form :method "post" :action "/login"
|
||||
(p (input :name "username" :placeholder "username"))
|
||||
(p (input :name "password" :type "password" :placeholder "password"))
|
||||
(p (button :type "submit" "Log in")))))))))
|
||||
(host/-login-form (host/-safe-next (dream-query-param req "next")) nil))))
|
||||
|
||||
;; ── POST /login — verify, write session principal, redirect home ────
|
||||
;; ── POST /login — verify, write session principal, redirect to ?next ────────
|
||||
;; The session middleware (host/sessions) has already created/loaded the session
|
||||
;; and will set the cookie on this response, so writing :principal here lands on
|
||||
;; the right sid and the browser keeps the cookie.
|
||||
;; the right sid and the browser keeps the cookie. On failure the form re-renders
|
||||
;; with the same return target so the user lands where they were headed.
|
||||
(define host/login-submit
|
||||
(fn (req)
|
||||
(let ((user (dream-form-field req "username"))
|
||||
(pass (dream-form-field req "password")))
|
||||
(pass (dream-form-field req "password"))
|
||||
(next-path (host/-safe-next (dream-form-field req "next"))))
|
||||
(if (host/-verify-cred user pass)
|
||||
(begin
|
||||
(host/login! req user)
|
||||
(dream-redirect "/"))
|
||||
(dream-redirect next-path))
|
||||
(dream-html-status 401
|
||||
(host/-auth-page "Log in"
|
||||
(quasiquote
|
||||
(div (h1 "Log in")
|
||||
(p "Invalid credentials.")
|
||||
(p (a :href "/login" "Try again."))))))))))
|
||||
(host/-login-form next-path "Invalid credentials — try again."))))))
|
||||
|
||||
;; ── POST /logout — clear the session, redirect home ─────────────────
|
||||
(define host/logout-submit
|
||||
@@ -75,22 +87,40 @@
|
||||
(dream-post "/login" host/login-submit)
|
||||
(dream-post "/logout" host/logout-submit)))
|
||||
|
||||
;; ── auth middleware: session principal OR bearer token ──────────────
|
||||
;; The authenticated principal for a request, or nil: a logged-in session takes
|
||||
;; precedence, else a Bearer token resolved by `resolve` (the API fallback).
|
||||
(define host/-principal-of
|
||||
(fn (req resolve)
|
||||
(let ((sp (host/current-principal req)))
|
||||
(if (and sp (not (= sp "")))
|
||||
sp
|
||||
(let ((tok (dream-bearer-token req)))
|
||||
(if tok (resolve tok) nil))))))
|
||||
|
||||
;; ── auth middleware (API shape): session principal OR bearer token ──
|
||||
;; Place AFTER the session middleware (so host/current-principal can read the
|
||||
;; session) and BEFORE host/require-permission. resolve : token -> principal | nil
|
||||
;; is the bearer fallback for API clients; a logged-in browser needs no token.
|
||||
;; session) and BEFORE host/require-permission. On failure -> JSON 401 with a
|
||||
;; Bearer challenge. For API/JSON routes; browser pages want host/require-login.
|
||||
(define host/require-user
|
||||
(fn (resolve)
|
||||
(fn (next)
|
||||
(fn (req)
|
||||
(let ((sp (host/current-principal req)))
|
||||
(let ((principal
|
||||
(if (and sp (not (= sp "")))
|
||||
sp
|
||||
(let ((tok (dream-bearer-token req)))
|
||||
(if tok (resolve tok) nil)))))
|
||||
(if (or (nil? principal) (= principal ""))
|
||||
(dream-add-header
|
||||
(host/error 401 "unauthorized")
|
||||
"www-authenticate" "Bearer")
|
||||
(next (assoc req :dream-principal principal)))))))))
|
||||
(let ((principal (host/-principal-of req resolve)))
|
||||
(if (or (nil? principal) (= principal ""))
|
||||
(dream-add-header
|
||||
(host/error 401 "unauthorized")
|
||||
"www-authenticate" "Bearer")
|
||||
(next (assoc req :dream-principal principal))))))))
|
||||
|
||||
;; ── auth middleware (browser shape): same check, but on failure REDIRECT to
|
||||
;; the login page with a return-to, instead of a raw JSON 401. Use this for HTML
|
||||
;; routes (an edit form, the create form) so an unauthenticated click lands on a
|
||||
;; usable login page and returns to where it was headed after logging in. ──
|
||||
(define host/require-login
|
||||
(fn (resolve)
|
||||
(fn (next)
|
||||
(fn (req)
|
||||
(let ((principal (host/-principal-of req resolve)))
|
||||
(if (or (nil? principal) (= principal ""))
|
||||
(dream-redirect (str "/login?next=" (host/-safe-next (dream-path req))))
|
||||
(next (assoc req :dream-principal principal))))))))
|
||||
|
||||
Reference in New Issue
Block a user