From 2b3e3d733c1d66edd68d79578f67bf99f63a3eaf Mon Sep 17 00:00:00 2001 From: Elliott Cable Date: Wed, 30 Aug 2023 01:21:30 +0000 Subject: [PATCH] trace-collector: Expose Internal module --- src/trace/opentelemetry_trace.ml | 281 +++++++++++++++--------------- src/trace/opentelemetry_trace.mli | 97 ++++++++++- 2 files changed, 237 insertions(+), 141 deletions(-) diff --git a/src/trace/opentelemetry_trace.ml b/src/trace/opentelemetry_trace.ml index 8b6b9da2..34010ef9 100644 --- a/src/trace/opentelemetry_trace.ml +++ b/src/trace/opentelemetry_trace.ml @@ -2,165 +2,166 @@ module Otel = Opentelemetry module Otrace = Trace (* ocaml-trace *) module TLS = Ambient_context_tls.Thread_local -type span_begin = { - id: Otel.Span_id.t; - start_time: int64; - name: string; - data: (string * Otrace.user_data) list; - __FILE__: string; - __LINE__: int; - __FUNCTION__: string option; - trace_id: Otel.Trace_id.t; - scope: Otel.Scope.t; - parent_id: Otel.Span_id.t option; - parent_scope: Otel.Scope.t option; -} +module Internal = struct + type span_begin = { + id: Otel.Span_id.t; + start_time: int64; + name: string; + data: (string * Otrace.user_data) list; + __FILE__: string; + __LINE__: int; + __FUNCTION__: string option; + trace_id: Otel.Trace_id.t; + scope: Otel.Scope.t; + parent_id: Otel.Span_id.t option; + parent_scope: Otel.Scope.t option; + } -(** Table indexed by ocaml-trace spans *) -module Active_span_tbl = Hashtbl.Make (struct - include Int64 + (** Table indexed by ocaml-trace spans *) + module Active_span_tbl = Hashtbl.Make (struct + include Int64 - let hash : t -> int = Hashtbl.hash -end) + let hash : t -> int = Hashtbl.hash + end) -(** Per-thread set of active spans. *) -module Active_spans = struct - type t = { tbl: span_begin Active_span_tbl.t } [@@unboxed] + (** Per-thread set of active spans. *) + module Active_spans = struct + type t = { tbl: span_begin Active_span_tbl.t } [@@unboxed] - let create () : t = { tbl = Active_span_tbl.create 32 } + let create () : t = { tbl = Active_span_tbl.create 32 } - let tls : t TLS.t = TLS.create () + let tls : t TLS.t = TLS.create () - let[@inline] get () : t = TLS.get_or_create tls ~create -end + let[@inline] get () : t = TLS.get_or_create tls ~create + end -let otrace_of_otel (id : Otel.Span_id.t) : int64 = - let bs = Otel.Span_id.to_bytes id in - (* lucky that it coincides! *) - assert (Bytes.length bs = 8); - Bytes.get_int64_le bs 0 + let otrace_of_otel (id : Otel.Span_id.t) : int64 = + let bs = Otel.Span_id.to_bytes id in + (* lucky that it coincides! *) + 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 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 spankind_of_string = - let open Otel.Span in - function - | "INTERNAL" -> Span_kind_internal - | "SERVER" -> Span_kind_server - | "CLIENT" -> Span_kind_client - | "PRODUCER" -> Span_kind_producer - | "CONSUMER" -> Span_kind_consumer - | _ -> Span_kind_unspecified + let spankind_of_string = + let open Otel.Span in + function + | "INTERNAL" -> Span_kind_internal + | "SERVER" -> Span_kind_server + | "CLIENT" -> Span_kind_client + | "PRODUCER" -> Span_kind_producer + | "CONSUMER" -> Span_kind_consumer + | _ -> Span_kind_unspecified -let otel_attrs_of_otrace_data (data : Otel.Span.key_value list) = - let kind : Otel.Span.kind ref = ref Otel.Span.Span_kind_unspecified in - let data = - List.filter_map - (function - | name, `String v when name = "otrace.spankind" -> - kind := spankind_of_string v; - None - | x -> Some x) - data - in - !kind, data + let otel_attrs_of_otrace_data data = + let kind : Otel.Span.kind ref = ref Otel.Span.Span_kind_unspecified in + let data = + List.filter_map + (function + | name, `String v when name = "otrace.spankind" -> + kind := spankind_of_string v; + None + | x -> Some x) + data + in + !kind, data -let enter_span' ?explicit_parent ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name = - let open Otel in - let otel_id = Span_id.create () in - let otrace_id = otrace_of_otel otel_id in + let enter_span' ?explicit_parent ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name + = + let open Otel in + let otel_id = Span_id.create () in + let otrace_id = otrace_of_otel otel_id in - let parent_scope = Scope.get_ambient_scope () in - let trace_id = - match parent_scope with - | Some sc -> sc.trace_id - | None -> Trace_id.create () - in - let parent_id = - match explicit_parent, parent_scope with - | Some p, _ -> Some (otel_of_otrace p) - | None, Some parent -> Some parent.span_id - | None, None -> None - in + let parent_scope = Scope.get_ambient_scope () in + let trace_id = + match parent_scope with + | Some sc -> sc.trace_id + | None -> Trace_id.create () + in + let parent_id = + match explicit_parent, parent_scope with + | Some p, _ -> Some (otel_of_otrace p) + | None, Some parent -> Some parent.span_id + | None, None -> None + in - let new_scope = - { Scope.span_id = otel_id; trace_id; events = []; attrs = [] } - in + let new_scope = + { Scope.span_id = otel_id; trace_id; events = []; attrs = [] } + in - let start_time = Timestamp_ns.now_unix_ns () in + let start_time = Timestamp_ns.now_unix_ns () in - let sb = - { - id = otel_id; - start_time; - name; - data; - __FILE__; - __LINE__; - __FUNCTION__; - trace_id; - scope = new_scope; - parent_id; - parent_scope; - } - in + let sb = + { + id = otel_id; + start_time; + name; + data; + __FILE__; + __LINE__; + __FUNCTION__; + trace_id; + scope = new_scope; + parent_id; + parent_scope; + } + in - let active_spans = Active_spans.get () in - Active_span_tbl.add active_spans.tbl otrace_id sb; + let active_spans = Active_spans.get () in + Active_span_tbl.add active_spans.tbl otrace_id sb; - otrace_id, sb + otrace_id, sb -let exit_span' otrace_id - { - id = otel_id; - start_time; - name; - data; - __FILE__; - __LINE__; - __FUNCTION__; - trace_id; - scope = _; - parent_id; - parent_scope = _; - } = - let open Otel in - let active_spans = Active_spans.get () in - Active_span_tbl.remove active_spans.tbl otrace_id; + let exit_span' otrace_id + { + id = otel_id; + start_time; + name; + data; + __FILE__; + __LINE__; + __FUNCTION__; + trace_id; + scope = _; + parent_id; + parent_scope = _; + } = + let open Otel in + let active_spans = Active_spans.get () in + Active_span_tbl.remove active_spans.tbl otrace_id; - let end_time = Timestamp_ns.now_unix_ns () in + let end_time = Timestamp_ns.now_unix_ns () in - let kind, attrs = otel_attrs_of_otrace_data data in + let kind, attrs = otel_attrs_of_otrace_data data in - let attrs = - match __FUNCTION__ with - | None -> - [ "code.filepath", `String __FILE__; "code.lineno", `Int __LINE__ ] - @ attrs - | Some __FUNCTION__ -> - let last_dot = String.rindex __FUNCTION__ '.' in - let module_path = String.sub __FUNCTION__ 0 last_dot in - let function_name = - String.sub __FUNCTION__ (last_dot + 1) - (String.length __FUNCTION__ - last_dot - 1) - in - [ - "code.filepath", `String __FILE__; - "code.lineno", `Int __LINE__; - "code.function", `String function_name; - "code.namespace", `String module_path; - ] - @ attrs - in - Span.create ~kind ~trace_id ?parent:parent_id ~id:otel_id ~start_time - ~end_time ~attrs name - |> fst + let attrs = + match __FUNCTION__ with + | None -> + [ "code.filepath", `String __FILE__; "code.lineno", `Int __LINE__ ] + @ attrs + | Some __FUNCTION__ -> + let last_dot = String.rindex __FUNCTION__ '.' in + let module_path = String.sub __FUNCTION__ 0 last_dot in + let function_name = + String.sub __FUNCTION__ (last_dot + 1) + (String.length __FUNCTION__ - last_dot - 1) + in + [ + "code.filepath", `String __FILE__; + "code.lineno", `Int __LINE__; + "code.function", `String function_name; + "code.namespace", `String module_path; + ] + @ attrs + in + Span.create ~kind ~trace_id ?parent:parent_id ~id:otel_id ~start_time + ~end_time ~attrs name + |> fst -let collector () : Trace.collector = - let module M = struct + module M = struct let with_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name cb = let otrace_id, sb = enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name @@ -226,8 +227,10 @@ let collector () : Trace.collector = let counter_float name cur_val : unit = let m = Otel.Metrics.(gauge ~name [ float cur_val ]) in Otel.Metrics.emit [ m ] - end in - (module M) + end +end + +let collector () : Trace.collector = (module Internal.M) let setup () = Trace.setup_collector @@ collector () diff --git a/src/trace/opentelemetry_trace.mli b/src/trace/opentelemetry_trace.mli index 8e99befb..e506d674 100644 --- a/src/trace/opentelemetry_trace.mli +++ b/src/trace/opentelemetry_trace.mli @@ -1,8 +1,101 @@ -val collector : unit -> Trace.collector -(** Make a Trace collector that uses the OTEL backend to send spans and logs *) +module Otel := Opentelemetry +module Otrace := Trace +module TLS := Ambient_context_tls.Thread_local 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 *) + +val collector : unit -> Trace.collector +(** Make a Trace collector that uses the OTEL backend to send spans and logs *) + +(** Internal implementation details; do not consider these stable. *) +module Internal : sig + module M : sig + val with_span : + __FUNCTION__:string option -> + __FILE__:string -> + __LINE__:int -> + data:(string * Otrace.user_data) list -> + string (* span name *) -> + (Otrace.span -> 'a) -> + 'a + + val enter_manual_span : + parent:Otrace.explicit_span option -> + flavor:'a -> + __FUNCTION__:string option -> + __FILE__:string -> + __LINE__:int -> + data:(string * Otrace.user_data) list -> + string (* span name *) -> + Otrace.explicit_span + + val exit_manual_span : Otrace.explicit_span -> unit + + val message : + ?span:Otrace.span -> + data:(string * Otrace.user_data) list -> + string -> + unit + + val shutdown : unit -> unit + + val name_process : string -> unit + + val name_thread : string -> unit + + val counter_int : string -> int -> unit + + val counter_float : string -> float -> unit + end + + type span_begin = { + id: Otel.Span_id.t; + start_time: int64; + name: string; + data: (string * Otrace.user_data) list; + __FILE__: string; + __LINE__: int; + __FUNCTION__: string option; + trace_id: Otel.Trace_id.t; + scope: Otel.Scope.t; + parent_id: Otel.Span_id.t option; + parent_scope: Otel.Scope.t option; + } + + module Active_span_tbl : Hashtbl.S with type key = Otrace.span + + module Active_spans : sig + type t = private { tbl: span_begin Active_span_tbl.t } [@@unboxed] + + val create : unit -> t + + val tls : t TLS.t + + val get : unit -> t + end + + val otrace_of_otel : Otel.Span_id.t -> Otrace.span + + val otel_of_otrace : Otrace.span -> Otel.Span_id.t + + val spankind_of_string : string -> Otel.Span.kind + + val otel_attrs_of_otrace_data : + (string * Otrace.user_data) list -> + Otel.Span.kind * Otel.Span.key_value list + + val enter_span' : + ?explicit_parent:Otrace.span -> + __FUNCTION__:string option -> + __FILE__:string -> + __LINE__:int -> + data:(string * Otrace.user_data) list -> + string -> + Otrace.span * span_begin + + val exit_span' : Otrace.span -> span_begin -> Otel.Span.t +end