otel P7: OTLP-JSON export + injected transport
otel/export-otlp folds spans → OTLP/JSON envelope (resourceSpans → scopeSpans → spans) with hex traceId(32)/spanId(16)/parentSpanId, uint64-as-string nano timestamps, typed attributes (stringValue/intValue), and span kind (SERVER/INTERNAL). otel/export-otlp-json encodes via dream-json-encode; otel/post-otlp POSTs through an injected transport (testable without a live collector).
This commit is contained in:
@@ -383,3 +383,82 @@
|
|||||||
(fn (req)
|
(fn (req)
|
||||||
(dream-response 200 {:content-type "text/event-stream"} (otel/-stream-body)))))
|
(dream-response 200 {:content-type "text/event-stream"} (otel/-stream-body)))))
|
||||||
(define otel/routes (list otel/dashboard-route otel/stream-route))
|
(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)})))
|
||||||
|
|||||||
@@ -259,6 +259,69 @@
|
|||||||
(host-ot-test "empty dashboard still renders" (contains? host-ot-empty-dash "otel-dashboard") true)
|
(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) "")
|
(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
|
(define
|
||||||
host-ot-tests-run!
|
host-ot-tests-run!
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
Reference in New Issue
Block a user