;; 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 "" (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.")))))) ;; ── POST /logout — clear the session, redirect home ───────────────── (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-post "/logout" host/logout-submit))) ;; 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))))))))