diff --git a/lib/host/auth.sx b/lib/host/auth.sx index e008520e..3921d6af 100644 --- a/lib/host/auth.sx +++ b/lib/host/auth.sx @@ -73,7 +73,8 @@ (dream-html-status 401 (host/-login-form next-path "Invalid credentials — try again.")))))) -;; ── POST /logout — clear the session, redirect home ───────────────── +;; ── /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 @@ -85,8 +86,22 @@ (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 · 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 diff --git a/lib/host/blog.sx b/lib/host/blog.sx index bbbf7f17..8fbdd1af 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -115,7 +115,9 @@ " · " (a :href (unquote (str "/" slug "/edit")) "edit") " · " - (a :href "/" "all posts")))))) + (a :href "/" "all posts") + " · " + (unquote (host/auth-footer req))))))) (dream-html-status 404 (host/blog--page "Not found" (quasiquote @@ -140,7 +142,9 @@ (quasiquote (div (h1 "Posts") (unquote listing) - (p (a :href "/new" "+ New post"))))))))))) + (p (a :href "/new" "+ New post")) + (p :style "margin-top:2em;font-size:0.9em;opacity:0.8" + (unquote (host/auth-footer req)))))))))))) (define host/blog-index (fn (req) (host/ok (host/blog-list)))) diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index f4d5a604..68618b03 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -203,6 +203,14 @@ (host-bl-test "edit missing post -> 404" (dream-status (host-bl-wapp (host-bl-send "GET" "/ghost/edit" "Bearer good" "" ""))) 404) +;; -- auth footer (discoverable login/logout) -- +(host-bl-test "home footer shows a log in link when anonymous" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/"))) ">log in") true) +(host-bl-test "post footer shows a log in link when anonymous" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/my-first-post/"))) ">log in") true) +(host-bl-test "GET /logout -> 303" + (dream-status (host-bl-app (host-bl-req "/logout"))) 303) + ;; -- experimental unguarded create-only route (POST /new, no auth) -- (define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes))) (host/blog-use-store! (persist/open))