http clients: carry a description of the export attempt into error message

src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml

@@ -89,8 +89,8 @@ struct
     let cleanup = ignore
 
     (* send the content to the remote endpoint/path *)
-    let send (client : t) ~url ~headers:user_headers ~decode (body : string) :
+    let send (client : t) ~attempt_descr ~url ~headers:user_headers ~decode
-        ('a, Export_error.t) result =
+        (body : string) : ('a, Export_error.t) result =
       Eio.Switch.run @@ fun sw ->
       let uri = Uri.of_string url in
 
@@ -138,7 +138,7 @@ struct
           let r =
             try
               let status = Status.decode_pb_status dec in
-              Error (`Status (code, status))
+              Error (`Status (code, status, attempt_descr))
             with e ->
               let bt = Printexc.get_backtrace () in
               Error

src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml

@@ -27,8 +27,8 @@ module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct
   let cleanup _self = ()
 
   (* send the content to the remote endpoint/path *)
-  let send (_self : t) ~url ~headers:user_headers ~decode (bod : string) :
+  let send (_self : t) ~attempt_descr ~url ~headers:user_headers ~decode
-      ('a, error) result Lwt.t =
+      (bod : string) : ('a, error) result Lwt.t =
     let uri = Uri.of_string url in
 
     let open Cohttp in
@@ -74,7 +74,7 @@ module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct
         let r =
           try
             let status = Status.decode_pb_status dec in
-            Error (`Status (code, status))
+            Error (`Status (code, status, attempt_descr))
           with e ->
             let bt = Printexc.get_backtrace () in
             Error

src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml

@@ -26,8 +26,8 @@ module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct
   let cleanup self = Ezcurl_lwt.delete self
 
   (** send the content to the remote endpoint/path *)
-  let send (self : t) ~url ~headers:user_headers ~decode (bod : string) :
+  let send (self : t) ~attempt_descr ~url ~headers:user_headers ~decode
-      ('a, error) result Lwt.t =
+      (bod : string) : ('a, error) result Lwt.t =
     let* r =
       let headers = user_headers in
       Ezcurl_lwt.post ~client:self ~headers ~params:[] ~url
@@ -61,7 +61,9 @@ module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct
         in
         Lwt.return r)
     | Ok { code; body; _ } ->
-      let err = Export_error.decode_invalid_http_response ~url ~code body in
+      let err =
+        Export_error.decode_invalid_http_response ~attempt_descr ~url ~code body
+      in
       Lwt.return (Error err)
 end
 

src/client-ocurl/opentelemetry_client_ocurl.ml

@@ -24,8 +24,8 @@ module Httpc : OTELC.Generic_http_consumer.HTTPC with module IO = IO = struct
 
   let cleanup = Ezcurl.delete
 
-  let send (self : t) ~url ~headers:user_headers ~decode (bod : string) :
+  let send (self : t) ~attempt_descr ~url ~headers:user_headers ~decode
-      ('a, error) result =
+      (bod : string) : ('a, error) result =
     let r =
       let headers = user_headers in
       Ezcurl.post ~client:self ~headers ~params:[] ~url ~content:(`String bod)
@@ -57,7 +57,8 @@ module Httpc : OTELC.Generic_http_consumer.HTTPC with module IO = IO = struct
                 (spf "decoding failed with:\n%s\n%s" (Printexc.to_string e) bt))))
     | Ok { code; body; _ } ->
       let err =
-        OTELC.Export_error.decode_invalid_http_response ~url ~code body
+        OTELC.Export_error.decode_invalid_http_response ~attempt_descr ~url
+          ~code body
       in
       Error err
 end

src/client/export_error.ml

@@ -1,7 +1,9 @@
 (** Error that can occur during export *)
 
+type attempt_descr = string
+
 type t =
-  [ `Status of int * Opentelemetry.Proto.Status.status
+  [ `Status of int * Opentelemetry.Proto.Status.status * attempt_descr
   | `Failure of string
   | `Sysbreak
   ]
@@ -24,25 +26,27 @@ let report_err : t -> unit = function
           message;
           details;
           _presence = _;
-        } ) ->
+        },
+        descr ) ->
     Opentelemetry.Self_debug.log Opentelemetry.Self_debug.Error (fun () ->
         let pp_details out l =
           List.iter
             (fun s -> Format.fprintf out "%S;@ " (Bytes.unsafe_to_string s))
             l
         in
+
         Format.asprintf
-          "@[<2>opentelemetry: export failed with@ http code=%d@ status \
+          "@[<2>opentelemetry: export failed with@ http code=%d@ attempt: %s@ \
-           {@[code=%ld;@ message=%S;@ details=[@[%a@]]@]}@]"
+           status {@[code=%ld;@ message=%S;@ details=[@[%a@]]@]}@]"
-          code scode
+          code descr scode
           (Bytes.unsafe_to_string message)
           pp_details details)
 
-let decode_invalid_http_response ~code ~url (body : string) : t =
+let decode_invalid_http_response ~attempt_descr ~code ~url (body : string) : t =
   try
     let dec = Pbrt.Decoder.of_string body in
     let status = Opentelemetry.Proto.Status.decode_pb_status dec in
-    `Status (code, status)
+    `Status (code, status, attempt_descr)
   with e ->
     let bt = Printexc.get_backtrace () in
     `Failure

src/client/generic_http_consumer.ml

@@ -15,11 +15,14 @@ module type HTTPC = sig
 
   val send :
     t ->
+    attempt_descr:string ->
     url:string ->
     headers:(string * string) list ->
     decode:[ `Dec of Pbrt.Decoder.t -> 'a | `Ret of 'a ] ->
     string ->
     ('a, error) result IO.t
+  (** Send a HTTP request.
+      @param attempt_descr included in error message if this fails *)
 end
 
 module Make
@@ -61,15 +64,19 @@ end = struct
     (** Should we retry, based on the HTTP response code? *)
     let should_retry = function
       | `Failure _ -> true (* Network errors, connection issues *)
-      | `Status (code, _) ->
+      | `Status (code, _, _) ->
         (* Retry on server errors, rate limits, timeouts *)
         code >= 500 || code = 429 || code = 408
       | `Sysbreak -> false (* User interrupt, don't retry *)
 
     (** Retry loop over [f()] with exponential backoff *)
-    let rec retry_loop_ (self : t) attempt delay_ms ~f =
+    let rec retry_loop_ (self : t) attempt delay_ms
+        ~(f : attempt_descr:string -> unit -> _ result IO.t) : _ result IO.t =
       let open IO in
-      let* result = f () in
+      let attempt_descr =
+        spf "try(%d/%d)" attempt self.config.retry_max_attempts
+      in
+      let* result = f ~attempt_descr () in
       match result with
       | Ok x -> return (Ok x)
       | Error err
@@ -114,14 +121,14 @@ end = struct
           ~protocol:self.config.protocol res
       in
 
-      let do_once () =
+      let do_once ~attempt_descr () =
-        Httpc.send self.http ~url ~headers ~decode:(`Ret ()) data
+        Httpc.send self.http ~attempt_descr ~url ~headers ~decode:(`Ret ()) data
       in
 
       if self.config.retry_max_attempts > 0 then
         retry_loop_ self 0 self.config.retry_initial_delay_ms ~f:do_once
       else
-        do_once ()
+        do_once ~attempt_descr:"single_attempt" ()
   end
 
   module C = Generic_consumer.Make (IO) (Notifier) (Sender)