From a47699f6f802726422a7a9327018c9c25a0dcdd4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Feb 2024 11:16:34 -0500 Subject: [PATCH 1/8] feat: add Span_context, as required by OTEL API guidelines --- src/core/opentelemetry.ml | 86 +++++++++++++++++++++++++++------------ 1 file changed, 61 insertions(+), 25 deletions(-) diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index dfd1122a..839ea94b 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -216,41 +216,58 @@ module Collector = struct f () end +(**/**) + module Util_ = struct - let bytes_to_hex (b : bytes) : string = - let i_to_hex (i : int) = - if i < 10 then - Char.chr (i + Char.code '0') - else - Char.chr (i - 10 + Char.code 'a') - in + let int_to_hex (i : int) = + if i < 10 then + Char.chr (i + Char.code '0') + else + Char.chr (i - 10 + Char.code 'a') - let res = Bytes.create (2 * Bytes.length b) in + let bytes_to_hex_into b res off : unit = for i = 0 to Bytes.length b - 1 do let n = Char.code (Bytes.get b i) in - Bytes.set res (2 * i) (i_to_hex ((n land 0xf0) lsr 4)); - Bytes.set res ((2 * i) + 1) (i_to_hex (n land 0x0f)) - done; + Bytes.set res ((2 * i) + off) (int_to_hex ((n land 0xf0) lsr 4)); + Bytes.set res ((2 * i) + 1 + off) (int_to_hex (n land 0x0f)) + done + + let bytes_to_hex (b : bytes) : string = + let res = Bytes.create (2 * Bytes.length b) in + bytes_to_hex_into b res 0; Bytes.unsafe_to_string res - let bytes_of_hex (s : string) : bytes = - let n_of_c = function - | '0' .. '9' as c -> Char.code c - Char.code '0' - | 'a' .. 'f' as c -> 10 + Char.code c - Char.code 'a' - | _ -> raise (Invalid_argument "invalid hex char") - in - if String.length s mod 2 <> 0 then + let int_of_hex = function + | '0' .. '9' as c -> Char.code c - Char.code '0' + | 'a' .. 'f' as c -> 10 + Char.code c - Char.code 'a' + | _ -> raise (Invalid_argument "invalid hex char") + + let bytes_of_hex_substring (s : string) off len = + if len mod 2 <> 0 then raise (Invalid_argument "hex sequence must be of even length"); - let res = Bytes.make (String.length s / 2) '\x00' in - for i = 0 to (String.length s / 2) - 1 do - let n1 = n_of_c (String.get s (2 * i)) in - let n2 = n_of_c (String.get s ((2 * i) + 1)) in + let res = Bytes.make (len / 2) '\x00' in + for i = 0 to (len / 2) - 1 do + let n1 = int_of_hex (String.get s (off + (2 * i))) in + let n2 = int_of_hex (String.get s (off + (2 * i) + 1)) in let n = (n1 lsl 4) lor n2 in Bytes.set res i (Char.chr n) done; res + + let bytes_of_hex (s : string) : bytes = + bytes_of_hex_substring s 0 (String.length s) + + let bytes_non_zero (self : bytes) : bool = + try + for i = 0 to Bytes.length self - 1 do + if Char.code (Bytes.unsafe_get self i) <> 0 then raise_notrace Exit + done; + false + with Exit -> true end +(**/**) + (** {2 Identifiers} *) (** Trace ID. @@ -263,13 +280,19 @@ module Trace_id : sig val pp : Format.formatter -> t -> unit + val is_valid : t -> bool + val to_bytes : t -> bytes val of_bytes : bytes -> t val to_hex : t -> string + val to_hex_into : t -> bytes -> int -> unit + val of_hex : string -> t + + val of_hex_substring : string -> int -> t end = struct type t = bytes @@ -286,11 +309,18 @@ end = struct if Bytes.length b = 16 then b else - raise (Invalid_argument "trace IDs must be 16 bytes in length") + raise (Invalid_argument "trace ID must be 16 bytes in length") - let to_hex self = Util_.bytes_to_hex self + let is_valid = Util_.bytes_non_zero - let of_hex s = of_bytes (Util_.bytes_of_hex s) + let to_hex = Util_.bytes_to_hex + + let to_hex_into = Util_.bytes_to_hex_into + + let[@inline] of_hex s = of_bytes (Util_.bytes_of_hex s) + + let[@inline] of_hex_substring s off = + of_bytes (Util_.bytes_of_hex_substring s off 32) let pp fmt t = Format.fprintf fmt "%s" (to_hex t) end @@ -303,13 +333,19 @@ module Span_id : sig val pp : Format.formatter -> t -> unit + val is_valid : t -> bool + val to_bytes : t -> bytes val of_bytes : bytes -> t val to_hex : t -> string + val to_hex_into : t -> bytes -> int -> unit + val of_hex : string -> t + + val of_hex_substring : string -> int -> t end = struct type t = bytes From fbba875d95b85f616fed6a00e41bc5d936f87460 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Feb 2024 11:16:51 -0500 Subject: [PATCH 2/8] perf: rewrite parsing+printing for span ctx as w3c trace ctx --- src/core/opentelemetry.ml | 153 ++++++++++++++++++++++++-------------- 1 file changed, 99 insertions(+), 54 deletions(-) diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index 839ea94b..67e076f0 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -10,13 +10,6 @@ module AList = AList (** Atomic list, for internal usage @since NEXT_RELEASE *) -open struct - let[@inline] result_bind x f = - match x with - | Error e -> Error e - | Ok x -> f x -end - (** {2 Wire format} *) module Proto = Opentelemetry_proto @@ -358,19 +351,111 @@ end = struct Bytes.set b 0 (Char.unsafe_chr (Char.code (Bytes.get b 0) lor 1)); b + let is_valid = Util_.bytes_non_zero + let of_bytes b = if Bytes.length b = 8 then b else raise (Invalid_argument "span IDs must be 8 bytes in length") - let to_hex self = Util_.bytes_to_hex self + let to_hex = Util_.bytes_to_hex - let of_hex s = of_bytes (Util_.bytes_of_hex s) + let to_hex_into = Util_.bytes_to_hex_into + + let[@inline] of_hex s = of_bytes (Util_.bytes_of_hex s) + + let[@inline] of_hex_substring s off = + of_bytes (Util_.bytes_of_hex_substring s off 16) let pp fmt t = Format.fprintf fmt "%s" (to_hex t) end +(** Span context. This bundles up a trace ID and parent ID. + + https://opentelemetry.io/docs/specs/otel/trace/api/#spancontext *) +module Span_ctx : sig + type t + + val make : trace_id:Trace_id.t -> parent_id:Span_id.t -> unit -> t + + val is_valid : t -> bool + + val trace_id : t -> Trace_id.t + + val parent_id : t -> Span_id.t + + val is_remote : t -> bool + + val to_w3c_trace_context : t -> bytes + + val of_w3c_trace_context : bytes -> (t, string) result + + val of_w3c_trace_context_exn : bytes -> t + (** @raise Invalid_argument if parsing failed *) +end = struct + (* TODO: trace flags *) + (* TODO: trace state *) + + type t = { + trace_id: Trace_id.t; + parent_id: Span_id.t; + is_remote: bool; + } + + let make ~trace_id ~parent_id () : t = + { trace_id; parent_id; is_remote = false } + + let[@inline] is_valid self = + Trace_id.is_valid self.trace_id && Span_id.is_valid self.parent_id + + let[@inline] is_remote self = self.is_remote + + let[@inline] trace_id self = self.trace_id + + let[@inline] parent_id self = self.parent_id + + let to_w3c_trace_context (self : t) : bytes = + let bs = Bytes.create 55 in + Bytes.set bs 0 '0'; + Bytes.set bs 1 '0'; + Bytes.set bs 2 '-'; + Trace_id.to_hex_into self.trace_id bs 3; + (* +32 *) + Bytes.set bs (3 + 32) '-'; + Span_id.to_hex_into self.parent_id bs 36; + (* +16 *) + Bytes.set bs 52 '-'; + Bytes.set bs 53 '0'; + Bytes.set bs 54 '0'; + bs + + let spf = Printf.sprintf + + let of_w3c_trace_context bs : _ result = + try + if Bytes.length bs <> 55 then invalid_arg "trace context must be 55 bytes"; + (match int_of_string_opt (Bytes.sub_string bs 0 2) with + | Some 0 -> () + | Some n -> invalid_arg @@ spf "version is %d, expected 0" n + | None -> invalid_arg "expected 2-digit version"); + if Bytes.get bs 2 <> '-' then invalid_arg "expected '-' before trace_id"; + let trace_id = Trace_id.of_hex_substring (Bytes.unsafe_to_string bs) 3 in + if Bytes.get bs (3 + 32) <> '-' then + invalid_arg "expected '-' before parent_id"; + let parent_id = Span_id.of_hex_substring (Bytes.unsafe_to_string bs) 36 in + if Bytes.get bs 52 <> '-' then invalid_arg "expected '-' after parent_id"; + + (* ignore flags *) + Ok { trace_id; parent_id; is_remote = true } + with Invalid_argument msg -> Error msg + + let of_w3c_trace_context_exn bs = + match of_w3c_trace_context bs with + | Ok t -> t + | Error msg -> invalid_arg @@ spf "invalid w3c trace context: %s" msg +end + (** {2 Attributes and conventions} *) module Conventions = struct @@ -1127,53 +1212,13 @@ module Trace_context = struct [{flags}] are currently ignored. *) let of_value str : (Trace_id.t * Span_id.t, string) result = - let ( let* ) = result_bind in - let blit ~offset ~len ~or_ = - let buf = Bytes.create len in - let* str = - match Bytes.blit_string str offset buf 0 len with - | () -> Ok (Bytes.unsafe_to_string buf) - | exception Invalid_argument _ -> Error or_ - in - Ok (str, offset + len) - in - let consume expected ~offset ~or_ = - let len = String.length expected in - let* str, offset = blit ~offset ~len ~or_ in - if str = expected then - Ok offset - else - Error or_ - in - let offset = 0 in - let* offset = consume "00" ~offset ~or_:"Expected version 00" in - let* offset = consume "-" ~offset ~or_:"Expected delimiter" in - let* trace_id, offset = - blit ~offset ~len:32 ~or_:"Expected 32-digit trace-id" - in - let* trace_id = - match Trace_id.of_hex trace_id with - | trace_id -> Ok trace_id - | exception Invalid_argument _ -> Error "Expected hex-encoded trace-id" - in - let* offset = consume "-" ~offset ~or_:"Expected delimiter" in - let* parent_id, offset = - blit ~offset ~len:16 ~or_:"Expected 16-digit parent-id" - in - let* parent_id = - match Span_id.of_hex parent_id with - | parent_id -> Ok parent_id - | exception Invalid_argument _ -> Error "Expected hex-encoded parent-id" - in - let* offset = consume "-" ~offset ~or_:"Expected delimiter" in - let* _flags, _offset = - blit ~offset ~len:2 ~or_:"Expected 2-digit flags" - in - Ok (trace_id, parent_id) + match Span_ctx.of_w3c_trace_context (Bytes.unsafe_of_string str) with + | Ok sp -> Ok (Span_ctx.trace_id sp, Span_ctx.parent_id sp) + | Error _ as e -> e let to_value ~(trace_id : Trace_id.t) ~(parent_id : Span_id.t) () : string = - Printf.sprintf "00-%s-%s-00" (Trace_id.to_hex trace_id) - (Span_id.to_hex parent_id) + let span_ctx = Span_ctx.make ~trace_id ~parent_id () in + Bytes.unsafe_to_string @@ Span_ctx.to_w3c_trace_context span_ctx end end From e4c41b2b62456015425095318107ca5946fa6ed1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Feb 2024 11:17:12 -0500 Subject: [PATCH 3/8] test: update test output --- tests/core/test_trace_context.expected | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/core/test_trace_context.expected b/tests/core/test_trace_context.expected index f885cb83..db614450 100644 --- a/tests/core/test_trace_context.expected +++ b/tests/core/test_trace_context.expected @@ -1,21 +1,21 @@ Trace_context.Traceparent.of_value "xx": - Error "Expected version 00" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00": - Error "Expected delimiter" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00-xxxx": - Error "Expected 32-digit trace-id" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx": - Error "Expected hex-encoded trace-id" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef": - Error "Expected delimiter" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-xxxx": - Error "Expected 16-digit parent-id" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-xxxxxxxxxxxxxxxx": - Error "Expected hex-encoded parent-id" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef": - Error "Expected delimiter" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef-": - Error "Expected 2-digit flags" + Error "trace context must be 55 bytes" Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef-00": Ok trace_id:"0123456789abcdef0123456789abcdef" parent_id:"0123456789abcdef" Trace_context.Traceparent.of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01": From 84ba8c747339a078c67dda4e62657a9afb4fdbfa Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Feb 2024 13:44:02 -0500 Subject: [PATCH 4/8] add dummy values for span/trace id, and for span_ctx --- src/core/opentelemetry.ml | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index 67e076f0..e3940f15 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -271,6 +271,8 @@ module Trace_id : sig val create : unit -> t + val dummy : t + val pp : Format.formatter -> t -> unit val is_valid : t -> bool @@ -291,6 +293,8 @@ end = struct let to_bytes self = self + let dummy : t = Bytes.make 16 '\x00' + let create () : t = let b = Collector.rand_bytes_16 () in assert (Bytes.length b = 16); @@ -324,6 +328,8 @@ module Span_id : sig val create : unit -> t + val dummy : t + val pp : Format.formatter -> t -> unit val is_valid : t -> bool @@ -344,6 +350,8 @@ end = struct let to_bytes self = self + let dummy : t = Bytes.make 8 '\x00' + let create () : t = let b = Collector.rand_bytes_8 () in assert (Bytes.length b = 8); @@ -373,12 +381,16 @@ end (** Span context. This bundles up a trace ID and parent ID. - https://opentelemetry.io/docs/specs/otel/trace/api/#spancontext *) + https://opentelemetry.io/docs/specs/otel/trace/api/#spancontext + @since NEXT_RELEASE *) module Span_ctx : sig type t val make : trace_id:Trace_id.t -> parent_id:Span_id.t -> unit -> t + val dummy : t + (** Invalid span context, to be used as a placeholder *) + val is_valid : t -> bool val trace_id : t -> Trace_id.t @@ -403,6 +415,9 @@ end = struct is_remote: bool; } + let dummy = + { trace_id = Trace_id.dummy; parent_id = Span_id.dummy; is_remote = false } + let make ~trace_id ~parent_id () : t = { trace_id; parent_id; is_remote = false } From 1b9ba95faf28533eab2e8c66bb67c438668a8918 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Feb 2024 13:57:20 -0500 Subject: [PATCH 5/8] more tests, better error message --- src/core/opentelemetry.ml | 18 +++++++++++++----- tests/core/test_trace_context.ml | 6 ++++++ 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index e3940f15..48704adf 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -1,5 +1,9 @@ (** Opentelemetry types and instrumentation *) +open struct + let spf = Printf.sprintf +end + module Lock = Lock (** Global lock. *) @@ -233,7 +237,7 @@ module Util_ = struct let int_of_hex = function | '0' .. '9' as c -> Char.code c - Char.code '0' | 'a' .. 'f' as c -> 10 + Char.code c - Char.code 'a' - | _ -> raise (Invalid_argument "invalid hex char") + | c -> raise (Invalid_argument (spf "invalid hex char: %C" c)) let bytes_of_hex_substring (s : string) off len = if len mod 2 <> 0 then @@ -445,8 +449,6 @@ end = struct Bytes.set bs 54 '0'; bs - let spf = Printf.sprintf - let of_w3c_trace_context bs : _ result = try if Bytes.length bs <> 55 then invalid_arg "trace context must be 55 bytes"; @@ -455,10 +457,16 @@ end = struct | Some n -> invalid_arg @@ spf "version is %d, expected 0" n | None -> invalid_arg "expected 2-digit version"); if Bytes.get bs 2 <> '-' then invalid_arg "expected '-' before trace_id"; - let trace_id = Trace_id.of_hex_substring (Bytes.unsafe_to_string bs) 3 in + let trace_id = + try Trace_id.of_hex_substring (Bytes.unsafe_to_string bs) 3 + with Invalid_argument msg -> invalid_arg (spf "in trace id: %s" msg) + in if Bytes.get bs (3 + 32) <> '-' then invalid_arg "expected '-' before parent_id"; - let parent_id = Span_id.of_hex_substring (Bytes.unsafe_to_string bs) 36 in + let parent_id = + try Span_id.of_hex_substring (Bytes.unsafe_to_string bs) 36 + with Invalid_argument msg -> invalid_arg (spf "in span id: %s" msg) + in if Bytes.get bs 52 <> '-' then invalid_arg "expected '-' after parent_id"; (* ignore flags *) diff --git a/tests/core/test_trace_context.ml b/tests/core/test_trace_context.ml index de486835..18cca5a5 100644 --- a/tests/core/test_trace_context.ml +++ b/tests/core/test_trace_context.ml @@ -36,6 +36,12 @@ let () = test_of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef-00" let () = test_of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01" +let () = test_of_value "03-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01" + +let () = test_of_value "00-ohnonohex7b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01" + +let () = test_of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aazzzzzzb7-01" + let () = print_endline "" let test_to_value trace_id parent_id = From e001d62fd53fa30d79de3befa25d855dd8201c63 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Feb 2024 14:00:51 -0500 Subject: [PATCH 6/8] add Scope.to_span_ctx --- src/core/opentelemetry.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index 48704adf..dd287d2b 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -672,6 +672,10 @@ module Scope = struct mutable attrs: key_value list; } + (** Turn the scope into a span context *) + let[@inline] to_span_ctx (self : t) : Span_ctx.t = + Span_ctx.make ~trace_id:self.trace_id ~parent_id:self.span_id () + (** Add an event to the scope. It will be aggregated into the span. Note that this takes a function that produces an event, and will only From efc9d74a074c78fee325215b8505f18f1f43bcc6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Feb 2024 14:17:23 -0500 Subject: [PATCH 7/8] add Span_link.of_span_ctx --- src/core/opentelemetry.ml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index dd287d2b..9ca7748d 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -730,6 +730,8 @@ module Span_link : sig ?dropped_attributes_count:int -> unit -> t + + val of_span_ctx : ?attrs:key_value list -> Span_ctx.t -> t end = struct open Proto.Trace @@ -745,6 +747,10 @@ end = struct ~trace_id:(Trace_id.to_bytes trace_id) ~span_id:(Span_id.to_bytes span_id) ?trace_state ~attributes ?dropped_attributes_count () + + let[@inline] of_span_ctx ?attrs ctx : t = + make ~trace_id:(Span_ctx.trace_id ctx) ~span_id:(Span_ctx.parent_id ctx) + ?attrs () end (** Spans. From e7056f4bfc2232c6269acf04311139cba90efbab Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Feb 2024 14:18:01 -0500 Subject: [PATCH 8/8] test: update output --- tests/core/test_trace_context.expected | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/core/test_trace_context.expected b/tests/core/test_trace_context.expected index db614450..21b56778 100644 --- a/tests/core/test_trace_context.expected +++ b/tests/core/test_trace_context.expected @@ -20,6 +20,12 @@ Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-01234567 Ok trace_id:"0123456789abcdef0123456789abcdef" parent_id:"0123456789abcdef" Trace_context.Traceparent.of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01": Ok trace_id:"4bf92f3577b34da6a3ce929d0e0e4736" parent_id:"00f067aa0ba902b7" +Trace_context.Traceparent.of_value "03-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01": + Error "version is 3, expected 0" +Trace_context.Traceparent.of_value "00-ohnonohex7b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01": + Error "in trace id: invalid hex char: 'o'" +Trace_context.Traceparent.of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aazzzzzzb7-01": + Error "in span id: invalid hex char: 'z'" Trace_context.Traceparent.to_value trace_id:"4bf92f3577b34da6a3ce929d0e0e4736" parent_id:"00f067aa0ba902b7": "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-00"