rose-ash/lib/host/tests/otel.sx

;; lib/host/tests/otel.sx — P1: span model + API. A span dict
;; {:trace :span :parent :name :t0 :t1 :attrs :events}; otel/with-span records
;; t0/t1 and pushes/pops a dynamic parent stack so nesting builds the tree; a
;; bounded ring buffer (record!/recent, cap, drop-oldest); current-span/current-trace.

(define host-ot-pass 0)
(define host-ot-fail 0)
(define host-ot-fails (list))

(define
  host-ot-test
  (fn
    (name actual expected)
    (if
      (= actual expected)
      (set! host-ot-pass (+ host-ot-pass 1))
      (begin
        (set! host-ot-fail (+ host-ot-fail 1))
        (append! host-ot-fails {:name name :actual actual :expected expected})))))

;; ── nested with-span builds the parent tree ─────────────────────────
(otel/reset!)
(otel/with-span "root" {}
  (fn () (otel/with-span "child" {} (fn () 42))))

(define host-ot-sp (otel/recent))
(define host-ot-child (first host-ot-sp))   ;; inner span completes+records first
(define host-ot-root (nth host-ot-sp 1))

(host-ot-test "two spans recorded" (len host-ot-sp) 2)
(host-ot-test "child name" (get host-ot-child :name) "child")
(host-ot-test "root name" (get host-ot-root :name) "root")
(host-ot-test "child parent is root span" (get host-ot-child :parent) (get host-ot-root :span))
(host-ot-test "root has no parent" (get host-ot-root :parent) nil)
(host-ot-test "same trace" (= (get host-ot-child :trace) (get host-ot-root :trace)) true)
(host-ot-test "root t1 >= t0" (>= (get host-ot-root :t1) (get host-ot-root :t0)) true)
(host-ot-test "root has attrs" (get host-ot-root :attrs) {})
(host-ot-test "root has events list" (get host-ot-root :events) (list))

;; ── attrs are carried through ───────────────────────────────────────
(otel/reset!)
(otel/with-span "req" {:http.method "GET" :http.route "/feed"} (fn () nil))
(host-ot-test "attrs carried"
  (get (get (first (otel/recent)) :attrs) :http.method) "GET")

;; ── current-span / current-trace track the dynamic stack ────────────
(otel/reset!)
(host-ot-test "no current span outside" (otel/current-span) nil)
(host-ot-test "no current trace outside" (otel/current-trace) nil)
(otel/with-span "x" {}
  (fn ()
    (begin
      (host-ot-test "current span set inside" (not (= (otel/current-span) nil)) true)
      (host-ot-test "current trace set inside" (not (= (otel/current-trace) nil)) true)
      nil)))
(host-ot-test "no current span after" (otel/current-span) nil)

;; ── ring buffer caps at N, drops oldest ─────────────────────────────
(otel/reset!)
(otel/set-cap! 3)
(for-each (fn (i) (otel/record! {:span i :name "s"})) (list 1 2 3 4 5))
(host-ot-test "ring capped at 3" (len (otel/recent)) 3)
(host-ot-test "oldest dropped" (get (first (otel/recent)) :span) 3)
(host-ot-test "newest kept" (get (last (otel/recent)) :span) 5)
(otel/set-cap! 1000)

;; ── P2: now-ns wraps the host monotonic clock ──────────────────────
;; now-ns is real epoch NANOSECONDS (clock-milliseconds * 1e6), clamped so it
;; never goes backwards. Non-negative, non-decreasing, nanosecond-scale.
(define host-ot-n0 (otel/now-ns))
(define host-ot-n1 (otel/now-ns))
(host-ot-test "now-ns non-negative" (>= host-ot-n0 0) true)
(host-ot-test "now-ns monotonic non-decreasing" (>= host-ot-n1 host-ot-n0) true)
(host-ot-test "now-ns is nanosecond-scale" (> host-ot-n0 1000000000000000) true)

;; a real with-span straddles the host clock
(otel/reset!)
(otel/with-span "timed" {} (fn () nil))
(define host-ot-timed (first (otel/recent)))
(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)

;; ── P4: render-fold → SVG waterfall ────────────────────────────────
;; A trace (tree of spans) folds into an <svg>: one <rect> per span, x by start
;; offset, width by duration, y by depth. Build a root with nested children.
(otel/reset!)
(otel/with-span "root" {}
  (fn ()
    (begin
      (otel/with-span "a" {} (fn () nil))
      (otel/with-span "b" {} (fn () (otel/with-span "b1" {} (fn () nil))))
      nil)))
(define host-ot-tid (get (first (otel/recent)) :trace))
(define host-ot-rects (otel/waterfall-rects host-ot-tid))
(define host-ot-rect-named
  (fn (nm) (first (filter (fn (r) (= (get r :name) nm)) host-ot-rects))))

(host-ot-test "one rect per span" (len host-ot-rects) 4)
(host-ot-test "root depth 0" (get (host-ot-rect-named "root") :depth) 0)
(host-ot-test "child a depth 1" (get (host-ot-rect-named "a") :depth) 1)
(host-ot-test "grandchild b1 depth 2" (get (host-ot-rect-named "b1") :depth) 2)
(host-ot-test "nested span y greater than root y"
  (> (get (host-ot-rect-named "a") :y) (get (host-ot-rect-named "root") :y)) true)
(host-ot-test "deeper nesting greater y"
  (> (get (host-ot-rect-named "b1") :y) (get (host-ot-rect-named "b") :y)) true)
(host-ot-test "root x is the left pad (starts at trace t0)"
  (get (host-ot-rect-named "root") :x) 4)
(host-ot-test "all widths positive"
  (every? (fn (r) (> (get r :w) 0)) host-ot-rects) true)

;; the SVG itself: an svg head with one rect + one label per span
(define host-ot-svg (otel/waterfall host-ot-tid))
(host-ot-test "waterfall head is svg" (str (first host-ot-svg)) "svg")
(host-ot-test "svg has one rect per span" (otel/-tree-count host-ot-svg "rect") 4)
(host-ot-test "svg has one label per span" (otel/-tree-count host-ot-svg "text") 4)

;; unknown trace → empty waterfall, still a valid svg
(host-ot-test "unknown trace has no rects" (len (otel/waterfall-rects "no-such-trace")) 0)
(host-ot-test "unknown trace still yields an svg"
  (str (first (otel/waterfall "no-such-trace"))) "svg")

;; ── P5: metrics (aggregate-fold) ───────────────────────────────────
;; Fold recent spans → per-route counters + latency percentiles (nearest-rank).
;; Build spans with KNOWN durations so the percentiles are deterministic.
(otel/reset!)
(for-each
  (fn (d)
    (otel/record! {:trace "t" :span (str "s" d) :parent nil :name "GET /feed"
                   :t0 0 :t1 d :attrs {:http.route "/feed"} :events (list)}))
  (list 30 10 50 20 40))   ;; unsorted on purpose — the fold must sort
(otel/record! {:trace "t" :span "h" :parent nil :name "GET /health"
               :t0 0 :t1 5 :attrs {:http.route "/health"} :events (list)})

(define host-ot-m (otel/metrics (otel/recent)))
(host-ot-test "total requests" (get host-ot-m :total-requests) 6)
(host-ot-test "two routes" (len (get host-ot-m :routes)) 2)

(define host-ot-feed
  (first (filter (fn (r) (= (get r :route) "/feed")) (get host-ot-m :routes))))
(host-ot-test "feed count" (get host-ot-feed :count) 5)
(host-ot-test "feed p50" (get host-ot-feed :p50) 30)  ;; ceil(.5*5)=3 → sorted[2]=30
(host-ot-test "feed p95" (get host-ot-feed :p95) 50)  ;; ceil(.95*5)=5 → sorted[4]=50
(host-ot-test "feed p99" (get host-ot-feed :p99) 50)

(define host-ot-health
  (first (filter (fn (r) (= (get r :route) "/health")) (get host-ot-m :routes))))
(host-ot-test "health count" (get host-ot-health :count) 1)
(host-ot-test "health p50 of a single sample" (get host-ot-health :p50) 5)

;; the sort helper on its own
(host-ot-test "sort-nums ascending" (otel/-sort-nums (list 3 1 2 5 4)) (list 1 2 3 4 5))

;; empty ring → zeroed metrics, no routes
(otel/reset!)
(define host-ot-me (otel/metrics (otel/recent)))
(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) "")

;; ── P7: OTLP-JSON export ───────────────────────────────────────────
;; Serialize spans to OTLP/JSON: resourceSpans → scopeSpans → spans with hex
;; traceId/spanId/parentSpanId, string nano timestamps, typed attributes. POST
;; via an injected transport (testable without a live collector).
(otel/reset!)
(otel/record! {:trace "trace-1" :span "span-1" :parent nil :name "GET /feed"
               :t0 1000 :t1 5000 :attrs {:http.method "GET" :http.status 200} :events (list)})
(otel/record! {:trace "trace-1" :span "span-2" :parent "span-1" :name "db"
               :t0 2000 :t1 3000 :attrs {} :events (list)})

(define host-ot-otlp (otel/export-otlp (otel/recent)))
(define host-ot-rss (get host-ot-otlp :resourceSpans))
(host-ot-test "one resourceSpans" (len host-ot-rss) 1)
(define host-ot-ss (get (first host-ot-rss) :scopeSpans))
(host-ot-test "one scopeSpans" (len host-ot-ss) 1)
(define host-ot-ospans (get (first host-ot-ss) :spans))
(host-ot-test "two otlp spans" (len host-ot-ospans) 2)

(define host-ot-oroot (first host-ot-ospans))
(host-ot-test "traceId is 32 hex chars" (len (get host-ot-oroot :traceId)) 32)
(host-ot-test "traceId value" (get host-ot-oroot :traceId) "00000000000000000000000000000001")
(host-ot-test "spanId is 16 hex chars" (len (get host-ot-oroot :spanId)) 16)
(host-ot-test "spanId value" (get host-ot-oroot :spanId) "0000000000000001")
(host-ot-test "otlp name" (get host-ot-oroot :name) "GET /feed")
(host-ot-test "startTimeUnixNano is a string" (get host-ot-oroot :startTimeUnixNano) "1000")
(host-ot-test "endTimeUnixNano is a string" (get host-ot-oroot :endTimeUnixNano) "5000")
(host-ot-test "server span kind 2" (get host-ot-oroot :kind) 2)
(host-ot-test "root has no parentSpanId" (has-key? host-ot-oroot :parentSpanId) false)

;; typed attributes: strings → stringValue, numbers → intValue
(define host-ot-oattrs (get host-ot-oroot :attributes))
(host-ot-test "two attributes" (len host-ot-oattrs) 2)
(define host-ot-mattr (first (filter (fn (a) (= (get a :key) "http.method")) host-ot-oattrs)))
(host-ot-test "attr key" (get host-ot-mattr :key) "http.method")
(host-ot-test "string attr uses stringValue" (get (get host-ot-mattr :value) :stringValue) "GET")
(define host-ot-sattr (first (filter (fn (a) (= (get a :key) "http.status")) host-ot-oattrs)))
(host-ot-test "int attr uses intValue" (get (get host-ot-sattr :value) :intValue) "200")

;; child carries parentSpanId = root spanId, and internal kind
(define host-ot-ochild (nth host-ot-ospans 1))
(host-ot-test "child parentSpanId is root spanId" (get host-ot-ochild :parentSpanId) "0000000000000001")
(host-ot-test "child spanId" (get host-ot-ochild :spanId) "0000000000000002")
(host-ot-test "internal span kind 1" (get host-ot-ochild :kind) 1)

;; JSON string + injected transport
(host-ot-test "export-otlp-json contains resourceSpans"
  (contains? (otel/export-otlp-json (otel/recent)) "resourceSpans") true)
(define host-ot-cap {})
(define host-ot-transport (fn (req) (begin (set! host-ot-cap req) req)))
(otel/post-otlp "http://collector:4318/v1/traces" (otel/recent) host-ot-transport)
(host-ot-test "transport got a POST" (get host-ot-cap :method) "POST")
(host-ot-test "transport got the endpoint" (get host-ot-cap :url) "http://collector:4318/v1/traces")
(host-ot-test "transport got json content-type"
  (get (get host-ot-cap :headers) :content-type) "application/json")
(host-ot-test "transport body carries the hex traceId"
  (contains? (get host-ot-cap :body) "00000000000000000000000000000001") true)

;; empty spans still yield the OTLP envelope with an empty spans list
(host-ot-test "empty export has resourceSpans"
  (len (get (otel/export-otlp (list)) :resourceSpans)) 1)
(host-ot-test "empty export has zero spans"
  (len (get (first (get (first (get (otel/export-otlp (list)) :resourceSpans)) :scopeSpans)) :spans)) 0)

(define
  host-ot-tests-run!
  (fn
    ()
    {:total (+ host-ot-pass host-ot-fail)
     :passed host-ot-pass
     :failed host-ot-fail
     :fails host-ot-fails}))