diff --git a/lib/host/otel.sx b/lib/host/otel.sx index 26acadb5..11194303 100644 --- a/lib/host/otel.sx +++ b/lib/host/otel.sx @@ -73,13 +73,15 @@ (set! otel/-stack (list)) nil))) -;; ── with-span: the timed-effect combinator ─────────────────────────── +;; ── -timed: the shared timed-effect core ───────────────────────────── ;; Records a span around (thunk): a fresh span id, the trace inherited from the ;; enclosing span (or a new trace at the root), the enclosing span as :parent, and -;; t0/t1 straddling the call. Pushes its context so nested with-spans see it as -;; parent, pops after, then records the finished span. Returns the thunk's value. -(define otel/with-span - (fn (name attrs thunk) +;; t0/t1 straddling the call. Pushes its context so nested spans see it as parent, +;; pops after, then records the finished span. `finalize` maps the thunk's result +;; to EXTRA attrs merged onto `attrs` (e.g. an http.status only known post-call). +;; Returns the thunk's value unchanged. +(define otel/-timed + (fn (name attrs finalize thunk) (let ((parent-ctx (otel/-top))) (let ((trace (if parent-ctx (get parent-ctx :trace) (otel/gen-trace-id))) (span (otel/gen-span-id)) @@ -91,5 +93,36 @@ (otel/-pop!) (otel/record! {:trace trace :span span :parent parent :name name - :t0 t0 :t1 t1 :attrs attrs :events (list)}) + :t0 t0 :t1 t1 + :attrs (merge attrs (finalize result)) + :events (list)}) result)))))))) + +;; with-span — a plain timed span; no result-derived attrs. +(define otel/with-span + (fn (name attrs thunk) + (otel/-timed name attrs (fn (r) {}) thunk))) + +;; ── auto-instrument HTTP handlers ───────────────────────────────────── +;; A trace is a composition; a request handler is a timed effect. Wrap one Dream +;; route's handler so dispatching it records a root span "METHOD /route" with +;; {:http.method :http.route :http.status}. The status is only known after the +;; handler runs, so it's a finalize attr; the result is coerced the same way the +;; router coerces it, so a bare-string handler still reports 200. The raw handler +;; result is returned untouched so dr/run-route's own coercion is unchanged. +(define otel/instrument-route + (fn (r) + (let ((method (dream-route-method r)) + (path (dream-route-path r)) + (handler (dream-route-handler r))) + (dream-route method path + (fn (req) + (otel/-timed + (str method " " path) + {:http.method method :http.route path} + (fn (resp) {:http.status (dream-status (dream-coerce-response resp))}) + (fn () (handler req)))))))) + +;; Flatten nested route groups and instrument each route — the host/make-app seam. +(define otel/instrument-routes + (fn (routes) (map otel/instrument-route (dr/flatten-routes routes)))) diff --git a/lib/host/router.sx b/lib/host/router.sx index 678ae9fb..04c4a843 100644 --- a/lib/host/router.sx +++ b/lib/host/router.sx @@ -17,9 +17,14 @@ ;; needed. The WHOLE app is wrapped in the signed-session middleware so every ;; request carries a session and any handler can log a principal in/out — this is ;; the front door, so sessions are not optional. +;; Every route's handler is wrapped by otel/instrument-routes (lib/host/otel.sx) +;; so each matched request records a "METHOD /route" trace span — observability is +;; on by default at the front door. (Resolved at call time; otel loads before any +;; request is served.) (define host/make-app (fn (groups) (let ((router (dream-router - (cons host/health-route - (cons host/auth-routes groups))))) + (otel/instrument-routes + (cons host/health-route + (cons host/auth-routes groups)))))) ((host/sessions) router)))) diff --git a/lib/host/tests/otel.sx b/lib/host/tests/otel.sx index 8e4d51b2..04261ab6 100644 --- a/lib/host/tests/otel.sx +++ b/lib/host/tests/otel.sx @@ -80,6 +80,52 @@ (host-ot-test "timed span t1 >= t0" (>= (get host-ot-timed :t1) (get host-ot-timed :t0)) true) (host-ot-test "timed span t0 nanosecond-scale" (> (get host-ot-timed :t0) 1000000000000000) true) +;; ── P3: auto-instrument handlers — a request becomes a trace ──────── +;; otel/instrument-routes wraps each route's handler so dispatching a request +;; records a root span named "METHOD /route" with http.method/route/status attrs. +(otel/reset!) +(define host-ot-routes + (list + (dream-get "/feed" (fn (req) (dream-response 200 {} "ok"))) + (dream-post "/feed" (fn (req) (dream-response 201 {} "made"))))) +(define host-ot-iapp (dream-router (otel/instrument-routes host-ot-routes))) +(host-ot-iapp (dream-request "GET" "/feed" {} "")) +(host-ot-test "one span for one request" (len (otel/recent)) 1) +(define host-ot-is (first (otel/recent))) +(host-ot-test "span name is method+route" (get host-ot-is :name) "GET /feed") +(host-ot-test "http.method attr" (get (get host-ot-is :attrs) :http.method) "GET") +(host-ot-test "http.route attr" (get (get host-ot-is :attrs) :http.route) "/feed") +(host-ot-test "http.status attr" (get (get host-ot-is :attrs) :http.status) 200) +(host-ot-test "request span is a root (no parent)" (get host-ot-is :parent) nil) +(host-ot-test "request span has a trace id" (not (= (get host-ot-is :trace) nil)) true) + +;; a second request → its own span + trace, status from its response +(host-ot-iapp (dream-request "POST" "/feed" {} "x")) +(host-ot-test "two requests two spans" (len (otel/recent)) 2) +(define host-ot-is2 (last (otel/recent))) +(host-ot-test "post span name" (get host-ot-is2 :name) "POST /feed") +(host-ot-test "post status attr" (get (get host-ot-is2 :attrs) :http.status) 201) +(host-ot-test "distinct trace per request" + (not (= (get host-ot-is :trace) (get host-ot-is2 :trace))) true) + +;; bare-string handler results still get a status (coerced to 200) +(otel/reset!) +(define host-ot-sapp + (dream-router (otel/instrument-routes + (list (dream-get "/plain" (fn (req) "hello")))))) +(host-ot-sapp (dream-request "GET" "/plain" {} "")) +(host-ot-test "string handler status coerced to 200" + (get (get (first (otel/recent)) :attrs) :http.status) 200) + +;; ── P3 integration: make-app traces every request ────────────────── +(otel/reset!) +(feed/reset!) +(define host-ot-happ (host/make-app (list host/feed-routes))) +(host-ot-happ (dream-request "GET" "/health" {} "")) +(define host-ot-hs (first (filter (fn (s) (= (get s :name) "GET /health")) (otel/recent)))) +(host-ot-test "make-app traces the health request" (not (= host-ot-hs nil)) true) +(host-ot-test "make-app health status 200" (get (get host-ot-hs :attrs) :http.status) 200) + (define host-ot-tests-run! (fn