From 8e0f06aa28318373aaffbef22c40e25fd5e3fb4c Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Jul 2026 10:07:40 +0000 Subject: [PATCH] H1: HMAC-gate internal endpoints /ticket /order /person (TDD) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Failing tests first (4 red: unsigned POSTs returned 200 and minted objects), then the gate: host/blog--int-verify? checks x-int-sig = sess-sig(fed-secret, request TARGET) (params live in the query, body is empty); host/blog--protect-internal wraps the three routes → 403 unsigned. Secret unset = open (dev/tests). Callers (events→shop /ticket + /order, shop→identity /person) sign via host/blog--int-headers. Closes the live capacity-bypass (anyone could mint tickets directly). blog suite 225/225 (218 + 7 new). Co-Authored-By: Claude Opus 4.8 --- lib/host/blog.sx | 34 ++++++++++++++++++++++++++-------- lib/host/tests/blog.sx | 31 +++++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+), 8 deletions(-) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 33ab21fe..5f29cc66 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -161,7 +161,9 @@ ;; domain call, like the RA kernel — not everything is a federated activity; directed reads/writes ;; are fine.) (define host/blog--http-order - (fn (event) (get (http-request "POST" (str host/blog--shop-base "/order?event=" event) {} "") "body"))) + (fn (event) + (let ((target (str "/order?event=" event))) + (get (http-request "POST" (str host/blog--shop-base target) (host/blog--int-headers target) "") "body")))) (define host/blog--allocate-activity (fn (post calendar) {:verb "allocate" :actor host/blog--actor @@ -256,6 +258,21 @@ (fn (req body) (or (= host/blog--fed-secret "") (= (str (or (dream-header req "x-fed-sig") "")) (dr/sess-sig host/blog--fed-secret body))))) +;; H1: INTERNAL service endpoints (/ticket /order /person) are peer-to-peer only — the caller signs +;; the request TARGET (path+query; these carry params in the query, body is empty) with the shared +;; fed secret in x-int-sig. Unsigned/miss-signed → 403. Secret unset ("") = open (dev/tests). +(define host/blog--int-verify? + (fn (req) + (or (= host/blog--fed-secret "") + (= (str (or (dream-header req "x-int-sig") "")) + (dr/sess-sig host/blog--fed-secret (get req :target)))))) +(define host/blog--protect-internal + (fn (handler) + (fn (req) + (if (host/blog--int-verify? req) (handler req) + (dream-response 403 {:content-type "text/plain; charset=utf-8"} "forbidden: internal endpoint"))))) +;; sign an internal call's target for http-request headers. +(define host/blog--int-headers (fn (target) {"x-int-sig" (host/blog--fed-sign target)})) ;; FOLLOW another actor: POST a follow to its /inbox announcing OUR actor + base, so it delivers to us. (define host/blog--follow! (fn (target-base) @@ -3253,9 +3270,9 @@ (let ((actor (str email "#" (str (len (ev/roster host/blog-store showing)))))) (let ((bk (ev/book! host/blog-store showing (host/blog--showing-capacity showing) actor))) (when (= (get bk :status) :booked) - (let ((body (get (http-request "POST" - (str host/blog--shop-base "/ticket?showing=" showing "&offering=" offering "&email=" email) - {} "") "body"))) + (let ((body (let ((target (str "/ticket?showing=" showing "&offering=" offering "&email=" email))) + (get (http-request "POST" (str host/blog--shop-base target) + (host/blog--int-headers target) "") "body")))) (when (starts-with? body "ticket:") (let ((tid (substr body 7 (- (len body) 7)))) (begin @@ -3315,7 +3332,8 @@ (host/blog-relate! tid email "owned-by") (host/blog--set-field-values! tid {"email" email}) (when (not (= host/blog--identity-base "")) - (http-request "POST" (str host/blog--identity-base "/person?email=" email) {} "")) + (let ((target (str "/person?email=" email))) + (http-request "POST" (str host/blog--identity-base target) (host/blog--int-headers target) ""))) (dream-response 200 {:content-type "text/plain; charset=utf-8"} (str "ticket:" tid))))))) ;; identity: find-or-create a Person keyed by a contact-id (email), login-optional → "person:". (define host/blog-person @@ -3521,11 +3539,11 @@ (dream-post "/offering-remove" host/blog-offering-remove) (dream-post "/add-poll" host/blog-add-poll) (dream-post "/vote" host/blog-vote) - (dream-post "/ticket" host/blog-ticket) - (dream-post "/person" host/blog-person) + (dream-post "/ticket" (host/blog--protect-internal host/blog-ticket)) + (dream-post "/person" (host/blog--protect-internal host/blog-person)) (dream-post "/new-event" host/blog-new-event) (dream-post "/buy" host/blog-buy) - (dream-post "/order" host/blog-order) + (dream-post "/order" (host/blog--protect-internal host/blog-order)) (dream-get "/activities" host/blog-activities) (dream-get "/:slug/source" host/blog-source) (dream-get "/:slug/relate-options" host/blog-relate-options) diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index 510ee620..6b0d8b7f 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -1315,6 +1315,37 @@ (list before (map (fn (e) (get e "verb")) host/blog--flow-log))))) (list (list "validate" "digest") (list "validate" "digest"))) +;; ── HARDENING H1: internal endpoints (/ticket /order /person) are HMAC-gated ───────────── +;; With a fed-secret set, an UNSIGNED POST is 403 and creates nothing; a SIGNED one +;; (x-int-sig = sess-sig(secret, target)) works. Secret unset ("") = open (dev/test compat). +(host/blog-use-store! (persist/open)) +(define host-bl-h1-secret "test-int-secret") +(host/blog--set-fed-secret! host-bl-h1-secret) +(define host-bl-h1-app (host/make-app (list host/blog-routes))) +(define host-bl-h1-post + (fn (target sig) + (host-bl-h1-app (dream-request "POST" target + (if sig {:x-int-sig (dr/sess-sig host-bl-h1-secret target)} {}) "")))) + +(host-bl-test "H1: unsigned /ticket -> 403" + (dream-status (host-bl-h1-post "/ticket?showing=sh1&offering=sh1--adult&email=a@x.com" false)) 403) +(host-bl-test "H1: unsigned /ticket creates NO ticket" + (len (filter (fn (s) (starts-with? s "ticket-")) (host/blog-slugs))) 0) +(host-bl-test "H1: signed /ticket -> 200 ticket:*" + (starts-with? (dream-resp-body (host-bl-h1-post "/ticket?showing=sh1&offering=sh1--adult&email=a@x.com" true)) "ticket:") + true) +(host-bl-test "H1: unsigned /order -> 403" + (dream-status (host-bl-h1-post "/order?event=sh1" false)) 403) +(host-bl-test "H1: unsigned /person -> 403" + (dream-status (host-bl-h1-post "/person?email=a@x.com" false)) 403) +(host-bl-test "H1: signed /person -> 200 person:*" + (starts-with? (dream-resp-body (host-bl-h1-post "/person?email=a@x.com" true)) "person:") + true) +(host/blog--set-fed-secret! "") +(host-bl-test "H1: secret unset -> /person open (dev compat)" + (starts-with? (dream-resp-body (host-bl-h1-post "/person?email=b@x.com" false)) "person:") + true) + (define host-bl-tests-run! (fn ()