collector: Add debug-wrapping backend

src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml

@@ -108,8 +108,7 @@ end = struct
       try%lwt
         let+ r = Httpc.post ~headers ~body uri in
         Ok r
-      with e ->
+      with e -> Lwt.return @@ Error e
-        Lwt.return @@ Error e
     in
     match r with
     | Error e ->
@@ -551,7 +550,7 @@ end)
     }
 end
 
-let setup_ ?(stop = Atomic.make false) ~(config : Config.t) () =
+let create_backend ?(stop = Atomic.make false) ?(config = Config.make ()) () =
   debug_ := config.debug;
   let module B =
     Backend
@@ -562,12 +561,17 @@ let setup_ ?(stop = Atomic.make false) ~(config : Config.t) () =
       end)
       ()
   in
-  Opentelemetry.Collector.set_backend (module B);
+  (module B : OT.Collector.BACKEND)
+
+let setup_ ?stop ?config () =
+  let backend = create_backend ?stop ?config () in
+  let (module B : OT.Collector.BACKEND) = backend in
+  OT.Collector.set_backend backend;
   B.cleanup
 
-let setup ?stop ?(config = Config.make ()) ?(enable = true) () =
+let setup ?stop ?config ?(enable = true) () =
   if enable then (
-    let cleanup = setup_ ?stop ~config () in
+    let cleanup = setup_ ?stop ?config () in
     at_exit cleanup
   )
 

src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli

@@ -18,6 +18,12 @@ val set_headers : (string * string) list -> unit
 
 module Config = Config
 
+val create_backend :
+  ?stop:bool Atomic.t ->
+  ?config:Config.t ->
+  unit ->
+  (module Opentelemetry.Collector.BACKEND)
+
 val setup :
   ?stop:bool Atomic.t -> ?config:Config.t -> ?enable:bool -> unit -> unit
 (** Setup endpoint. This modifies {!Opentelemetry.Collector.backend}.

src/client-ocurl/opentelemetry_client_ocurl.ml

@@ -325,7 +325,8 @@ end = struct
     )
 end
 
-let mk_backend ~stop ~config () : (module Collector.BACKEND) =
+let create_backend ?(stop = Atomic.make false)
+    ?(config : Config.t = Config.make ()) () : (module Collector.BACKEND) =
   let module M = struct
     open Opentelemetry.Proto
     open Opentelemetry.Collector
@@ -426,8 +427,9 @@ let setup_ticker_thread ~stop ~sleep_ms (module B : Collector.BACKEND) () =
   in
   start_bg_thread tick_loop
 
-let setup_ ?(stop = Atomic.make false) ~(config : Config.t) () =
+let setup_ ?(stop = Atomic.make false) ?(config : Config.t = Config.make ()) ()
-  let ((module B) as backend) = mk_backend ~stop ~config () in
+    =
+  let ((module B) as backend) = create_backend ~stop ~config () in
   Opentelemetry.Collector.set_backend backend;
 
   if config.ticker_thread then (
@@ -437,15 +439,15 @@ let setup_ ?(stop = Atomic.make false) ~(config : Config.t) () =
 
   B.cleanup
 
-let setup ?stop ?(config = Config.make ()) ?(enable = true) () =
+let setup ?stop ?config ?(enable = true) () =
   if enable then (
-    let cleanup = setup_ ?stop ~config () in
+    let cleanup = setup_ ?stop ?config () in
     at_exit cleanup
   )
 
-let with_setup ?stop ?(config = Config.make ()) ?(enable = true) () f =
+let with_setup ?stop ?config ?(enable = true) () f =
   if enable then (
-    let cleanup = setup_ ?stop ~config () in
+    let cleanup = setup_ ?stop ?config () in
     Fun.protect ~finally:cleanup f
   ) else
     f ()

src/client-ocurl/opentelemetry_client_ocurl.mli

@@ -17,6 +17,12 @@ val set_headers : (string * string) list -> unit
 module Atomic = Opentelemetry_atomic.Atomic
 module Config = Config
 
+val create_backend :
+  ?stop:bool Atomic.t ->
+  ?config:Config.t ->
+  unit ->
+  (module Opentelemetry.Collector.BACKEND)
+
 val setup :
   ?stop:bool Atomic.t -> ?config:Config.t -> ?enable:bool -> unit -> unit
 (** Setup endpoint. This modifies {!Opentelemetry.Collector.backend}.

src/opentelemetry.ml

@@ -147,6 +147,69 @@ module Collector = struct
 
   type backend = (module BACKEND)
 
+  module Noop_backend : BACKEND = struct
+    let noop_sender _ ~ret = ret ()
+
+    let send_trace : Trace.resource_spans list sender = { send = noop_sender }
+
+    let send_metrics : Metrics.resource_metrics list sender =
+      { send = noop_sender }
+
+    let send_logs : Logs.resource_logs list sender = { send = noop_sender }
+
+    let signal_emit_gc_metrics () = ()
+
+    let tick () = ()
+
+    let set_on_tick_callbacks _cbs = ()
+
+    let cleanup () = ()
+  end
+
+  module Debug_backend (B : BACKEND) : BACKEND = struct
+    open Proto
+
+    let send_trace : Trace.resource_spans list sender =
+      {
+        send =
+          (fun l ~ret ->
+            Format.eprintf "SPANS: %a@."
+              (Format.pp_print_list Trace.pp_resource_spans)
+              l;
+            B.send_trace.send l ~ret);
+      }
+
+    let send_metrics : Metrics.resource_metrics list sender =
+      {
+        send =
+          (fun l ~ret ->
+            Format.eprintf "METRICS: %a@."
+              (Format.pp_print_list Metrics.pp_resource_metrics)
+              l;
+            B.send_metrics.send l ~ret);
+      }
+
+    let send_logs : Logs.resource_logs list sender =
+      {
+        send =
+          (fun l ~ret ->
+            Format.eprintf "LOGS: %a@."
+              (Format.pp_print_list Logs.pp_resource_logs)
+              l;
+            B.send_logs.send l ~ret);
+      }
+
+    let signal_emit_gc_metrics () = B.signal_emit_gc_metrics ()
+
+    let tick () = B.tick ()
+
+    let set_on_tick_callbacks cbs = B.set_on_tick_callbacks cbs
+
+    let cleanup () = B.cleanup ()
+  end
+
+  let debug_backend : backend = (module Debug_backend (Noop_backend))
+
   (* hidden *)
   open struct
     let on_tick_cbs_ = ref []
@@ -193,6 +256,14 @@ module Collector = struct
     match !backend with
     | None -> ()
     | Some (module B) -> B.tick ()
+
+  let with_setup_debug_backend b ?(enable = true) () f =
+    let (module B : BACKEND) = b in
+    if enable then (
+      set_backend b;
+      Fun.protect ~finally:B.cleanup f
+    ) else
+      f ()
 end
 
 module Util_ = struct