mirror of
https://github.com/ocaml-tracing/ocaml-opentelemetry.git
synced 2026-03-09 12:23:32 -04:00
trace-collector: Expose Internal module
This commit is contained in:
Elliott Cable
parent
6bf59ee21e
commit
2b3e3d733c
2 changed files with 237 additions and 141 deletions
|
|
@ -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 ()
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue