otel P8: W3C traceparent propagation + error spans

otel/format-traceparent + otel/current-traceparent emit '00-<32hex>-<16hex>-01';
otel/parse-traceparent round-trips it (nil on malformed/bad-width). otel/-timed
now guards the thunk: success spans get :status ok, a raised error records a
span with :status error + an exception event then propagates. Error propagation
uses a false-returning guard clause test (an explicit (raise e) in a guard
handler re-enters the guard and hangs).

lib/host/otel.sx

@@ -87,16 +87,30 @@
             (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 (merge attrs (finalize result))
-                   :events (list)})
-                result))))))))
+          ;; guard the body: on a raise, pop + record an ERROR span (status +
+          ;; exception event) as a SIDE EFFECT in a clause test that returns false,
+          ;; so the condition auto-propagates to the outer handler. (An explicit
+          ;; `(raise e)` inside a guard handler re-enters this guard and hangs.)
+          (guard (e ((begin
+                       (let ((t1 (otel/now-ns)))
+                         (begin
+                           (otel/-pop!)
+                           (otel/record!
+                             {:trace trace :span span :parent parent :name name
+                              :t0 t0 :t1 t1 :status "error" :attrs attrs
+                              :events (list {:name "exception" :time t1 :message (str e)})})))
+                       false)
+                     nil))
+            (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 :status "ok"
+                     :attrs (merge attrs (finalize result))
+                     :events (list)})
+                  result)))))))))
 
 ;; with-span — a plain timed span; no result-derived attrs.
 (define otel/with-span
@@ -462,3 +476,34 @@
        :url endpoint
        :headers {:content-type "application/json"}
        :body (otel/export-otlp-json spans)})))
+
+;; ── P8: W3C traceparent context propagation ───────────────────────────
+;; traceparent = "<version>-<trace-id>-<parent-id>-<flags>" (RFC: version 00,
+;; trace-id 32 hex, parent-id 16 hex, flags 2 hex; low bit = sampled). Emitting it
+;; on outbound inter-service calls and parsing it on inbound requests lets ONE
+;; trace span multiple services. Our internal ids hex-encode via the OTLP helpers.
+(define otel/format-traceparent
+  (fn (trace-id span-id)
+    (str "00-" (otel/-trace-hex trace-id) "-" (otel/-span-hex span-id) "-01")))
+
+;; the traceparent for the CURRENT span (nil outside any span) — for outbound calls.
+(define otel/current-traceparent
+  (fn ()
+    (let ((t (otel/-top)))
+      (if (nil? t) nil (otel/format-traceparent (get t :trace) (get t :span))))))
+
+;; parse an inbound traceparent → {:version :trace-id :parent-id :flags :sampled};
+;; nil if absent or malformed (wrong field count / hex widths).
+(define otel/parse-traceparent
+  (fn (header)
+    (if (or (nil? header) (= header ""))
+      nil
+      (let ((parts (split header "-")))
+        (if (= (len parts) 4)
+          (let ((ver (nth parts 0)) (tid (nth parts 1))
+                (pid (nth parts 2)) (flags (nth parts 3)))
+            (if (and (= (len tid) 32) (= (len pid) 16))
+              {:version ver :trace-id tid :parent-id pid :flags flags
+               :sampled (not (= flags "00"))}
+              nil))
+          nil)))))

lib/host/tests/otel.sx

@@ -322,6 +322,53 @@
 (host-ot-test "empty export has zero spans"
   (len (get (first (get (first (get (otel/export-otlp (list)) :resourceSpans)) :scopeSpans)) :spans)) 0)
 
+;; ── P8: context propagation (W3C traceparent) + error spans ────────
+;; traceparent = "00-<32hex trace>-<16hex span>-<flags>"; round-trips.
+(define host-ot-tp (otel/format-traceparent "trace-1" "span-1"))
+(host-ot-test "traceparent format"
+  host-ot-tp (str "00-" (otel/-trace-hex "trace-1") "-" (otel/-span-hex "span-1") "-01"))
+(define host-ot-tpp (otel/parse-traceparent host-ot-tp))
+(host-ot-test "parsed version" (get host-ot-tpp :version) "00")
+(host-ot-test "trace-id round-trips" (get host-ot-tpp :trace-id) (otel/-trace-hex "trace-1"))
+(host-ot-test "parent-id round-trips" (get host-ot-tpp :parent-id) (otel/-span-hex "span-1"))
+(host-ot-test "sampled flag" (get host-ot-tpp :sampled) true)
+(host-ot-test "malformed traceparent → nil" (otel/parse-traceparent "garbage") nil)
+(host-ot-test "wrong-width traceparent → nil" (otel/parse-traceparent "00-abc-def-01") nil)
+(host-ot-test "empty traceparent → nil" (otel/parse-traceparent "") nil)
+
+;; current-traceparent reflects the active span
+(otel/reset!)
+(otel/with-span "x" {}
+  (fn ()
+    (begin
+      (host-ot-test "current-traceparent set inside a span"
+        (not (= (otel/current-traceparent) nil)) true)
+      (host-ot-test "current-traceparent has 4 dash-parts"
+        (len (split (otel/current-traceparent) "-")) 4)
+      nil)))
+(host-ot-test "current-traceparent nil outside a span" (otel/current-traceparent) nil)
+
+;; error spans: a raising thunk records a span marked :status error + an event,
+;; then re-raises (caught by the test's guard); the stack is left clean.
+(otel/reset!)
+(guard (e (else nil))
+  (otel/with-span "boom" {} (fn () (raise "kaboom"))))
+(host-ot-test "error span recorded" (len (otel/recent)) 1)
+(define host-ot-err (first (otel/recent)))
+(host-ot-test "error span status" (get host-ot-err :status) "error")
+(host-ot-test "error span name" (get host-ot-err :name) "boom")
+(host-ot-test "error span has one event" (len (get host-ot-err :events)) 1)
+(host-ot-test "error event name" (get (first (get host-ot-err :events)) :name) "exception")
+(host-ot-test "error event carries the message"
+  (contains? (str (get (first (get host-ot-err :events)) :message)) "kaboom") true)
+(host-ot-test "stack cleared after an error span" (otel/current-span) nil)
+
+;; success spans are marked ok (and keep empty attrs when none given)
+(otel/reset!)
+(otel/with-span "ok-span" {} (fn () 1))
+(host-ot-test "success span status ok" (get (first (otel/recent)) :status) "ok")
+(host-ot-test "success span keeps empty attrs" (get (first (otel/recent)) :attrs) {})
+
 (define
   host-ot-tests-run!
   (fn