add links to scope

src/client-ocurl/opentelemetry_client_ocurl.ml

@@ -38,6 +38,7 @@ module Self_trace = struct
           span_id = dummy_span_id;
           attrs = [];
           events = [];
+          links = [];
         }
       in
       f scope

src/core/opentelemetry.ml

@@ -751,6 +751,49 @@ end = struct
     default_span_event ~time_unix_nano ~name ~attributes:attrs ()
 end
 
+(** Span Link
+
+   A pointer from the current span to another span in the same trace or in a
+   different trace. For example, this can be used in batching operations,
+   where a single batch handler processes multiple requests from different
+   traces or when the handler receives a request from a different project.
+*)
+module Span_link : sig
+  open Proto.Trace
+
+  type t = span_link
+
+  val make :
+    trace_id:Trace_id.t ->
+    span_id:Span_id.t ->
+    ?trace_state:string ->
+    ?attrs:key_value list ->
+    ?dropped_attributes_count:int ->
+    unit ->
+    t
+
+  val of_span_ctx : ?attrs:key_value list -> Span_ctx.t -> t
+end = struct
+  open Proto.Trace
+
+  type t = span_link
+
+  let make ~trace_id ~span_id ?trace_state ?(attrs = [])
+      ?dropped_attributes_count () : t =
+    let attributes = List.map _conv_key_value attrs in
+    let dropped_attributes_count =
+      Option.map Int32.of_int dropped_attributes_count
+    in
+    default_span_link
+      ~trace_id:(Trace_id.to_bytes trace_id)
+      ~span_id:(Span_id.to_bytes span_id) ?trace_state ~attributes
+      ?dropped_attributes_count ()
+
+  let[@inline] of_span_ctx ?attrs ctx : t =
+    make ~trace_id:(Span_ctx.trace_id ctx) ~span_id:(Span_ctx.parent_id ctx)
+      ?attrs ()
+end
+
 (** {2 Scopes} *)
 
 (** Scopes.
@@ -763,6 +806,7 @@ module Scope = struct
     span_id: Span_id.t;
     mutable events: Event.t list;
     mutable attrs: key_value list;
+    mutable links: Span_link.t list;
   }
 
   (** Turn the scope into a span context *)
@@ -791,14 +835,22 @@ module Scope = struct
       scope.events <- ev :: scope.events
     )
 
-  (** Add an attr to the scope. It will be aggregated into the span.
+  (** Add attributes to the scope. It will be aggregated into the span.
 
       Note that this takes a function that produces attributes, and will only
       call it if there is an instrumentation backend. *)
   let[@inline] add_attrs (scope : t) (attrs : unit -> key_value list) : unit =
     if Collector.has_backend () then
       scope.attrs <- List.rev_append (attrs ()) scope.attrs
 
+  (** Add links to the scope. It will be aggregated into the span.
+
+      Note that this takes a function that produces links, and will only
+      call it if there is an instrumentation backend. *)
+  let[@inline] add_links (scope : t) (links : unit -> Span_link.t list) : unit =
+    if Collector.has_backend () then
+      scope.links <- List.rev_append (links ()) scope.links
+
   (** The opaque key necessary to access/set the ambient scope with
       {!Ambient_context}. *)
   let ambient_scope_key : t Ambient_context.key = Ambient_context.create_key ()
@@ -820,49 +872,6 @@ end
 
 (** {2 Traces} *)
 
-(** Span Link
-
-   A pointer from the current span to another span in the same trace or in a
-   different trace. For example, this can be used in batching operations,
-   where a single batch handler processes multiple requests from different
-   traces or when the handler receives a request from a different project.
-*)
-module Span_link : sig
-  open Proto.Trace
-
-  type t = span_link
-
-  val make :
-    trace_id:Trace_id.t ->
-    span_id:Span_id.t ->
-    ?trace_state:string ->
-    ?attrs:key_value list ->
-    ?dropped_attributes_count:int ->
-    unit ->
-    t
-
-  val of_span_ctx : ?attrs:key_value list -> Span_ctx.t -> t
-end = struct
-  open Proto.Trace
-
-  type t = span_link
-
-  let make ~trace_id ~span_id ?trace_state ?(attrs = [])
-      ?dropped_attributes_count () : t =
-    let attributes = List.map _conv_key_value attrs in
-    let dropped_attributes_count =
-      Option.map Int32.of_int dropped_attributes_count
-    in
-    default_span_link
-      ~trace_id:(Trace_id.to_bytes trace_id)
-      ~span_id:(Span_id.to_bytes span_id) ?trace_state ~attributes
-      ?dropped_attributes_count ()
-
-  let[@inline] of_span_ctx ?attrs ctx : t =
-    make ~trace_id:(Span_ctx.trace_id ctx) ~span_id:(Span_ctx.parent_id ctx)
-      ?attrs ()
-end
-
 (** Spans.
 
     A Span is the workhorse of traces, it indicates an operation that
@@ -1007,6 +1016,7 @@ module Trace = struct
     span_id: Span_id.t;
     mutable events: Event.t list;
     mutable attrs: Span.key_value list;
+    mutable links: Span_link.t list;
   }
   [@@deprecated "use Scope.t"]
 
@@ -1016,7 +1026,7 @@ module Trace = struct
 
   let with_' ?(force_new_trace_id = false) ?trace_state ?service_name
       ?(attrs : (string * [< value ]) list = []) ?kind ?trace_id ?parent ?scope
-      ?links name cb =
+      ?(links = []) name cb =
     let scope =
       if force_new_trace_id then
         None
@@ -1039,7 +1049,7 @@ module Trace = struct
     in
     let start_time = Timestamp_ns.now_unix_ns () in
     let span_id = Span_id.create () in
-    let scope = { trace_id; span_id; events = []; attrs } in
+    let scope = { trace_id; span_id; events = []; attrs; links } in
     (* called once we're done, to emit a span *)
     let finally res =
       let status =
@@ -1055,8 +1065,8 @@ module Trace = struct
         (* TODO: should the attrs passed to with_ go on the Span
            (in Span.create) or on the ResourceSpan (in emit)?
            (question also applies to Opentelemetry_lwt.Trace.with) *)
-        Span.create ?kind ~trace_id ?parent ?links ~id:span_id ?trace_state
-          ~attrs:scope.attrs ~events:scope.events ~start_time
+        Span.create ?kind ~trace_id ?parent ~links:scope.links ~id:span_id
+          ?trace_state ~attrs:scope.attrs ~events:scope.events ~start_time
           ~end_time:(Timestamp_ns.now_unix_ns ())
           ~status name
       in

src/integrations/cohttp/opentelemetry_cohttp_lwt.ml

@@ -112,7 +112,14 @@ end = struct
       (match Traceparent.of_value v with
       | Ok (trace_id, parent_id) ->
         Some
-          Otel.Trace.{ trace_id; span_id = parent_id; events = []; attrs = [] }
+          Otel.Trace.
+            {
+              trace_id;
+              span_id = parent_id;
+              events = [];
+              attrs = [];
+              links = [];
+            }
       | Error _ -> None)
 
   let remove_trace_context req =

src/trace/opentelemetry_trace.ml

@@ -122,7 +122,13 @@ module Internal = struct
     in
 
     let new_scope =
-      { Scope.span_id = otel_id; trace_id; events = []; attrs = data }
+      {
+        Scope.span_id = otel_id;
+        trace_id;
+        events = [];
+        attrs = data;
+        links = [];
+      }
     in
 
     let start_time = Timestamp_ns.now_unix_ns () in