From 9b5f3cd0c3306bb457f4960a89b9a42e1145532d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 17 Apr 2025 10:03:29 -0400 Subject: [PATCH] feat: adapt to trace 0.10 --- dune-project | 2 +- opentelemetry.opam | 2 +- src/core/opentelemetry.ml | 2 +- src/trace/opentelemetry_trace.ml | 67 ++++++++++++++++++++++++------- src/trace/opentelemetry_trace.mli | 41 ++++++++++++------- 5 files changed, 83 insertions(+), 31 deletions(-) diff --git a/dune-project b/dune-project index ae7049aa..60b778fd 100644 --- a/dune-project +++ b/dune-project @@ -48,7 +48,7 @@ (depopts trace lwt eio) (conflicts (trace - (< 0.9))) + (< 0.10))) (tags (instrumentation tracing opentelemetry datadog jaeger))) diff --git a/opentelemetry.opam b/opentelemetry.opam index c5fddf66..919011ae 100644 --- a/opentelemetry.opam +++ b/opentelemetry.opam @@ -27,7 +27,7 @@ depends: [ ] depopts: ["trace" "lwt" "eio"] conflicts: [ - "trace" {< "0.9"} + "trace" {< "0.10"} ] build: [ ["dune" "subst"] {dev} diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml index e3e3c1f7..4de03c5d 100644 --- a/src/core/opentelemetry.ml +++ b/src/core/opentelemetry.ml @@ -369,7 +369,7 @@ module Span_id : sig end = struct type t = bytes - let to_bytes self = self + let[@inline] to_bytes self = self let dummy : t = Bytes.make 8 '\x00' diff --git a/src/trace/opentelemetry_trace.ml b/src/trace/opentelemetry_trace.ml index bf9a091d..dd423d84 100644 --- a/src/trace/opentelemetry_trace.ml +++ b/src/trace/opentelemetry_trace.ml @@ -6,6 +6,49 @@ open struct let spf = Printf.sprintf end +module Conv = struct + let[@inline] trace_id_of_otel (id : Otel.Trace_id.t) : Otrace.trace_id = + if id == Otel.Trace_id.dummy then + Otrace.Collector.dummy_trace_id + else + Bytes.unsafe_to_string (Otel.Trace_id.to_bytes id) + + let[@inline] trace_id_to_otel (id : Otrace.trace_id) : Otel.Trace_id.t = + if id == Otrace.Collector.dummy_trace_id then + Otel.Trace_id.dummy + else + Otel.Trace_id.of_bytes @@ Bytes.unsafe_of_string id + + let[@inline] span_id_of_otel (id : Otel.Span_id.t) : Otrace.span = + if id == Otel.Span_id.dummy then + Otrace.Collector.dummy_span + else + Bytes.get_int64_le (Otel.Span_id.to_bytes id) 0 + + let[@inline] span_id_to_otel (id : Otrace.span) : Otel.Span_id.t = + if id == Otrace.Collector.dummy_span then + Otel.Span_id.dummy + else ( + let b = Bytes.create 8 in + Bytes.set_int64_le b 0 id; + Otel.Span_id.of_bytes b + ) + + let[@inline] ctx_to_otel (self : Otrace.explicit_span_ctx) : Otel.Span_ctx.t = + Otel.Span_ctx.make + ~trace_id:(trace_id_to_otel self.trace_id) + ~parent_id:(span_id_to_otel self.span) + () + + let[@inline] ctx_of_otel (ctx : Otel.Span_ctx.t) : Otrace.explicit_span_ctx = + { + trace_id = trace_id_of_otel (Otel.Span_ctx.trace_id ctx); + span = span_id_of_otel (Otel.Span_ctx.parent_id ctx); + } +end + +open Conv + module Well_known = struct let spankind_key = "otrace.spankind" @@ -42,9 +85,9 @@ module Well_known = struct in !kind, data - (** Key to store an error [Otel.Span.status] with the message. - Set ["otrace.error" = "mymsg"] in a span data to set the span's status - to [{message="mymsg"; code=Error}]. *) + (** Key to store an error [Otel.Span.status] with the message. Set + ["otrace.error" = "mymsg"] in a span data to set the span's status to + [{message="mymsg"; code=Error}]. *) let status_error_key = "otrace.error" end @@ -101,12 +144,7 @@ module Internal = struct assert (Bytes.length bs = 8); Bytes.get_int64_le bs 0 - let otel_of_otrace (id : int64) : Otel.Span_id.t = - let bs = Bytes.create 8 in - Bytes.set_int64_le bs 0 id; - Otel.Span_id.of_bytes bs - - let enter_span' ?explicit_parent ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name + let enter_span' ?(explicit_parent : Otrace.explicit_span_ctx option) ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name = let open Otel in let otel_id = Span_id.create () in @@ -121,7 +159,7 @@ module Internal = struct let parent = match explicit_parent, parent_scope with | Some p, _ -> - Some (Otel.Span_ctx.make ~trace_id ~parent_id:(otel_of_otrace p) ()) + Some (Otel.Span_ctx.make ~trace_id ~parent_id:(span_id_to_otel p.span) ()) | None, Some parent -> Some (Otel.Scope.to_span_ctx parent) | None, None -> None in @@ -237,13 +275,13 @@ module Internal = struct | None -> () | Some otel_span -> Otel.Trace.emit [ otel_span ] - let enter_manual_span ~(parent : Otrace.explicit_span option) ~flavor:_ + let enter_manual_span ~(parent : Otrace.explicit_span_ctx option) ~flavor:_ ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : Otrace.explicit_span = let otrace_id, sb = match parent with | None -> enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name - | Some { span; _ } -> - enter_span' ~explicit_parent:span ~__FUNCTION__ ~__FILE__ ~__LINE__ + | Some parent -> + enter_span' ~explicit_parent:parent ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name in @@ -253,6 +291,7 @@ module Internal = struct Otrace. { span = otrace_id; + trace_id = trace_id_of_otel sb.scope.trace_id; meta = Meta_map.(empty |> add k_explicit_scope sb.scope); } @@ -283,7 +322,7 @@ module Internal = struct let span_id = match span with - | Some id -> Some (otel_of_otrace id) + | Some id -> Some (span_id_to_otel id) | None -> Option.map (fun sc -> sc.Otel.Scope.span_id) old_scope in diff --git a/src/trace/opentelemetry_trace.mli b/src/trace/opentelemetry_trace.mli index 79dd8e04..060f4f13 100644 --- a/src/trace/opentelemetry_trace.mli +++ b/src/trace/opentelemetry_trace.mli @@ -2,6 +2,20 @@ module Otel := Opentelemetry module Otrace := Trace_core module TLS := Thread_local_storage +module Conv : sig + val trace_id_of_otel : Otel.Trace_id.t -> string + + val trace_id_to_otel : string -> Otel.Trace_id.t + + val span_id_of_otel : Otel.Span_id.t -> int64 + + val span_id_to_otel : int64 -> Otel.Span_id.t + + val ctx_to_otel : Otrace.explicit_span_ctx -> Otel.Span_ctx.t + + val ctx_of_otel : Otel.Span_ctx.t -> Otrace.explicit_span_ctx +end + (** [opentelemetry.trace] implements a {!Trace_core.Collector} for {{:https://v3.ocaml.org/p/trace} ocaml-trace}. @@ -28,13 +42,13 @@ module TLS := Thread_local_storage the {!Opentelemetry.Span.kind} of the emitted span. (See {!Internal.spankind_of_string} for the list of supported values.) - {[ocaml + {[ + ocaml let describe () = [ Opentelemetry_trace.(spankind_key, client) ] in Trace_core.with_span ~__FILE__ ~__LINE__ ~data:describe "my-span" @@ fun _ -> (* ... *) - ]} - *) + ]} *) val on_internal_error : (string -> unit) ref (** Callback to print errors in the library itself (ie bugs) *) @@ -43,23 +57,23 @@ val setup : unit -> unit (** Install the OTEL backend as a Trace collector *) val setup_with_otel_backend : Opentelemetry.Collector.backend -> unit -(** Same as {!setup}, but also install the given backend as OTEL backend *) +(** Same as {!setup}, but also install the given backend as OTEL backend *) val collector : unit -> Trace_core.collector (** Make a Trace collector that uses the OTEL backend to send spans and logs *) val link_spans : Otrace.explicit_span -> Otrace.explicit_span -> unit (** [link_spans sp1 sp2] modifies [sp1] by adding a span link to [sp2]. - @since 0.11 *) + @since 0.11 *) val set_span_kind : Otrace.explicit_span -> Otel.Span.kind -> unit (** [set_span_kind sp k] sets the span's kind. - @since 0.11 *) + @since 0.11 *) val record_exception : Otrace.explicit_span -> exn -> Printexc.raw_backtrace -> unit (** Record exception in the current span. - @since 0.11 *) + @since 0.11 *) (** Static references for well-known identifiers; see {!label-wellknown}. *) module Well_known : sig @@ -103,10 +117,11 @@ module Internal : sig {!Opentelemetry.Trace.with_}, and requires configuration of {!Ambient_context}. - @see ambient-context docs *) + @see + ambient-context docs *) val enter_manual_span : - parent:Otrace.explicit_span option -> + parent:Otrace.explicit_span_ctx option -> flavor:'a -> __FUNCTION__:string option -> __FILE__:string -> @@ -135,8 +150,8 @@ module Internal : sig Generally, the best practice is to only use these [manual] functions at the 'leaves' of your callstack: that is, don't invoke user callbacks from within them; or if you do, make sure to pass the [explicit_span] - you recieve from this function onwards to the user callback, so they can create further - child-spans. *) + you recieve from this function onwards to the user callback, so they can + create further child-spans. *) val exit_manual_span : Otrace.explicit_span -> unit (** Implements {!Trace_core.Collector.S.exit_manual_span}, with the @@ -197,10 +212,8 @@ module Internal : sig val otrace_of_otel : Otel.Span_id.t -> Otrace.span - val otel_of_otrace : Otrace.span -> Otel.Span_id.t - val enter_span' : - ?explicit_parent:Otrace.span -> + ?explicit_parent:Otrace.explicit_span_ctx -> __FUNCTION__:string option -> __FILE__:string -> __LINE__:int ->