CP-48195: Tracing -- Move create\set\destroy\...

Moves the following:

- `create` under `TracerProvider`;
- `set` under `TracerProvider`;
- `destroy` under `TracerProvider;
- `get_tracer_providers` unde `TracerProvider`;
- `get_tracer` under `Tracer`.

Adds documentation for `TracerProvider` module.

It kept being confusing of what `Tracing.set` does unless I was going through
the implementation again and again. Therefore, I moved some of the
functions so that their functionality becomes (hopefully) more intuitive.

Signed-off-by: Gabriel Buica <danutgabriel.buica@cloud.com>

Author: GabrielBuica

ocaml/libs/tracing/test_tracing.ml

@@ -46,7 +46,7 @@ let with_observe_mode_check flag f = f () ; assert_observe_mode flag
 
 let get_provider name_label =
   let providers =
-    Tracing.get_tracer_providers ()
+    Tracing.TracerProvider.get_tracer_providers ()
     |> List.filter (fun provider ->
            String.equal
              (Tracing.TracerProvider.get_name_label provider)
@@ -60,11 +60,14 @@ let get_provider name_label =
       Alcotest.failf "expected only one provider"
 
 let create_with (enabled, attributes, endpoints, name_label, uuid) =
-  let () = Tracing.create ~enabled ~attributes ~endpoints ~name_label ~uuid in
+  let () =
+    Tracing.TracerProvider.create ~enabled ~attributes ~endpoints ~name_label
+      ~uuid
+  in
   get_provider name_label
 
 let test_destroy_all_providers uuids =
-  let () = List.iter (fun uuid -> Tracing.destroy ~uuid) uuids in
+  let () = List.iter (fun uuid -> Tracing.TracerProvider.destroy ~uuid) uuids in
   assert_observe_mode false
 
 let test_create_and_destroy () =
@@ -145,7 +148,7 @@ let test_create_and_destroy () =
 
 let test_set_tracer_provider () =
   let test_set_with provider (enabled, attributes, endpoints, uuid) =
-    Tracing.set ~enabled ~attributes ~endpoints ~uuid () ;
+    Tracing.TracerProvider.set ~enabled ~attributes ~endpoints ~uuid () ;
     let updated_provider =
       provider |> Tracing.TracerProvider.get_name_label |> get_provider
     in

ocaml/libs/tracing/tracing.ml

@@ -477,6 +477,82 @@ module TracerProvider = struct
   let get_endpoints t = t.endpoints
 
   let get_enabled t = t.enabled
+
+  let lock = Mutex.create ()
+
+  let tracer_providers = Hashtbl.create 100
+
+  let create ~enabled ~attributes ~endpoints ~name_label ~uuid =
+    let provider : t =
+      let endpoints = List.map endpoint_of_string endpoints in
+      let attributes = Attributes.of_list attributes in
+      {name_label; attributes; endpoints; enabled}
+    in
+    Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
+        ( match Hashtbl.find_opt tracer_providers uuid with
+        | None ->
+            Hashtbl.add tracer_providers uuid provider
+        | Some _ ->
+            (* CP-45469: It is ok not to have an exception here since it is unlikely that the
+               user has caused the issue, so no need to propagate back. It is also
+               handy to not change the control flow since calls like cluster_pool_resync
+               might not be aware that a TracerProvider has already been created.*)
+            error "Tracing : TracerProvider %s already exists" name_label
+        ) ;
+        if enabled then set_observe true
+    )
+
+  let get_tracer_providers_unlocked () =
+    Hashtbl.fold (fun _ provider acc -> provider :: acc) tracer_providers []
+
+  let get_tracer_providers () =
+    Xapi_stdext_threads.Threadext.Mutex.execute lock
+      get_tracer_providers_unlocked
+
+  let set ?enabled ?attributes ?endpoints ~uuid () =
+    let update_provider (provider : t) enabled attributes endpoints =
+      let enabled = Option.value ~default:provider.enabled enabled in
+      let attributes : string Attributes.t =
+        Option.fold ~none:provider.attributes ~some:Attributes.of_list
+          attributes
+      in
+      let endpoints =
+        Option.fold ~none:provider.endpoints
+          ~some:(List.map endpoint_of_string)
+          endpoints
+      in
+      {provider with enabled; attributes; endpoints}
+    in
+
+    Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
+        let provider =
+          match Hashtbl.find_opt tracer_providers uuid with
+          | Some (provider : t) ->
+              update_provider provider enabled attributes endpoints
+          | None ->
+              failwith
+                (Printf.sprintf "The TracerProvider : %s does not exist" uuid)
+        in
+        Hashtbl.replace tracer_providers uuid provider ;
+        if
+          List.for_all
+            (fun provider -> not provider.enabled)
+            (get_tracer_providers_unlocked ())
+        then (
+          set_observe false ;
+          Xapi_stdext_threads.Threadext.Mutex.execute Spans.lock (fun () ->
+              Hashtbl.clear Spans.spans ;
+              Hashtbl.clear Spans.finished_spans
+          )
+        ) else
+          set_observe true
+    )
+
+  let destroy ~uuid =
+    Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
+        let _ = Hashtbl.remove tracer_providers uuid in
+        if Hashtbl.length tracer_providers = 0 then set_observe false else ()
+    )
 end
 
 module Tracer = struct
@@ -495,6 +571,19 @@ module Tracer = struct
     in
     {name= ""; provider}
 
+  let get_tracer ~name =
+    let providers =
+      Xapi_stdext_threads.Threadext.Mutex.execute TracerProvider.lock
+        TracerProvider.get_tracer_providers_unlocked
+    in
+
+    match List.find_opt TracerProvider.get_enabled providers with
+    | Some provider ->
+        create ~name ~provider
+    | None ->
+        warn "No provider found for tracing %s" name ;
+        no_op
+
   let span_of_span_context context name : Span.t =
     {
       context
@@ -549,100 +638,12 @@ module Tracer = struct
     Spans.finished_span_hashtbl_is_empty ()
 end
 
-let lock = Mutex.create ()
-
-let tracer_providers = Hashtbl.create 100
-
-let get_tracer_providers_unlocked () =
-  Hashtbl.fold (fun _ provider acc -> provider :: acc) tracer_providers []
-
-let get_tracer_providers () =
-  Xapi_stdext_threads.Threadext.Mutex.execute lock get_tracer_providers_unlocked
-
-let set ?enabled ?attributes ?endpoints ~uuid () =
-  let update_provider (provider : TracerProvider.t) enabled attributes endpoints
-      =
-    let enabled = Option.value ~default:provider.enabled enabled in
-    let attributes : string Attributes.t =
-      Option.fold ~none:provider.attributes ~some:Attributes.of_list attributes
-    in
-    let endpoints =
-      Option.fold ~none:provider.endpoints
-        ~some:(List.map endpoint_of_string)
-        endpoints
-    in
-    {provider with enabled; attributes; endpoints}
-  in
-
-  Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
-      let provider =
-        match Hashtbl.find_opt tracer_providers uuid with
-        | Some (provider : TracerProvider.t) ->
-            update_provider provider enabled attributes endpoints
-        | None ->
-            failwith
-              (Printf.sprintf "The TracerProvider : %s does not exist" uuid)
-      in
-      Hashtbl.replace tracer_providers uuid provider ;
-      if
-        List.for_all
-          (fun provider -> not provider.TracerProvider.enabled)
-          (get_tracer_providers_unlocked ())
-      then (
-        set_observe false ;
-        Xapi_stdext_threads.Threadext.Mutex.execute Spans.lock (fun () ->
-            Hashtbl.clear Spans.spans ;
-            Hashtbl.clear Spans.finished_spans
-        )
-      ) else
-        set_observe true
-  )
-
-let create ~enabled ~attributes ~endpoints ~name_label ~uuid =
-  let provider : TracerProvider.t =
-    let endpoints = List.map endpoint_of_string endpoints in
-    let attributes = Attributes.of_list attributes in
-    {name_label; attributes; endpoints; enabled}
-  in
-  Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
-      ( match Hashtbl.find_opt tracer_providers uuid with
-      | None ->
-          Hashtbl.add tracer_providers uuid provider
-      | Some _ ->
-          (* CP-45469: It is ok not to have an exception here since it is unlikely that the
-             user has caused the issue, so no need to propagate back. It is also
-             handy to not change the control flow since calls like cluster_pool_resync
-             might not be aware that a TracerProvider has already been created.*)
-          error "Tracing : TracerProvider %s already exists" name_label
-      ) ;
-      if enabled then set_observe true
-  )
-
-let destroy ~uuid =
-  Xapi_stdext_threads.Threadext.Mutex.execute lock (fun () ->
-      let _ = Hashtbl.remove tracer_providers uuid in
-      if Hashtbl.length tracer_providers = 0 then set_observe false else ()
-  )
-
-let get_tracer ~name =
-  let providers =
-    Xapi_stdext_threads.Threadext.Mutex.execute lock
-      get_tracer_providers_unlocked
-  in
-
-  match List.find_opt TracerProvider.get_enabled providers with
-  | Some provider ->
-      Tracer.create ~name ~provider
-  | None ->
-      (* warn "No provider found for tracing %s" name ; *)
-      Tracer.no_op
-
 let enable_span_garbage_collector ?(timeout = 86400.) () =
   Spans.GC.initialise_thread ~timeout
 
 let with_tracing ?(attributes = []) ?(parent = None) ~name f =
   if Atomic.get observe then (
-    let tracer = get_tracer ~name in
+    let tracer = Tracer.get_tracer ~name in
     match Tracer.start ~tracer ~attributes ~name ~parent () with
     | Ok span -> (
       try

ocaml/libs/tracing/tracing.mli

@@ -110,6 +110,8 @@ end
 module Tracer : sig
   type t
 
+  val get_tracer : name:string -> t
+
   val span_of_span_context : SpanContext.t -> string -> Span.t
 
   val start :
@@ -131,40 +133,61 @@ module Tracer : sig
   val finished_span_hashtbl_is_empty : unit -> bool
 end
 
+(** [TracerProvider] module provides ways to intereact with the tracer providers. 
+    *)
 module TracerProvider : sig
+  (** Type that represents a tracer provider.*)
   type t
 
+  val create :
+       enabled:bool
+    -> attributes:(string * string) list
+    -> endpoints:string list
+    -> name_label:string
+    -> uuid:string
+    -> unit
+  (** [create ~enabled ~attributes ~endpoints ~name_label ~uuid] initializes a 
+      tracer provider based on the following parameters: [enabled], [attributes],
+      [endpoints], [name_label], and [uuid]. *)
+
+  val set :
+       ?enabled:bool
+    -> ?attributes:(string * string) list
+    -> ?endpoints:string list
+    -> uuid:string
+    -> unit
+    -> unit
+  (** [set ?enabled ?attributes ?endpoints ~uuid ()] updates the tracer provider
+      identified by the given [uuid] with the new configuration paremeters: 
+      [enabled], [attributes], and [endpoints]. 
+        
+      If any of the configuration parameters are
+      missing, the old ones are kept.
+        
+      Raises [Failure] if there are no tracer provider with the given [uuid].
+      *)
+
+  val destroy : uuid:string -> unit
+  (** [destroy ~uuid] destroys the tracer provider with the given [uuid]. 
+      If there are no tracer provider with the given [uuid], it does nothing.
+      *)
+
+  val get_tracer_providers : unit -> t list
+  (** [get_tracer_providers] returns a list of all existing tracer providers. *)
+
   val get_name_label : t -> string
+  (** [get_name_label provider] returns the name label of the [provider]. *)
 
   val get_attributes : t -> (string * string) list
+  (** [get_attributes provider] returns the list of attributes of the [provider]. *)
 
   val get_endpoints : t -> endpoint list
+  (** [get_endpoints provider] returns list of endpoints of the [provider]. *)
 
   val get_enabled : t -> bool
+  (** [get_name_label provider] returns whether or not the [provider] is enabled. *)
 end
 
-val set :
-     ?enabled:bool
-  -> ?attributes:(string * string) list
-  -> ?endpoints:string list
-  -> uuid:string
-  -> unit
-  -> unit
-
-val create :
-     enabled:bool
-  -> attributes:(string * string) list
-  -> endpoints:string list
-  -> name_label:string
-  -> uuid:string
-  -> unit
-
-val destroy : uuid:string -> unit
-
-val get_tracer_providers : unit -> TracerProvider.t list
-
-val get_tracer : name:string -> Tracer.t
-
 val enable_span_garbage_collector : ?timeout:float -> unit -> unit
 
 val with_tracing :

ocaml/libs/tracing/tracing_export.ml

@@ -280,7 +280,7 @@ module Destination = struct
     let@ parent =
       with_tracing ~parent:None ~attributes ~name:"Tracing.flush_spans"
     in
-    get_tracer_providers ()
+    TracerProvider.get_tracer_providers ()
     |> List.filter TracerProvider.get_enabled
     |> List.concat_map TracerProvider.get_endpoints
     |> List.iter (export_to_endpoint parent span_list)

ocaml/tests/test_observer.ml

@@ -62,13 +62,13 @@ end
 
 module TracerProvider = struct
   let assert_num_observers ~__context x =
-    let providers = get_tracer_providers () in
+    let providers = TracerProvider.get_tracer_providers () in
     Alcotest.(check int)
       (Printf.sprintf "%d provider(s) exists in lib " x)
       x (List.length providers)
 
   let find_provider_exn ~name =
-    let providers = get_tracer_providers () in
+    let providers = TracerProvider.get_tracer_providers () in
     match
       List.find_opt (fun x -> TracerProvider.get_name_label x = name) providers
     with
@@ -135,12 +135,12 @@ let test_create ~__context ?(name_label = "test-observer") ?(enabled = false) ()
   self
 
 let start_test_span () =
-  let tracer = get_tracer ~name:"test-observer" in
+  let tracer = Tracer.get_tracer ~name:"test-observer" in
   let span = Tracer.start ~tracer ~name:"test_task" ~parent:None () in
   span
 
 let start_test_trace () =
-  let tracer = get_tracer ~name:"test-observer" in
+  let tracer = Tracer.get_tracer ~name:"test-observer" in
   let root =
     Tracer.start ~tracer ~name:"test_task" ~parent:None ()
     |> Result.value ~default:None