ocaml-opentelemetry/src/lib/tracer.ml
2026-01-20 00:15:30 -05:00

123 lines
4 KiB
OCaml

(** Traces.
The tracer is an object that can be used to emit spans that form a trace.
See
{{:https://opentelemetry.io/docs/reference/specification/overview/#tracing-signal}
the spec} *)
open Common_
open Proto.Trace
open Opentelemetry_emitter
type span = Span.t
type t = {
emit: Span.t Emitter.t;
clock: Clock.t;
}
(** A tracer.
https://opentelemetry.io/docs/specs/otel/trace/api/#tracer *)
(** Dummy tracer, always disabled *)
let dummy : t = { emit = Emitter.dummy; clock = Clock.ptime_clock }
let[@inline] enabled (self : t) = Emitter.enabled self.emit
let of_exporter (exp : Exporter.t) : t =
{ emit = exp.emit_spans; clock = exp.clock }
(** A tracer that uses the current {!Main_exporter} *)
let dynamic_main : t =
Main_exporter.dynamic_forward_to_main_exporter |> of_exporter
let (add_event [@deprecated "use Span.add_event"]) = Span.add_event'
let (add_attrs [@deprecated "use Span.add_attrs"]) = Span.add_attrs'
(** Helper to implement {!with_} and similar functions *)
let with_thunk_and_finally (self : t) ?(force_new_trace_id = false) ?trace_state
?(attrs : (string * [< Value.t ]) list = []) ?kind ?trace_id ?parent ?links
name cb =
let parent =
match parent with
| Some _ -> parent
| None -> Ambient_span.get ()
in
let trace_id =
match trace_id, parent with
| _ when force_new_trace_id -> Trace_id.create ()
| Some trace_id, _ -> trace_id
| None, Some p -> Span.trace_id p
| None, None -> Trace_id.create ()
in
let start_time = Clock.now self.clock in
let span_id = Span_id.create () in
let parent_id = Option.map Span.id parent in
let span : Span.t =
Span.make ?trace_state ?kind ?parent:parent_id ~trace_id ~id:span_id ~attrs
?links ~start_time ~end_time:start_time name
in
(* called once we're done, to emit a span *)
let finally res =
let end_time = Clock.now self.clock in
Proto.Trace.span_set_end_time_unix_nano span end_time;
(match Span.status span with
| Some _ -> ()
| None ->
(match res with
| Ok () ->
(* By default, all spans are Unset, which means a span completed without error.
The Ok status is reserved for when you need to explicitly mark a span as successful
rather than stick with the default of Unset (i.e., “without error”).
https://opentelemetry.io/docs/languages/go/instrumentation/#set-span-status *)
()
| Error (e, bt) ->
Span.record_exception span e bt;
let status =
make_status ~code:Status_code_error ~message:(Printexc.to_string e) ()
in
Span.set_status span status));
Emitter.emit self.emit [ span ]
in
let thunk () = Ambient_span.with_ambient span (fun () -> cb span) in
thunk, finally
(** Sync span guard.
Notably, this includes {e implicit} scope-tracking: if called without a
[~scope] argument (or [~parent]/[~trace_id]), it will check in the
{!Ambient_context} for a surrounding environment, and use that as the scope.
Similarly, it uses {!Scope.with_ambient_scope} to {e set} a new scope in the
ambient context, so that any logically-nested calls to {!with_} will use
this span as their parent.
{b NOTE} be careful not to call this inside a Gc alarm, as it can cause
deadlocks.
@param tracer the tracer to use (default [get_main()])
@param force_new_trace_id
if true (default false), the span will not use a ambient scope, the
[~scope] argument, nor [~trace_id], but will instead always create fresh
identifiers for this span *)
let with_ ?(tracer = dynamic_main) ?force_new_trace_id ?trace_state ?attrs ?kind
?trace_id ?parent ?links name (cb : Span.t -> 'a) : 'a =
let thunk, finally =
with_thunk_and_finally tracer ?force_new_trace_id ?trace_state ?attrs ?kind
?trace_id ?parent ?links name cb
in
try
let rv = thunk () in
finally (Ok ());
rv
with e ->
let bt = Printexc.get_raw_backtrace () in
finally (Error (e, bt));
raise e