refactor: extract should_retry

This commit is contained in:
Simon Cruanes 2026-02-15 15:21:29 -05:00
parent a44c50581b
commit 33a0ee69ba
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4

View file

@ -60,15 +60,33 @@ end = struct
let cleanup self = Httpc.cleanup self.http
let send (self : t) (sigs : OTEL.Any_signal_l.t) : (unit, error) result IO.t
=
(** Should we retry, based on the HTTP response code? *)
let should_retry = function
| `Failure _ -> true (* Network errors, connection issues *)
| `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 open IO in
let* result = f () in
match result with
| Ok x -> return (Ok x)
| Error err
when should_retry err && attempt < self.config.retry_max_attempts ->
let delay_s = delay_ms /. 1000. in
let* () = sleep_s delay_s in
let next_delay =
min self.config.retry_max_delay_ms
(delay_ms *. self.config.retry_backoff_multiplier)
in
retry_loop_ self (attempt + 1) next_delay ~f
| Error _ as err -> return err
let send (self : t) (sigs : OTEL.Any_signal_l.t) : (unit, error) result IO.t
=
let res = Resource_signal.of_signal_l sigs in
let url, signal_headers =
match res with
@ -98,30 +116,14 @@ end = struct
~protocol:self.config.protocol res
in
(* Retry loop with exponential backoff *)
let rec retry_send attempt delay_ms =
let open IO in
let* result =
let do_once () =
Httpc.send self.http ~url ~headers ~decode:(`Ret ()) data
in
match result with
| Ok x -> return (Ok x)
| Error err
when should_retry err && attempt < self.config.retry_max_attempts ->
let delay_s = delay_ms /. 1000. in
let* () = sleep_s delay_s in
let next_delay =
min self.config.retry_max_delay_ms
(delay_ms *. self.config.retry_backoff_multiplier)
in
retry_send (attempt + 1) next_delay
| Error _ as err -> return err
in
if self.config.retry_max_attempts > 0 then
retry_send 0 self.config.retry_initial_delay_ms
retry_loop_ self 0 self.config.retry_initial_delay_ms ~f:do_once
else
Httpc.send self.http ~url ~headers ~decode:(`Ret ()) data
do_once ()
end
module C = Generic_consumer.Make (IO) (Notifier) (Sender)