otel P6: live dashboard — GET /otel SSR + /otel/stream SSE

otel/dashboard SSRs the metrics strip + latest-trace waterfall + recent-traces
list as HTML carrying Datastar-style data-on-load subscribing to /otel/stream,
the SSE feed of SXTP otel.span events. Routes otel/dashboard-route +
otel/stream-route (otel/routes) mount via make-app. recent-traces/latest-trace
+ otel/span-event helpers.
This commit is contained in:
2026-07-01 15:32:14 +00:00
parent 296fa45bea
commit 4400870abe
2 changed files with 167 additions and 0 deletions

View File

@@ -273,3 +273,113 @@
;; convenience: metrics over the current ring.
(define otel/metrics-recent (fn () (otel/metrics (otel/recent))))
;; ── P6: live dashboard (SSR + SSE) ────────────────────────────────────
;; GET /otel renders a dashboard — metrics strip + the latest trace's waterfall +
;; a recent-traces list — as server-rendered HTML carrying Datastar-style reactive
;; attributes that subscribe to GET /otel/stream, the SSE feed of new span events
;; (SXTP events, the host's Datastar-borrowed wire format). SSR + declarative
;; reactive attrs + SSE patches IS the reactive-island model here. (Live client
;; hydration is a deploy concern; SSR, the event feed, and the data are tested.)
;; recent traces, newest-first: {:trace :name :spans}. root name = the parentless
;; span (fallback: first recorded).
(define otel/-trace-ids
(fn () (otel/-distinct (map (fn (s) (get s :trace)) (otel/recent)))))
(define otel/-trace-root-name
(fn (trace-id)
(let ((spans (otel/trace-spans trace-id)))
(let ((roots (filter (fn (s) (nil? (get s :parent))) spans)))
(cond
((not (empty? roots)) (get (first roots) :name))
((not (empty? spans)) (get (first spans) :name))
(else ""))))))
(define otel/trace-summary
(fn (trace-id)
{:trace trace-id
:name (otel/-trace-root-name trace-id)
:spans (len (otel/trace-spans trace-id))}))
(define otel/recent-traces
(fn () (reverse (map otel/trace-summary (otel/-trace-ids)))))
(define otel/latest-trace
(fn ()
(let ((r (otel/recent)))
(if (empty? r) nil (get (last r) :trace)))))
;; ── SSE span events (SXTP) ────────────────────────────────────────────
(define otel/span-event
(fn (s)
(sxtp/event "otel.span"
{:id (get s :span)
:body {:trace (get s :trace) :span (get s :span) :parent (get s :parent)
:name (get s :name) :t0 (get s :t0) :t1 (get s :t1)
:attrs (get s :attrs)}
:time (get s :t1)})))
(define otel/latest-span-event
(fn ()
(let ((r (otel/recent)))
(if (empty? r) nil (otel/span-event (last r))))))
;; one SSE frame: `event: otel.span\n data: <sxtp event>\n\n`; "" when no spans.
(define otel/-stream-body
(fn ()
(let ((e (otel/latest-span-event)))
(if (nil? e)
""
(str "event: otel.span\ndata: " (sxtp/serialize e) "\n\n")))))
;; ── dashboard markup (plain HTML tags → render-to-html SSRs cleanly) ──
(define otel/-metrics-strip
(fn (m)
(quasiquote
(table :class "otel-metrics"
(tr (th "route") (th "count") (th "p50") (th "p95") (th "p99"))
(splice-unquote
(map
(fn (r)
(quasiquote
(tr (td (unquote (str (get r :route))))
(td (unquote (str (get r :count))))
(td (unquote (str (get r :p50))))
(td (unquote (str (get r :p95))))
(td (unquote (str (get r :p99)))))))
(get m :routes)))))))
(define otel/-traces-list
(fn (traces)
(quasiquote
(ul :class "otel-traces"
(splice-unquote
(map
(fn (t)
(quasiquote
(li :data-trace (unquote (str (get t :trace)))
(unquote (str (get t :name) " — " (get t :spans) " spans")))))
traces))))))
(define otel/dashboard
(fn ()
(let ((m (otel/metrics (otel/recent)))
(lt (otel/latest-trace))
(traces (otel/recent-traces)))
(quasiquote
(div :id "otel-dashboard" :data-on-load "@get('/otel/stream')"
(h1 "OpenTelemetry")
(h2 "metrics")
(unquote (otel/-metrics-strip m))
(h2 "latest trace")
(unquote
(if (nil? lt)
(quasiquote (p :class "otel-empty" "no traces yet"))
(otel/waterfall lt)))
(h2 "recent traces")
(unquote (otel/-traces-list traces)))))))
;; ── routes ────────────────────────────────────────────────────────────
(define otel/dashboard-route
(dream-get "/otel"
(fn (req) (dream-html (render-to-html (otel/dashboard) {})))))
(define otel/stream-route
(dream-get "/otel/stream"
(fn (req)
(dream-response 200 {:content-type "text/event-stream"} (otel/-stream-body)))))
(define otel/routes (list otel/dashboard-route otel/stream-route))

View File

@@ -202,6 +202,63 @@
(host-ot-test "empty metrics total 0" (get host-ot-me :total-requests) 0)
(host-ot-test "empty metrics no routes" (len (get host-ot-me :routes)) 0)
;; ── P6: live dashboard (SSR + SSE) ─────────────────────────────────
;; Drive two traces through instrumented routes, then check: recent-traces lists
;; them (newest first); the dashboard SSRs to HTML with the metrics strip + the
;; latest-trace <svg>; the /otel/stream SSE endpoint emits an SXTP span event.
(otel/reset!)
(define host-ot-dapp
(dream-router (otel/instrument-routes
(list
(dream-get "/feed" (fn (req) (dream-response 200 {} "ok")))
(dream-get "/health" (fn (req) (dream-response 200 {} "ok")))))))
(host-ot-dapp (dream-request "GET" "/feed" {} ""))
(host-ot-dapp (dream-request "GET" "/health" {} ""))
(host-ot-test "recent-traces lists both" (len (otel/recent-traces)) 2)
(host-ot-test "recent-traces newest first"
(get (first (otel/recent-traces)) :name) "GET /health")
(host-ot-test "latest-trace is the /health trace"
(otel/-trace-root-name (otel/latest-trace)) "GET /health")
;; dashboard SSRs to an HTML string carrying the strip + waterfall + trace list
(define host-ot-dash (render-to-html (otel/dashboard) {}))
(host-ot-test "dashboard is a string" (= (type-of host-ot-dash) "string") true)
(host-ot-test "dashboard has the root id" (contains? host-ot-dash "otel-dashboard") true)
(host-ot-test "dashboard SSRs the waterfall svg" (contains? host-ot-dash "<svg") true)
(host-ot-test "dashboard shows a route in the strip" (contains? host-ot-dash "/feed") true)
(host-ot-test "dashboard declares the SSE subscription" (contains? host-ot-dash "/otel/stream") true)
;; the SSE endpoint emits a span event, SSE-framed
(define host-ot-sse
((dream-route-handler otel/stream-route) (dream-request "GET" "/otel/stream" {} "")))
(host-ot-test "sse content type is event-stream"
(contains? (str (dream-headers host-ot-sse)) "event-stream") true)
(host-ot-test "sse body is SSE-framed" (contains? (dream-resp-body host-ot-sse) "data:") true)
(host-ot-test "sse emits an otel.span event"
(contains? (dream-resp-body host-ot-sse) "otel.span") true)
(host-ot-test "sse event carries the span name"
(contains? (dream-resp-body host-ot-sse) "GET /health") true)
;; span-event helper carries the type + span
(define host-ot-ev (otel/latest-span-event))
(host-ot-test "latest span event type" (str (get host-ot-ev :type)) "otel.span")
;; mounted through make-app: GET /otel serves the dashboard page
(otel/reset!)
(feed/reset!)
(define host-ot-mapp (host/make-app (list host/feed-routes otel/routes)))
(define host-ot-otelresp (host-ot-mapp (dream-request "GET" "/otel" {} "")))
(host-ot-test "GET /otel status 200" (dream-status host-ot-otelresp) 200)
(host-ot-test "GET /otel serves the dashboard"
(contains? (dream-resp-body host-ot-otelresp) "otel-dashboard") true)
;; empty ring → dashboard still SSRs (a placeholder, no svg)
(otel/reset!)
(define host-ot-empty-dash (render-to-html (otel/dashboard) {}))
(host-ot-test "empty dashboard still renders" (contains? host-ot-empty-dash "otel-dashboard") true)
(host-ot-test "empty stream body is blank" (otel/-stream-body) "")
(define
host-ot-tests-run!
(fn