Merge pull request #66 from tatchi/add-links

add links to scope

src/client-ocurl/opentelemetry_client_ocurl.ml

@@ -33,12 +33,7 @@ module Self_trace = struct
     else (
       (* do nothing *)
       let scope =
-        {
-          Scope.trace_id = dummy_trace_id_;
-          span_id = dummy_span_id;
-          attrs = [];
-          events = [];
-        }
+        Scope.make ~trace_id:dummy_trace_id_ ~span_id:dummy_span_id ()
       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 : Span_ctx.t) : t =
+    make ~trace_id:(Span_ctx.trace_id ctx) ~span_id:(Span_ctx.parent_id ctx)
+      ?attrs ()
+end
+
 (** {2 Scopes} *)
 
 (** Scopes.
@@ -763,8 +806,13 @@ module Scope = struct
     span_id: Span_id.t;
     mutable events: Event.t list;
     mutable attrs: key_value list;
+    mutable links: Span_link.t list;
   }
 
+  let make ~trace_id ~span_id ?(events = []) ?(attrs = []) ?(links = []) () : t
+      =
+    { trace_id; span_id; events; attrs; links }
+
   (** Turn the scope into a span context *)
   let[@inline] to_span_ctx (self : t) : Span_ctx.t =
     Span_ctx.make ~trace_id:self.trace_id ~parent_id:self.span_id ()
@@ -791,14 +839,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 +876,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 +1020,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 +1030,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 +1053,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 = Scope.make ~trace_id ~span_id ~attrs ~links () in
     (* called once we're done, to emit a span *)
     let finally res =
       let status =
@@ -1055,8 +1069,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

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

src/trace/opentelemetry_trace.ml

@@ -121,9 +121,7 @@ module Internal = struct
       | None, None -> None
     in
 
-    let new_scope =
-      { Scope.span_id = otel_id; trace_id; events = []; attrs = data }
-    in
+    let new_scope = Otel.Scope.make ~trace_id ~span_id:otel_id ~attrs:data () in
 
     let start_time = Timestamp_ns.now_unix_ns () in
     let sb =