giles
999249b944
Greenfield SX-native pivot (NOT a strangler): the host speaks SX/SXTP end to end;
JSON only at the future ActivityPub federation edge.
- OUTPUT: host/json-status -> host/sx-status — every host/ok/host/error response is
text/sx via the serialize primitive (NOT application/json). Flips feed, relations,
blog reads. Tests assert the SX envelope ({:ok true :data ...}).
- DELETE the blog JSON CRUD /posts (POST/PUT/DELETE) + bearer-based host/blog--protect:
a pure old-contract REST mirror. Create/edit go through the HTML editor forms;
programmatic writes speak SXTP. FOLLOW-UP: no browser delete route yet (was JSON-only,
no UI) — add POST /:slug/delete + cascade edge cleanup when the metamodel UI needs it.
- INPUT: host/sx-body (sxtp.sx) parses a text/sx request body to a string-keyed dict
(parse-safe + sxtp/-normalize). feed POST + relations attach/detach read it.
- UNIFIED field reader host/fields / host/field: text/sx body OR urlencoded form by
content-type. The blog form handlers (new/edit/relate/unrelate) + login read through
it — additive, urlencoded still works (no-engine / bootstrap fallback).
Conformance 290/290 (11 suites). Retires the strangler framing in the plan; adds the
'SX all the way out' wire table. The engine half (browser posts text/sx) follows.
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
147 lines
6.6 KiB
Plaintext
147 lines
6.6 KiB
Plaintext
;; 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}))
|