giles
6419aa38c5
Login had no visible entry point — you could only reach it by hitting a guard. Add an auth footer the pages splice in: "log in" when logged out, "signed in as <user> · log out" when logged in. - host/auth-footer: SX fragment reading the session principal; guards a session-less request so it's safe to call anywhere. - GET /logout added alongside POST so the footer link is a plain <a> (logout is low-harm; GET is acceptable). Clears the session, redirects home. - home and post pages splice (host/auth-footer req) into their footer. Tests: home + post footers show a login link when anonymous; GET /logout -> 303. 221/221. Verified live: anonymous shows "log in"; logged in shows "signed in as admin · log out"; /logout reverts it. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
142 lines
6.3 KiB
Plaintext
142 lines
6.3 KiB
Plaintext
;; lib/host/auth.sx — browser login on top of host sessions (lib/host/session.sx).
|
|
;; A login form posts credentials; on success the principal is written to the
|
|
;; session cookie. The guarded write routes then accept EITHER a logged-in session
|
|
;; OR a Bearer token (host/require-user), so the same routes serve browsers and API
|
|
;; clients. Single admin user; credentials come from $SX_ADMIN_USER / _PASSWORD
|
|
;; (set in serve.sh) — the in-source defaults are dev-only.
|
|
;;
|
|
;; Depends on lib/host/session.sx, lib/host/{handler,middleware}.sx, lib/dream/*
|
|
;; (form/types/session) + the kernel render-page primitive.
|
|
|
|
;; ── page shell (own copy; render-page renders the static SX tree) ───
|
|
(define host/-auth-page
|
|
(fn (title body)
|
|
(str "<!doctype html>"
|
|
(render-page
|
|
(quasiquote
|
|
(html
|
|
(head (meta :charset "utf-8") (title (unquote title)))
|
|
(body (unquote body))))))))
|
|
|
|
;; ── admin credential (override from env in serve.sh) ────────────────
|
|
(define host/admin-user "admin")
|
|
(define host/admin-password "letmein")
|
|
(define host/auth-set-admin!
|
|
(fn (u p) (begin (set! host/admin-user u) (set! host/admin-password p))))
|
|
(define host/-verify-cred
|
|
(fn (user pass)
|
|
(and (not (= pass ""))
|
|
(= user host/admin-user)
|
|
(= pass host/admin-password))))
|
|
|
|
;; 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/-login-form (host/-safe-next (dream-query-param req "next")) nil))))
|
|
|
|
;; ── 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. 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"))
|
|
(next-path (host/-safe-next (dream-form-field req "next"))))
|
|
(if (host/-verify-cred user pass)
|
|
(begin
|
|
(host/login! req user)
|
|
(dream-redirect next-path))
|
|
(dream-html-status 401
|
|
(host/-login-form next-path "Invalid credentials — try again."))))))
|
|
|
|
;; ── /logout — clear the session, redirect home. Allowed on GET too so a plain
|
|
;; footer link can log out (logout is low-harm, so GET is acceptable here). ─────
|
|
(define host/logout-submit
|
|
(fn (req)
|
|
(begin
|
|
(host/logout! req)
|
|
(dream-redirect "/"))))
|
|
|
|
;; ── login routes (mounted by host/make-app) ─────────────────────────
|
|
(define host/auth-routes
|
|
(list
|
|
(dream-get "/login" host/login-page)
|
|
(dream-post "/login" host/login-submit)
|
|
(dream-get "/logout" host/logout-submit)
|
|
(dream-post "/logout" host/logout-submit)))
|
|
|
|
;; ── auth footer fragment ────────────────────────────────────────────
|
|
;; A small SX node pages splice into their footer: "log in" when logged out,
|
|
;; "signed in as <user> · log out" when logged in. Guards a session-less request
|
|
;; (no middleware) so it's safe to call anywhere. Reads the session principal.
|
|
(define host/auth-footer
|
|
(fn (req)
|
|
(let ((who (if (get req :dream-session) (host/current-principal req) nil)))
|
|
(if (and who (not (= who "")))
|
|
(quasiquote
|
|
(span (unquote (str "signed in as " who)) " · "
|
|
(a :href "/logout" "log out")))
|
|
(quote (a :href "/login" "log in"))))))
|
|
|
|
;; 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. 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 ((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))))))))
|