My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1let src = Logs.Src.create "requests.retry" ~doc:"HTTP Request Retry Logic"
2module Log = (val Logs.src_log src : Logs.LOG)
3
4type config = {
5 max_retries : int;
6 backoff_factor : float;
7 backoff_max : float;
8 status_forcelist : int list;
9 allowed_methods : Method.t list;
10 respect_retry_after : bool;
11 jitter : bool;
12}
13
14let default_config = {
15 max_retries = 3;
16 backoff_factor = 0.3;
17 backoff_max = 120.0;
18 status_forcelist = [408; 429; 500; 502; 503; 504];
19 allowed_methods = [`GET; `HEAD; `PUT; `DELETE; `OPTIONS; `TRACE];
20 respect_retry_after = true;
21 jitter = true;
22}
23
24let create_config
25 ?(max_retries = 3)
26 ?(backoff_factor = 0.3)
27 ?(backoff_max = 120.0)
28 ?(status_forcelist = [408; 429; 500; 502; 503; 504])
29 ?(allowed_methods = [`GET; `HEAD; `PUT; `DELETE; `OPTIONS; `TRACE])
30 ?(respect_retry_after = true)
31 ?(jitter = true)
32 () =
33 Log.debug (fun m -> m "Creating retry config: max_retries=%d backoff_factor=%.2f"
34 max_retries backoff_factor);
35 {
36 max_retries;
37 backoff_factor;
38 backoff_max;
39 status_forcelist;
40 allowed_methods;
41 respect_retry_after;
42 jitter;
43 }
44
45let should_retry ~config ~method_ ~status =
46 let should =
47 List.mem method_ config.allowed_methods &&
48 List.mem status config.status_forcelist
49 in
50 Log.debug (fun m -> m "Should retry? method=%s status=%d -> %b"
51 (Method.to_string method_) status should);
52 should
53
54let calculate_backoff ~config ~attempt =
55 let base_delay = config.backoff_factor *. (2.0 ** float_of_int attempt) in
56 let delay =
57 if config.jitter then
58 (* Add random jitter between 0 and base_delay *)
59 base_delay +. Random.float base_delay
60 else
61 base_delay
62 in
63 let final_delay = min delay config.backoff_max in
64 Log.debug (fun m -> m "Backoff calculation: attempt=%d base=%.2f jitter=%b -> %.2f seconds"
65 attempt base_delay config.jitter final_delay);
66 final_delay
67
68let parse_retry_after value =
69 Log.debug (fun m -> m "Parsing Retry-After header: %s" value);
70
71 (* First try to parse as integer (delay in seconds) *)
72 match int_of_string_opt value with
73 | Some seconds ->
74 Log.debug (fun m -> m "Retry-After is %d seconds" seconds);
75 Some (float_of_int seconds)
76 | None ->
77 (* Try to parse as HTTP date *)
78 (* This is simplified - real implementation would use a proper HTTP date parser *)
79 try
80 let time, _tz_offset, _tz_string = Ptime.of_rfc3339 value |> Result.get_ok in
81 let now = Unix.time () in
82 let target = Ptime.to_float_s time in
83 let delay = max 0.0 (target -. now) in
84 Log.debug (fun m -> m "Retry-After is HTTP date, delay=%.2f seconds" delay);
85 Some delay
86 with _ ->
87 Log.warn (fun m -> m "Failed to parse Retry-After header: %s" value);
88 None
89
90let with_retry ~sw:_ ~clock ~config ~f ~should_retry_exn =
91 let rec attempt_with_retry attempt =
92 Log.info (fun m -> m "Attempt %d/%d" attempt (config.max_retries + 1));
93
94 match f () with
95 | result ->
96 if attempt > 1 then
97 Log.info (fun m -> m "Request succeeded after %d attempts" attempt);
98 result
99 | exception exn when attempt <= config.max_retries && should_retry_exn exn ->
100 let delay = calculate_backoff ~config ~attempt in
101
102 Log.warn (fun m -> m "Request failed (attempt %d/%d): %s. Retrying in %.2f seconds..."
103 attempt (config.max_retries + 1) (Printexc.to_string exn) delay);
104
105 (* Sleep for the backoff duration *)
106 Eio.Time.sleep clock delay;
107
108 attempt_with_retry (attempt + 1)
109 | exception exn ->
110 if attempt > config.max_retries then
111 Log.err (fun m -> m "Request failed after %d attempts: %s"
112 attempt (Printexc.to_string exn))
113 else
114 Log.err (fun m -> m "Request failed and won't be retried: %s"
115 (Printexc.to_string exn));
116 raise exn
117 in
118 attempt_with_retry 1
119
120let pp_config ppf config =
121 Format.fprintf ppf "@[<v>Retry Configuration:@,\
122 @[<v 2>\
123 max_retries: %d@,\
124 backoff_factor: %.2f@,\
125 backoff_max: %.1f seconds@,\
126 status_forcelist: [%a]@,\
127 allowed_methods: [%a]@,\
128 respect_retry_after: %b@,\
129 jitter: %b\
130 @]@]"
131 config.max_retries
132 config.backoff_factor
133 config.backoff_max
134 Format.(pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ", ") pp_print_int) config.status_forcelist
135 Format.(pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ", ")
136 (fun ppf m -> pp_print_string ppf (Method.to_string m))) config.allowed_methods
137 config.respect_retry_after
138 config.jitter
139
140let log_retry ~attempt ~delay ~reason =
141 Log.info (fun m -> m "Retry attempt %d scheduled in %.2f seconds. Reason: %s"
142 attempt delay reason)