diff --git a/lib/host/conformance.sh b/lib/host/conformance.sh index 2a88c839..6ed9ce1b 100755 --- a/lib/host/conformance.sh +++ b/lib/host/conformance.sh @@ -99,6 +99,7 @@ MODULES=( "lib/host/page.sx" "lib/host/server.sx" "lib/host/ledger.sx" + "lib/host/otel.sx" ) # Suites: NAME RUNNER-FN PATH @@ -117,6 +118,7 @@ SUITES=( "page host-pg-tests-run! lib/host/tests/page.sx" "server host-sv-tests-run! lib/host/tests/server.sx" "ledger host-lg-tests-run! lib/host/tests/ledger.sx" + "otel host-ot-tests-run! lib/host/tests/otel.sx" ) # Filter to a single suite if a name was given (filter the array itself so its diff --git a/lib/host/otel.sx b/lib/host/otel.sx new file mode 100644 index 00000000..55134ff8 --- /dev/null +++ b/lib/host/otel.sx @@ -0,0 +1,89 @@ +;; lib/host/otel.sx — OpenTelemetry in SX, P1: the span model + API. +;; +;; A TRACE is a COMPOSITION: a span is {:trace :span :parent :name :t0 :t1 :attrs +;; :events}, so a trace is a tree of spans (the same shape as an object's :body +;; composition). Later phases fold that tree into a waterfall (render-fold), OTLP +;; JSON (export-fold) and metrics (aggregate-fold). This phase gives us the model, +;; the dynamic parent stack that builds the tree, and a bounded in-memory ring +;; buffer — spans are cheap timed effects, NOT durable KV rows. + +;; ── monotonic id + clock ───────────────────────────────────────────── +;; A simple process-monotonic counter gives collision-free ids without needing a +;; random source (Math.random/Date.now aren't available on this host). now-ns is a +;; placeholder tick here (monotonic non-decreasing); P2 wraps the real host clock. +(define otel/-id-counter 0) +(define otel/-next-id + (fn (prefix) + (begin + (set! otel/-id-counter (+ otel/-id-counter 1)) + (str prefix otel/-id-counter)))) +(define otel/gen-trace-id (fn () (otel/-next-id "trace-"))) +(define otel/gen-span-id (fn () (otel/-next-id "span-"))) + +(define otel/-clock 0) +(define otel/now-ns + (fn () + (begin + (set! otel/-clock (+ otel/-clock 1)) + otel/-clock))) + +;; ── the dynamic parent stack ───────────────────────────────────────── +;; head = the innermost (current) span context {:span id :trace id}. Pushing on +;; with-span entry / popping on exit is what turns lexical nesting into parent +;; links, so a trace tree falls out of ordinary call nesting. +(define otel/-stack (list)) +(define otel/-push! (fn (ctx) (set! otel/-stack (cons ctx otel/-stack)))) +(define otel/-pop! (fn () (set! otel/-stack (rest otel/-stack)))) +(define otel/-top (fn () (if (= (len otel/-stack) 0) nil (first otel/-stack)))) + +(define otel/current-span + (fn () (let ((t (otel/-top))) (if t (get t :span) nil)))) +(define otel/current-trace + (fn () (let ((t (otel/-top))) (if t (get t :trace) nil)))) + +;; ── the bounded ring buffer ────────────────────────────────────────── +;; Oldest → newest. record! appends and drops from the front once over cap, so the +;; buffer stays O(cap) no matter how many spans flow through. NOT persisted. +(define otel/-cap 1000) +(define otel/-ring (list)) +(define otel/set-cap! (fn (n) (begin (set! otel/-cap n) nil))) + +(define otel/record! + (fn (span) + (begin + (set! otel/-ring (append otel/-ring (list span))) + (if (> (len otel/-ring) otel/-cap) + (set! otel/-ring (slice otel/-ring (- (len otel/-ring) otel/-cap))) + nil) + span))) + +(define otel/recent (fn () otel/-ring)) + +;; Clear the ring AND the parent stack — used between tests / requests. +(define otel/reset! + (fn () + (begin + (set! otel/-ring (list)) + (set! otel/-stack (list)) + nil))) + +;; ── with-span: the timed-effect combinator ─────────────────────────── +;; 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) + (let ((parent-ctx (otel/-top))) + (let ((trace (if parent-ctx (get parent-ctx :trace) (otel/gen-trace-id))) + (span (otel/gen-span-id)) + (parent (if parent-ctx (get parent-ctx :span) nil))) + (let ((t0 (begin (otel/-push! {:span span :trace trace}) (otel/now-ns)))) + (let ((result (thunk))) + (let ((t1 (otel/now-ns))) + (begin + (otel/-pop!) + (otel/record! + {:trace trace :span span :parent parent :name name + :t0 t0 :t1 t1 :attrs attrs :events (list)}) + result)))))))) diff --git a/lib/host/tests/otel.sx b/lib/host/tests/otel.sx new file mode 100644 index 00000000..b98edb73 --- /dev/null +++ b/lib/host/tests/otel.sx @@ -0,0 +1,74 @@ +;; 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) + +(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}))