feat otel.trace: extension points for links, record_exn, kind

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 =
@@ -263,10 +271,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
+      match get_scope span with
-      | exception _ ->
+      | 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 *)
@@ -297,9 +305,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 ()

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"]
 
 (**/**)