diff --git a/lib/host/otel.sx b/lib/host/otel.sx index 43bc5558..d80017ff 100644 --- a/lib/host/otel.sx +++ b/lib/host/otel.sx @@ -383,3 +383,82 @@ (fn (req) (dream-response 200 {:content-type "text/event-stream"} (otel/-stream-body))))) (define otel/routes (list otel/dashboard-route otel/stream-route)) + +;; ── P7: OTLP-JSON export ────────────────────────────────────────────── +;; Serialize spans to the OTLP/JSON schema (resourceSpans → scopeSpans → spans) +;; for interop with Jaeger/Grafana. traceId/spanId/parentSpanId are hex strings; +;; timestamps are uint64-as-string; attributes are typed {key,value}. Export is a +;; fold (span → OTLP span); POST goes through an INJECTED transport so it's +;; testable without a live collector. + +;; our "trace-N"/"span-N" ids → a fixed-width lowercase-hex id (real OTLP widths: +;; traceId 16 bytes = 32 hex, spanId 8 bytes = 16 hex). Deterministic from the id. +(define otel/-id-num + (fn (id) + (let ((n (string->number (last (split id "-"))))) + (if (nil? n) 0 n)))) +(define otel/-zeros + (fn (k) (if (<= k 0) "" (str "0" (otel/-zeros (- k 1)))))) +(define otel/-pad-hex + (fn (n width) + (let ((h (number->string n 16))) + (str (otel/-zeros (- width (len h))) h)))) +(define otel/-trace-hex (fn (id) (otel/-pad-hex (otel/-id-num id) 32))) +(define otel/-span-hex (fn (id) (otel/-pad-hex (otel/-id-num id) 16))) + +;; a value → OTLP AnyValue: numbers are intValue (uint64-as-string), else stringValue. +(define otel/-otlp-value + (fn (v) + (if (= (type-of v) "number") + {:intValue (str v)} + {:stringValue (str v)}))) +(define otel/-otlp-attrs + (fn (attrs) + (map (fn (k) {:key (str k) :value (otel/-otlp-value (get attrs k))}) (keys attrs)))) + +;; span kind: 2 = SERVER for an instrumented request (has http.method), else +;; 1 = INTERNAL. +(define otel/-otlp-kind + (fn (attrs) (if (get attrs :http.method) 2 1))) + +(define otel/-otlp-span + (fn (s) + (let ((attrs (or (get s :attrs) {}))) + (let ((base + {:traceId (otel/-trace-hex (get s :trace)) + :spanId (otel/-span-hex (get s :span)) + :name (get s :name) + :kind (otel/-otlp-kind attrs) + :startTimeUnixNano (str (get s :t0)) + :endTimeUnixNano (str (get s :t1)) + :attributes (otel/-otlp-attrs attrs)})) + (if (nil? (get s :parent)) + base + (assoc base :parentSpanId (otel/-span-hex (get s :parent)))))))) + +;; spans → the OTLP export envelope (a JSON-shaped SX value). +(define otel/export-otlp + (fn (spans) + {:resourceSpans + (list + {:resource + {:attributes (list {:key "service.name" + :value {:stringValue "rose-ash-host"}})} + :scopeSpans + (list + {:scope {:name "otel-on-sx" :version "0.1.0"} + :spans (map otel/-otlp-span spans)})})})) + +(define otel/export-otlp-json + (fn (spans) (dream-json-encode (otel/export-otlp spans)))) + +;; POST the OTLP payload through an injected transport. `transport` is a fn taking +;; a request dict {:method :url :headers :body} — real deploys pass an http POST; +;; tests pass a recorder. Returns whatever the transport returns. +(define otel/post-otlp + (fn (endpoint spans transport) + (transport + {:method "POST" + :url endpoint + :headers {:content-type "application/json"} + :body (otel/export-otlp-json spans)}))) diff --git a/lib/host/tests/otel.sx b/lib/host/tests/otel.sx index c3a84231..d71ee27a 100644 --- a/lib/host/tests/otel.sx +++ b/lib/host/tests/otel.sx @@ -259,6 +259,69 @@ (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