From b03a5fa65bd9be50ddb02ac2a0b771caa28dc696 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 4 Apr 2026 03:02:25 +0000
Subject: [PATCH] add trace_state module

---
 src/core/trace_state.ml  | 104 +++++++++++++++++++++++++++++++++++++++
 src/core/trace_state.mli |  42 ++++++++++++++++
 src/lib/opentelemetry.ml |   1 +
 3 files changed, 147 insertions(+)
 create mode 100644 src/core/trace_state.ml
 create mode 100644 src/core/trace_state.mli

diff --git a/src/core/trace_state.ml b/src/core/trace_state.ml
new file mode 100644
index 00000000..14a304b6
--- /dev/null
+++ b/src/core/trace_state.ml
@@ -0,0 +1,104 @@
+(** W3C Trace State - https://www.w3.org/TR/trace-context/#tracestate-header *)
+
+type t = (string * string) list
+
+let empty : t = []
+
+let is_valid_key (k : string) : bool =
+  let n = String.length k in
+  if n < 1 || n > 256 then
+    false
+  else (
+    let ok =
+      ref
+        (match k.[0] with
+        | 'a' .. 'z' -> true
+        | _ -> false)
+    in
+    let i = ref 1 in
+    while !ok && !i < n do
+      (match k.[!i] with
+      | 'a' .. 'z' | '0' .. '9' | '_' | '-' | '*' | '/' -> ()
+      | _ -> ok := false);
+      incr i
+    done;
+    !ok
+  )
+
+let is_valid_value (v : string) : bool =
+  let n = String.length v in
+  if n < 1 || n > 256 then
+    false
+  else (
+    let ok = ref (v.[0] <> ' ' && v.[n - 1] <> ' ') in
+    let i = ref 0 in
+    while !ok && !i < n do
+      let code = Char.code v.[!i] in
+      if code < 0x20 || code > 0x7e || v.[!i] = ',' || v.[!i] = '=' then
+        ok := false;
+      incr i
+    done;
+    !ok
+  )
+
+let get (self : t) (key : string) : string option = List.assoc_opt key self
+
+let set (self : t) (key : string) (value : string) : t =
+  if not (is_valid_key key) then
+    invalid_arg (Printf.sprintf "Trace_state.set: invalid key %S" key);
+  if not (is_valid_value value) then
+    invalid_arg (Printf.sprintf "Trace_state.set: invalid value %S" value);
+  let rest = List.filter (fun (k, _) -> k <> key) self in
+  (key, value) :: rest
+
+let delete (self : t) (key : string) : t =
+  List.filter (fun (k, _) -> k <> key) self
+
+let encoded_length (self : t) : int =
+  match self with
+  | [] -> 0
+  | _ ->
+    let n = List.length self in
+    let sum =
+      List.fold_left
+        (fun acc (k, v) -> acc + String.length k + 1 + String.length v)
+        0 self
+    in
+    sum + n - 1
+
+let to_w3c_string (self : t) : string =
+  match self with
+  | [] -> ""
+  | _ ->
+    let buf = Buffer.create (encoded_length self) in
+    List.iteri
+      (fun i (k, v) ->
+        if i > 0 then Buffer.add_char buf ',';
+        Buffer.add_string buf k;
+        Buffer.add_char buf '=';
+        Buffer.add_string buf v)
+      self;
+    Buffer.contents buf
+
+let of_w3c_string (s : string) : (t, string) result =
+  if s = "" then
+    Ok []
+  else (
+    let parts = String.split_on_char ',' s in
+    let pairs =
+      List.filter_map
+        (fun part ->
+          let part = String.trim part in
+          match String.index_opt part '=' with
+          | None -> None
+          | Some i ->
+            let k = String.sub part 0 i in
+            let v = String.sub part (i + 1) (String.length part - i - 1) in
+            if is_valid_key k && is_valid_value v then
+              Some (k, v)
+            else
+              None)
+        parts
+    in
+    Ok pairs
+  )
diff --git a/src/core/trace_state.mli b/src/core/trace_state.mli
new file mode 100644
index 00000000..1b350fdd
--- /dev/null
+++ b/src/core/trace_state.mli
@@ -0,0 +1,42 @@
+(** W3C Trace State.
+
+    A list of vendor-specific key/value pairs propagated across distributed
+    tracing systems.
+
+    @since NEXT_RELEASE
+
+    https://www.w3.org/TR/trace-context/#tracestate-header *)
+
+type t = (string * string) list
+
+val empty : t
+
+val is_valid_key : string -> bool
+(** [is_valid_key k] is true if [k] is a valid W3C tracestate key. Keys must
+    start with [a-z], followed by [a-z0-9_-*/], and be at most 256 chars. *)
+
+val is_valid_value : string -> bool
+(** [is_valid_value v] is true if [v] is a valid W3C tracestate value. Values
+    must be printable ASCII (0x20–0x7E), excluding [,] and [=], with no
+    leading/trailing space, and at most 256 chars. *)
+
+val get : t -> string -> string option
+
+val set : t -> string -> string -> t
+(** [set ts key value] adds or replaces [key] in [ts], placing it at the front
+    (most-recently-updated), per the W3C spec.
+    @raise Invalid_argument
+      if [key] or [value] fail their respective validators. *)
+
+val delete : t -> string -> t
+
+val encoded_length : t -> int
+(** Length of the string produced by {!to_w3c_string}. *)
+
+val to_w3c_string : t -> string
+(** Encodes as a W3C tracestate header value ([k1=v1,k2=v2,...]). Returns [""]
+    for an empty list. *)
+
+val of_w3c_string : string -> (t, string) result
+(** Parses a W3C tracestate header value. Malformed or invalid entries are
+    silently skipped rather than returning an error. *)
diff --git a/src/lib/opentelemetry.ml b/src/lib/opentelemetry.ml
index 60007126..3ed36b61 100644
--- a/src/lib/opentelemetry.ml
+++ b/src/lib/opentelemetry.ml
@@ -83,6 +83,7 @@ let k_trace_id = Trace_id.k_trace_id
 
 module Span_id = Span_id
 module Span_ctx = Span_ctx
+module Trace_state = Trace_state
 
 let k_ambient = Span_ctx.k_ambient