From ce3c85869b78ec7329c287411d61be8a1b0f3ead Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 9 Mar 2026 17:59:15 -0400 Subject: [PATCH] http clients: carry a description of the export attempt into error message --- .../opentelemetry_client_cohttp_eio.ml | 6 +++--- .../opentelemetry_client_cohttp_lwt.ml | 6 +++--- .../opentelemetry_client_ocurl_lwt.ml | 8 +++++--- .../opentelemetry_client_ocurl.ml | 7 ++++--- src/client/export_error.ml | 18 +++++++++++------- src/client/generic_http_consumer.ml | 19 +++++++++++++------ 6 files changed, 39 insertions(+), 25 deletions(-) diff --git a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml b/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml index 5bcdc46e..fb3b8860 100644 --- a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml +++ b/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) : - ('a, Export_error.t) result = + let send (client : t) ~attempt_descr ~url ~headers:user_headers ~decode + (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 diff --git a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml index a6e87671..ea964cf6 100644 --- a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml +++ b/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) : - ('a, error) result Lwt.t = + let send (_self : t) ~attempt_descr ~url ~headers:user_headers ~decode + (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 diff --git a/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml b/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml index 8d10d404..2a8c0cd3 100644 --- a/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml +++ b/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) : - ('a, error) result Lwt.t = + let send (self : t) ~attempt_descr ~url ~headers:user_headers ~decode + (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 diff --git a/src/client-ocurl/opentelemetry_client_ocurl.ml b/src/client-ocurl/opentelemetry_client_ocurl.ml index d8cd316e..0ded3037 100644 --- a/src/client-ocurl/opentelemetry_client_ocurl.ml +++ b/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) : - ('a, error) result = + let send (self : t) ~attempt_descr ~url ~headers:user_headers ~decode + (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 diff --git a/src/client/export_error.ml b/src/client/export_error.ml index a82954da..e75aacbb 100644 --- a/src/client/export_error.ml +++ b/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 \ - {@[code=%ld;@ message=%S;@ details=[@[%a@]]@]}@]" - code scode + "@[<2>opentelemetry: export failed with@ http code=%d@ attempt: %s@ \ + status {@[code=%ld;@ message=%S;@ details=[@[%a@]]@]}@]" + 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 diff --git a/src/client/generic_http_consumer.ml b/src/client/generic_http_consumer.ml index 05e9bf66..c98a702b 100644 --- a/src/client/generic_http_consumer.ml +++ b/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 () = - Httpc.send self.http ~url ~headers ~decode:(`Ret ()) data + let do_once ~attempt_descr () = + 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)