From a83464bcd5bf7a548490188b79ceacbd211ffa5c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 22 Oct 2024 13:27:01 -0400 Subject: [PATCH] feat otel.trace: extension points for links, record_exn, kind --- src/trace/opentelemetry_trace.ml | 40 ++++++++++++++++++++++++++++--- src/trace/opentelemetry_trace.mli | 14 +++++++++++ 2 files changed, 51 insertions(+), 3 deletions(-) diff --git a/src/trace/opentelemetry_trace.ml b/src/trace/opentelemetry_trace.ml index ebf9328..09b29d7 100644 --- a/src/trace/opentelemetry_trace.ml +++ b/src/trace/opentelemetry_trace.ml @@ -53,6 +53,11 @@ open Well_known let on_internal_error = ref (fun msg -> Printf.eprintf "error in Opentelemetry_trace: %s\n%!" msg) +type Otrace.extension_event += + | Ev_link_span of Otrace.explicit_span * Otrace.explicit_span + | Ev_set_span_kind of Otrace.explicit_span * Otel.Span_kind.t + | Ev_record_exn of Otrace.explicit_span * exn * Printexc.raw_backtrace + module Internal = struct type span_begin = { start_time: int64; @@ -193,6 +198,9 @@ module Internal = struct Active_span_tbl.remove active_spans.tbl otrace_id; Some (exit_span_ otel_span_begin) + let[@inline] get_scope (span : Otrace.explicit_span) : Otel.Scope.t option = + Otrace.Meta_map.find k_explicit_scope span.meta + module M = struct let with_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name cb = let otrace_id, sb = @@ -259,10 +267,10 @@ module Internal = struct | Some sb -> Otel.Scope.add_attrs sb.scope (fun () -> data) let add_data_to_manual_span (span : Otrace.explicit_span) data : unit = - match Otrace.Meta_map.find_exn k_explicit_scope span.meta with - | exception _ -> + match get_scope span with + | None -> !on_internal_error (spf "manual span does not a contain an OTEL scope") - | scope -> Otel.Scope.add_attrs scope (fun () -> data) + | Some scope -> Otel.Scope.add_attrs scope (fun () -> data) let message ?span ~data:_ msg : unit = (* gather information from context *) @@ -293,9 +301,35 @@ module Internal = struct let _kind, attrs = otel_attrs_of_otrace_data data in let m = Otel.Metrics.(gauge ~name [ float ~attrs cur_val ]) in Otel.Metrics.emit [ m ] + + let extension_event = function + | Ev_link_span (sp1, sp2) -> + (match get_scope sp1, get_scope sp2 with + | Some sc1, Some sc2 -> + Otel.Scope.add_links sc1 (fun () -> [ Otel.Scope.to_span_link sc2 ]) + | _ -> !on_internal_error "could not find scope for OTEL span") + | Ev_set_span_kind (sp, k) -> + (match get_scope sp with + | None -> !on_internal_error "could not find scope for OTEL span" + | Some sc -> Otel.Scope.set_kind sc k) + | Ev_record_exn (sp, exn, bt) -> + (match get_scope sp with + | None -> !on_internal_error "could not find scope for OTEL span" + | Some sc -> Otel.Scope.record_exception sc exn bt) + | _ -> () end end +let link_spans (sp1 : Otrace.explicit_span) (sp2 : Otrace.explicit_span) : unit + = + if Otrace.enabled () then Otrace.extension_event @@ Ev_link_span (sp1, sp2) + +let set_span_kind sp k : unit = + if Otrace.enabled () then Otrace.extension_event @@ Ev_set_span_kind (sp, k) + +let record_exception sp exn bt : unit = + if Otrace.enabled () then Otrace.extension_event @@ Ev_record_exn (sp, exn, bt) + let collector () : Otrace.collector = (module Internal.M) let setup () = Otrace.setup_collector @@ collector () diff --git a/src/trace/opentelemetry_trace.mli b/src/trace/opentelemetry_trace.mli index 0834960..da8f848 100644 --- a/src/trace/opentelemetry_trace.mli +++ b/src/trace/opentelemetry_trace.mli @@ -48,6 +48,19 @@ val setup_with_otel_backend : Opentelemetry.Collector.backend -> unit 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 NEXT_RELEASE *) + +val set_span_kind : Otrace.explicit_span -> Otel.Span.kind -> unit +(** [set_span_kind sp k] sets the span's kind. + @since NEXT_RELEASE *) + +val record_exception : + Otrace.explicit_span -> exn -> Printexc.raw_backtrace -> unit +(** Record exception in the current span. + @since NEXT_RELEASE *) + (** Static references for well-known identifiers; see {!label-wellknown}. *) module Well_known : sig val spankind_key : string @@ -68,6 +81,7 @@ module Well_known : sig (string * Otrace.user_data) list -> Otel.Span.kind * Otel.Span.key_value list end +[@@deprecated "use the regular functions for this"] (**/**)