Exponential backoff retry logic
Squashed 'ocaml-retry/' content from commit f41bea95 git-subtree-split: f41bea95a011e24c409111e2c71d11465937ddb0
+1017
+8
.gitignore
+8
.gitignore
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.28.1
+25
dune-project
+25
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name retry)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
(homepage "https://github.com/samoht/ocaml-retry")
11
+
(bug_reports "https://github.com/samoht/ocaml-retry/issues")
12
+
13
+
(package
14
+
(name retry)
15
+
(synopsis "Generic retry logic with exponential backoff")
16
+
(description
17
+
"Provides configurable retry logic with exponential backoff, jitter, and
18
+
customizable predicates for determining when to retry operations.")
19
+
(depends
20
+
(ocaml (>= 5.1))
21
+
(eio (>= 1.0))
22
+
(logs (>= 0.7))
23
+
(alcotest :with-test)
24
+
(eio_main :with-test)
25
+
(odoc :with-doc)))
+92
lib/retry.ml
+92
lib/retry.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let log_src = Logs.Src.create "retry"
7
+
8
+
module Log = (val Logs.src_log log_src : Logs.LOG)
9
+
10
+
type config = {
11
+
max_retries : int;
12
+
backoff_factor : float;
13
+
backoff_max : float;
14
+
jitter : bool;
15
+
}
16
+
17
+
let default_config =
18
+
{ max_retries = 3; backoff_factor = 0.3; backoff_max = 120.0; jitter = true }
19
+
20
+
let create_config ?(max_retries = 3) ?(backoff_factor = 0.3)
21
+
?(backoff_max = 120.0) ?(jitter = true) () =
22
+
Log.debug (fun m ->
23
+
m "Creating retry config: max_retries=%d backoff_factor=%.2f jitter=%b"
24
+
max_retries backoff_factor jitter);
25
+
{ max_retries; backoff_factor; backoff_max; jitter }
26
+
27
+
let calculate_backoff ~config ~attempt =
28
+
let base_delay = config.backoff_factor *. (2.0 ** float_of_int attempt) in
29
+
let delay =
30
+
if config.jitter then base_delay +. Random.float base_delay else base_delay
31
+
in
32
+
let final_delay = min delay config.backoff_max in
33
+
Log.debug (fun m ->
34
+
m "Backoff: attempt=%d base=%.2f jitter=%b -> %.2fs" attempt base_delay
35
+
config.jitter final_delay);
36
+
final_delay
37
+
38
+
let with_retry ~clock ~config ~should_retry f =
39
+
let rec attempt n =
40
+
Log.info (fun m -> m "Attempt %d/%d" n (config.max_retries + 1));
41
+
match f () with
42
+
| result ->
43
+
if n > 1 then Log.info (fun m -> m "Succeeded after %d attempts" n);
44
+
result
45
+
| exception exn when n <= config.max_retries && should_retry exn ->
46
+
let delay = calculate_backoff ~config ~attempt:n in
47
+
Log.warn (fun m ->
48
+
m "Attempt %d/%d failed: %s. Retrying in %.2fs..." n
49
+
(config.max_retries + 1) (Printexc.to_string exn) delay);
50
+
Eio.Time.sleep clock delay;
51
+
attempt (n + 1)
52
+
| exception exn ->
53
+
if n > config.max_retries then
54
+
Log.err (fun m ->
55
+
m "Failed after %d attempts: %s" n (Printexc.to_string exn))
56
+
else
57
+
Log.err (fun m ->
58
+
m "Failed and won't retry: %s" (Printexc.to_string exn));
59
+
raise exn
60
+
in
61
+
attempt 1
62
+
63
+
let with_retry_result ~clock ~config ~should_retry f =
64
+
let rec attempt n =
65
+
Log.info (fun m -> m "Attempt %d/%d" n (config.max_retries + 1));
66
+
match f () with
67
+
| Ok _ as result ->
68
+
if n > 1 then Log.info (fun m -> m "Succeeded after %d attempts" n);
69
+
result
70
+
| Error e when n <= config.max_retries && should_retry e ->
71
+
let delay = calculate_backoff ~config ~attempt:n in
72
+
Log.warn (fun m ->
73
+
m "Attempt %d/%d returned error. Retrying in %.2fs..." n
74
+
(config.max_retries + 1) delay);
75
+
Eio.Time.sleep clock delay;
76
+
attempt (n + 1)
77
+
| Error _ as result ->
78
+
if n > config.max_retries then
79
+
Log.err (fun m -> m "Failed after %d attempts" n)
80
+
else Log.err (fun m -> m "Failed and won't retry");
81
+
result
82
+
in
83
+
attempt 1
84
+
85
+
let pp_config ppf config =
86
+
Format.fprintf ppf
87
+
"@[<v>Retry Config:@,\
88
+
@[<v 2>max_retries: %d@,\
89
+
backoff_factor: %.2f@,\
90
+
backoff_max: %.1fs@,\
91
+
jitter: %b@]@]"
92
+
config.max_retries config.backoff_factor config.backoff_max config.jitter
+66
lib/retry.mli
+66
lib/retry.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Generic retry logic with exponential backoff.
7
+
8
+
Provides configurable retry behavior for operations that may fail
9
+
transiently.
10
+
11
+
{1 Example}
12
+
{[
13
+
let config = Retry.create_config ~max_retries:5 () in
14
+
let should_retry = function
15
+
| Eio.Net.Connection_refused _ -> true
16
+
| _ -> false
17
+
in
18
+
Retry.with_retry ~clock ~config ~should_retry (fun () ->
19
+
connect_to_server ())
20
+
]} *)
21
+
22
+
type config = {
23
+
max_retries : int; (** Maximum number of retries (default: 3) *)
24
+
backoff_factor : float;
25
+
(** Base delay multiplier in seconds (default: 0.3) *)
26
+
backoff_max : float; (** Maximum delay in seconds (default: 120.0) *)
27
+
jitter : bool; (** Add random jitter to delays (default: true) *)
28
+
}
29
+
30
+
val default_config : config
31
+
(** Default configuration with 3 retries, 0.3s backoff factor, 120s max. *)
32
+
33
+
val create_config :
34
+
?max_retries:int ->
35
+
?backoff_factor:float ->
36
+
?backoff_max:float ->
37
+
?jitter:bool ->
38
+
unit ->
39
+
config
40
+
(** Create a custom retry configuration. *)
41
+
42
+
val calculate_backoff : config:config -> attempt:int -> float
43
+
(** [calculate_backoff ~config ~attempt] returns the delay in seconds for the
44
+
given attempt number. Uses exponential backoff with optional jitter. *)
45
+
46
+
val with_retry :
47
+
clock:_ Eio.Time.clock ->
48
+
config:config ->
49
+
should_retry:(exn -> bool) ->
50
+
(unit -> 'a) ->
51
+
'a
52
+
(** [with_retry ~clock ~config ~should_retry f] executes [f] and retries on
53
+
exception if [should_retry exn] returns true, up to [max_retries] times. *)
54
+
55
+
val with_retry_result :
56
+
clock:_ Eio.Time.clock ->
57
+
config:config ->
58
+
should_retry:('e -> bool) ->
59
+
(unit -> ('a, 'e) result) ->
60
+
('a, 'e) result
61
+
(** [with_retry_result ~clock ~config ~should_retry f] is like {!with_retry} but
62
+
for functions returning [result]. Retries when [should_retry error] is true.
63
+
*)
64
+
65
+
val pp_config : Format.formatter -> config -> unit
66
+
(** Pretty-printer for configuration. *)
+34
retry.opam
+34
retry.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Generic retry logic with exponential backoff"
4
+
description: """
5
+
Provides configurable retry logic with exponential backoff, jitter, and
6
+
customizable predicates for determining when to retry operations."""
7
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
9
+
license: "MIT"
10
+
homepage: "https://github.com/samoht/ocaml-retry"
11
+
bug-reports: "https://github.com/samoht/ocaml-retry/issues"
12
+
depends: [
13
+
"dune" {>= "3.0"}
14
+
"ocaml" {>= "5.1"}
15
+
"eio" {>= "1.0"}
16
+
"logs" {>= "0.7"}
17
+
"alcotest" {with-test}
18
+
"eio_main" {with-test}
19
+
"odoc" {with-doc}
20
+
]
21
+
build: [
22
+
["dune" "subst"] {dev}
23
+
[
24
+
"dune"
25
+
"build"
26
+
"-p"
27
+
name
28
+
"-j"
29
+
jobs
30
+
"@install"
31
+
"@runtest" {with-test}
32
+
"@doc" {with-doc}
33
+
]
34
+
]
+784
test/test.ml
+784
test/test.ml
···
1
+
(* Config tests *)
2
+
3
+
let test_default_config () =
4
+
let config = Retry.default_config in
5
+
Alcotest.(check int) "max_retries" 3 config.max_retries;
6
+
Alcotest.(check (float 0.01)) "backoff_factor" 0.3 config.backoff_factor;
7
+
Alcotest.(check (float 0.01)) "backoff_max" 120.0 config.backoff_max;
8
+
Alcotest.(check bool) "jitter" true config.jitter
9
+
10
+
let test_create_config_defaults () =
11
+
let config = Retry.create_config () in
12
+
Alcotest.(check int) "max_retries" 3 config.max_retries;
13
+
Alcotest.(check (float 0.01)) "backoff_factor" 0.3 config.backoff_factor;
14
+
Alcotest.(check (float 0.01)) "backoff_max" 120.0 config.backoff_max;
15
+
Alcotest.(check bool) "jitter" true config.jitter
16
+
17
+
let test_create_config_custom () =
18
+
let config =
19
+
Retry.create_config ~max_retries:10 ~backoff_factor:1.0 ~backoff_max:60.0
20
+
~jitter:false ()
21
+
in
22
+
Alcotest.(check int) "max_retries" 10 config.max_retries;
23
+
Alcotest.(check (float 0.01)) "backoff_factor" 1.0 config.backoff_factor;
24
+
Alcotest.(check (float 0.01)) "backoff_max" 60.0 config.backoff_max;
25
+
Alcotest.(check bool) "jitter" false config.jitter
26
+
27
+
let test_create_config_partial () =
28
+
let config = Retry.create_config ~max_retries:5 ~jitter:false () in
29
+
Alcotest.(check int) "max_retries" 5 config.max_retries;
30
+
Alcotest.(check (float 0.01)) "backoff_factor" 0.3 config.backoff_factor;
31
+
Alcotest.(check (float 0.01)) "backoff_max" 120.0 config.backoff_max;
32
+
Alcotest.(check bool) "jitter" false config.jitter
33
+
34
+
let test_pp_config () =
35
+
let config =
36
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.5 ~backoff_max:30.0
37
+
~jitter:true ()
38
+
in
39
+
let output = Format.asprintf "%a" Retry.pp_config config in
40
+
(* Check exact substrings using a ref flag *)
41
+
let found_max_retries = ref false in
42
+
let found_backoff_factor = ref false in
43
+
let found_jitter = ref false in
44
+
String.iter
45
+
(fun _ ->
46
+
if String.length output >= 12 && String.sub output 0 12 = "Retry Config"
47
+
then found_max_retries := true)
48
+
output;
49
+
(* Just verify output is formatted correctly by checking length *)
50
+
Alcotest.(check bool) "non-empty output" true (String.length output > 20);
51
+
(* Check for expected patterns in the output *)
52
+
let re_max = Re.(compile (str "max_retries: 5")) in
53
+
let re_backoff = Re.(compile (str "backoff_factor: 0.50")) in
54
+
let re_jitter = Re.(compile (str "jitter: true")) in
55
+
found_max_retries := Re.execp re_max output;
56
+
found_backoff_factor := Re.execp re_backoff output;
57
+
found_jitter := Re.execp re_jitter output;
58
+
Alcotest.(check bool) "contains max_retries: 5" true !found_max_retries;
59
+
Alcotest.(check bool) "contains backoff_factor" true !found_backoff_factor;
60
+
Alcotest.(check bool) "contains jitter: true" true !found_jitter
61
+
62
+
(* Backoff calculation tests *)
63
+
(* Based on AWS exponential backoff recommendations:
64
+
https://aws.amazon.com/blogs/architecture/exponential-backoff-and-jitter/
65
+
Formula: delay = min(cap, base * 2^attempt)
66
+
With jitter: delay = base_delay + random(0, base_delay)
67
+
*)
68
+
69
+
(* Test vectors: backoff_factor=1.0, no cap, no jitter
70
+
| attempt | expected_delay |
71
+
|---------|----------------|
72
+
| 0 | 1.0 | (1.0 * 2^0)
73
+
| 1 | 2.0 | (1.0 * 2^1)
74
+
| 2 | 4.0 | (1.0 * 2^2)
75
+
| 3 | 8.0 | (1.0 * 2^3)
76
+
| 4 | 16.0 | (1.0 * 2^4)
77
+
| 5 | 32.0 | (1.0 * 2^5)
78
+
| 10 | 1024.0 | (1.0 * 2^10)
79
+
*)
80
+
let backoff_test_vectors_no_cap =
81
+
[ (0, 1.0); (1, 2.0); (2, 4.0); (3, 8.0); (4, 16.0); (5, 32.0); (10, 1024.0) ]
82
+
83
+
let test_backoff_test_vectors () =
84
+
let config =
85
+
Retry.create_config ~backoff_factor:1.0 ~backoff_max:10000.0 ~jitter:false
86
+
()
87
+
in
88
+
List.iter
89
+
(fun (attempt, expected) ->
90
+
let delay = Retry.calculate_backoff ~config ~attempt in
91
+
Alcotest.(check (float 0.001))
92
+
(Printf.sprintf "attempt %d" attempt)
93
+
expected delay)
94
+
backoff_test_vectors_no_cap
95
+
96
+
(* Test vectors: backoff_factor=0.3 (default), cap=120.0, no jitter
97
+
| attempt | base_delay | capped_delay |
98
+
|---------|--------------|--------------|
99
+
| 1 | 0.6 | 0.6 | (0.3 * 2^1)
100
+
| 2 | 1.2 | 1.2 | (0.3 * 2^2)
101
+
| 3 | 2.4 | 2.4 | (0.3 * 2^3)
102
+
| 4 | 4.8 | 4.8 | (0.3 * 2^4)
103
+
| 5 | 9.6 | 9.6 | (0.3 * 2^5)
104
+
| 6 | 19.2 | 19.2 | (0.3 * 2^6)
105
+
| 7 | 38.4 | 38.4 | (0.3 * 2^7)
106
+
| 8 | 76.8 | 76.8 | (0.3 * 2^8)
107
+
| 9 | 153.6 | 120.0 | capped
108
+
| 10 | 307.2 | 120.0 | capped
109
+
*)
110
+
let backoff_test_vectors_default_config =
111
+
[
112
+
(1, 0.6);
113
+
(2, 1.2);
114
+
(3, 2.4);
115
+
(4, 4.8);
116
+
(5, 9.6);
117
+
(6, 19.2);
118
+
(7, 38.4);
119
+
(8, 76.8);
120
+
(9, 120.0);
121
+
(10, 120.0);
122
+
]
123
+
124
+
let test_backoff_default_config_vectors () =
125
+
let config =
126
+
Retry.create_config ~backoff_factor:0.3 ~backoff_max:120.0 ~jitter:false ()
127
+
in
128
+
List.iter
129
+
(fun (attempt, expected) ->
130
+
let delay = Retry.calculate_backoff ~config ~attempt in
131
+
Alcotest.(check (float 0.01))
132
+
(Printf.sprintf "attempt %d" attempt)
133
+
expected delay)
134
+
backoff_test_vectors_default_config
135
+
136
+
(* AWS-style backoff: base=100ms, cap=10s
137
+
| attempt | base_delay(ms) | capped_delay(ms) |
138
+
|---------|----------------|------------------|
139
+
| 1 | 200 | 200 |
140
+
| 2 | 400 | 400 |
141
+
| 3 | 800 | 800 |
142
+
| 4 | 1600 | 1600 |
143
+
| 5 | 3200 | 3200 |
144
+
| 6 | 6400 | 6400 |
145
+
| 7 | 12800 | 10000 | capped
146
+
*)
147
+
let backoff_test_vectors_aws_style =
148
+
[
149
+
(1, 0.2);
150
+
(2, 0.4);
151
+
(3, 0.8);
152
+
(4, 1.6);
153
+
(5, 3.2);
154
+
(6, 6.4);
155
+
(7, 10.0);
156
+
(8, 10.0);
157
+
]
158
+
159
+
let test_backoff_aws_style () =
160
+
let config =
161
+
Retry.create_config ~backoff_factor:0.1 ~backoff_max:10.0 ~jitter:false ()
162
+
in
163
+
List.iter
164
+
(fun (attempt, expected) ->
165
+
let delay = Retry.calculate_backoff ~config ~attempt in
166
+
Alcotest.(check (float 0.01))
167
+
(Printf.sprintf "AWS-style attempt %d" attempt)
168
+
expected delay)
169
+
backoff_test_vectors_aws_style
170
+
171
+
(* Google Cloud style: initial=1s, multiplier=2, max=32s
172
+
| attempt | delay(s) |
173
+
|---------|----------|
174
+
| 0 | 1 |
175
+
| 1 | 2 |
176
+
| 2 | 4 |
177
+
| 3 | 8 |
178
+
| 4 | 16 |
179
+
| 5 | 32 |
180
+
| 6 | 32 | capped
181
+
*)
182
+
let backoff_test_vectors_gcp_style =
183
+
[ (0, 1.0); (1, 2.0); (2, 4.0); (3, 8.0); (4, 16.0); (5, 32.0); (6, 32.0) ]
184
+
185
+
let test_backoff_gcp_style () =
186
+
let config =
187
+
Retry.create_config ~backoff_factor:1.0 ~backoff_max:32.0 ~jitter:false ()
188
+
in
189
+
List.iter
190
+
(fun (attempt, expected) ->
191
+
let delay = Retry.calculate_backoff ~config ~attempt in
192
+
Alcotest.(check (float 0.01))
193
+
(Printf.sprintf "GCP-style attempt %d" attempt)
194
+
expected delay)
195
+
backoff_test_vectors_gcp_style
196
+
197
+
let test_backoff_no_jitter () =
198
+
let config =
199
+
Retry.create_config ~backoff_factor:1.0 ~backoff_max:1000.0 ~jitter:false ()
200
+
in
201
+
(* attempt 1: 1.0 * 2^1 = 2.0 *)
202
+
let delay1 = Retry.calculate_backoff ~config ~attempt:1 in
203
+
Alcotest.(check (float 0.01)) "attempt 1" 2.0 delay1;
204
+
(* attempt 2: 1.0 * 2^2 = 4.0 *)
205
+
let delay2 = Retry.calculate_backoff ~config ~attempt:2 in
206
+
Alcotest.(check (float 0.01)) "attempt 2" 4.0 delay2;
207
+
(* attempt 3: 1.0 * 2^3 = 8.0 *)
208
+
let delay3 = Retry.calculate_backoff ~config ~attempt:3 in
209
+
Alcotest.(check (float 0.01)) "attempt 3" 8.0 delay3
210
+
211
+
let test_backoff_exponential () =
212
+
let config =
213
+
Retry.create_config ~backoff_factor:0.5 ~backoff_max:1000.0 ~jitter:false ()
214
+
in
215
+
(* attempt 1: 0.5 * 2^1 = 1.0 *)
216
+
let delay1 = Retry.calculate_backoff ~config ~attempt:1 in
217
+
Alcotest.(check (float 0.01)) "attempt 1" 1.0 delay1;
218
+
(* attempt 4: 0.5 * 2^4 = 8.0 *)
219
+
let delay4 = Retry.calculate_backoff ~config ~attempt:4 in
220
+
Alcotest.(check (float 0.01)) "attempt 4" 8.0 delay4;
221
+
(* attempt 5: 0.5 * 2^5 = 16.0 *)
222
+
let delay5 = Retry.calculate_backoff ~config ~attempt:5 in
223
+
Alcotest.(check (float 0.01)) "attempt 5" 16.0 delay5
224
+
225
+
let test_backoff_capped () =
226
+
let config =
227
+
Retry.create_config ~backoff_factor:1.0 ~backoff_max:5.0 ~jitter:false ()
228
+
in
229
+
(* attempt 1: min(2.0, 5.0) = 2.0 *)
230
+
let delay1 = Retry.calculate_backoff ~config ~attempt:1 in
231
+
Alcotest.(check (float 0.01)) "attempt 1 not capped" 2.0 delay1;
232
+
(* attempt 2: min(4.0, 5.0) = 4.0 *)
233
+
let delay2 = Retry.calculate_backoff ~config ~attempt:2 in
234
+
Alcotest.(check (float 0.01)) "attempt 2 not capped" 4.0 delay2;
235
+
(* attempt 3: min(8.0, 5.0) = 5.0 *)
236
+
let delay3 = Retry.calculate_backoff ~config ~attempt:3 in
237
+
Alcotest.(check (float 0.01)) "attempt 3 capped" 5.0 delay3;
238
+
(* attempt 10: still capped at 5.0 *)
239
+
let delay10 = Retry.calculate_backoff ~config ~attempt:10 in
240
+
Alcotest.(check (float 0.01)) "attempt 10 capped" 5.0 delay10
241
+
242
+
let test_backoff_with_jitter () =
243
+
let config =
244
+
Retry.create_config ~backoff_factor:1.0 ~backoff_max:1000.0 ~jitter:true ()
245
+
in
246
+
(* With jitter, delay is base + random(0, base), so between base and 2*base *)
247
+
(* attempt 1: base = 2.0, so delay in [2.0, 4.0) *)
248
+
let delays =
249
+
List.init 10 (fun _ -> Retry.calculate_backoff ~config ~attempt:1)
250
+
in
251
+
List.iter
252
+
(fun delay ->
253
+
Alcotest.(check bool) "delay >= 2.0" true (delay >= 2.0);
254
+
Alcotest.(check bool) "delay < 4.0" true (delay < 4.0))
255
+
delays
256
+
257
+
let test_backoff_zero_factor () =
258
+
let config =
259
+
Retry.create_config ~backoff_factor:0.0 ~backoff_max:1000.0 ~jitter:false ()
260
+
in
261
+
let delay = Retry.calculate_backoff ~config ~attempt:5 in
262
+
Alcotest.(check (float 0.01)) "zero factor gives zero delay" 0.0 delay
263
+
264
+
let test_backoff_attempt_zero () =
265
+
let config =
266
+
Retry.create_config ~backoff_factor:1.0 ~backoff_max:1000.0 ~jitter:false ()
267
+
in
268
+
(* attempt 0: 1.0 * 2^0 = 1.0 *)
269
+
let delay = Retry.calculate_backoff ~config ~attempt:0 in
270
+
Alcotest.(check (float 0.01)) "attempt 0" 1.0 delay
271
+
272
+
(* with_retry tests *)
273
+
274
+
let test_success_first_try () =
275
+
Eio_main.run @@ fun env ->
276
+
let clock = Eio.Stdenv.clock env in
277
+
let config = Retry.create_config ~max_retries:3 () in
278
+
let calls = ref 0 in
279
+
let result =
280
+
Retry.with_retry ~clock ~config
281
+
~should_retry:(fun _ -> true)
282
+
(fun () ->
283
+
incr calls;
284
+
"success")
285
+
in
286
+
Alcotest.(check string) "result" "success" result;
287
+
Alcotest.(check int) "called once" 1 !calls
288
+
289
+
let test_retry_then_success () =
290
+
Eio_main.run @@ fun env ->
291
+
let clock = Eio.Stdenv.clock env in
292
+
let config =
293
+
Retry.create_config ~max_retries:3 ~backoff_factor:0.001 ~jitter:false ()
294
+
in
295
+
let calls = ref 0 in
296
+
let result =
297
+
Retry.with_retry ~clock ~config
298
+
~should_retry:(fun _ -> true)
299
+
(fun () ->
300
+
incr calls;
301
+
if !calls < 3 then failwith "not yet";
302
+
"success")
303
+
in
304
+
Alcotest.(check string) "result" "success" result;
305
+
Alcotest.(check int) "called 3 times" 3 !calls
306
+
307
+
let test_exhaust_retries () =
308
+
Eio_main.run @@ fun env ->
309
+
let clock = Eio.Stdenv.clock env in
310
+
let config =
311
+
Retry.create_config ~max_retries:2 ~backoff_factor:0.001 ~jitter:false ()
312
+
in
313
+
let calls = ref 0 in
314
+
let raised =
315
+
try
316
+
let _ =
317
+
Retry.with_retry ~clock ~config
318
+
~should_retry:(fun _ -> true)
319
+
(fun () ->
320
+
incr calls;
321
+
failwith "always fail")
322
+
in
323
+
false
324
+
with Failure _ -> true
325
+
in
326
+
Alcotest.(check bool) "raised" true raised;
327
+
Alcotest.(check int) "called max+1 times" 3 !calls
328
+
329
+
let test_should_retry_false () =
330
+
Eio_main.run @@ fun env ->
331
+
let clock = Eio.Stdenv.clock env in
332
+
let config =
333
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
334
+
in
335
+
let calls = ref 0 in
336
+
let raised =
337
+
try
338
+
let _ =
339
+
Retry.with_retry ~clock ~config
340
+
~should_retry:(fun _ -> false)
341
+
(fun () ->
342
+
incr calls;
343
+
failwith "fail")
344
+
in
345
+
false
346
+
with Failure _ -> true
347
+
in
348
+
Alcotest.(check bool) "raised" true raised;
349
+
Alcotest.(check int) "called only once (no retry)" 1 !calls
350
+
351
+
let test_selective_retry () =
352
+
Eio_main.run @@ fun env ->
353
+
let clock = Eio.Stdenv.clock env in
354
+
let config =
355
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
356
+
in
357
+
let calls = ref 0 in
358
+
let should_retry = function
359
+
| Failure msg -> String.equal msg "transient"
360
+
| _ -> false
361
+
in
362
+
let result =
363
+
Retry.with_retry ~clock ~config ~should_retry (fun () ->
364
+
incr calls;
365
+
if !calls < 3 then failwith "transient";
366
+
"success")
367
+
in
368
+
Alcotest.(check string) "result" "success" result;
369
+
Alcotest.(check int) "called 3 times" 3 !calls
370
+
371
+
let test_selective_retry_permanent_failure () =
372
+
Eio_main.run @@ fun env ->
373
+
let clock = Eio.Stdenv.clock env in
374
+
let config =
375
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
376
+
in
377
+
let calls = ref 0 in
378
+
let should_retry = function
379
+
| Failure msg -> String.equal msg "transient"
380
+
| _ -> false
381
+
in
382
+
let raised =
383
+
try
384
+
let _ =
385
+
Retry.with_retry ~clock ~config ~should_retry (fun () ->
386
+
incr calls;
387
+
failwith "permanent")
388
+
in
389
+
false
390
+
with Failure msg -> String.equal msg "permanent"
391
+
in
392
+
Alcotest.(check bool) "raised permanent" true raised;
393
+
Alcotest.(check int) "called only once" 1 !calls
394
+
395
+
let test_zero_retries () =
396
+
Eio_main.run @@ fun env ->
397
+
let clock = Eio.Stdenv.clock env in
398
+
let config =
399
+
Retry.create_config ~max_retries:0 ~backoff_factor:0.001 ~jitter:false ()
400
+
in
401
+
let calls = ref 0 in
402
+
let raised =
403
+
try
404
+
let _ =
405
+
Retry.with_retry ~clock ~config
406
+
~should_retry:(fun _ -> true)
407
+
(fun () ->
408
+
incr calls;
409
+
failwith "fail")
410
+
in
411
+
false
412
+
with Failure _ -> true
413
+
in
414
+
Alcotest.(check bool) "raised" true raised;
415
+
Alcotest.(check int) "called only once (no retries)" 1 !calls
416
+
417
+
let test_success_on_last_attempt () =
418
+
Eio_main.run @@ fun env ->
419
+
let clock = Eio.Stdenv.clock env in
420
+
let config =
421
+
Retry.create_config ~max_retries:3 ~backoff_factor:0.001 ~jitter:false ()
422
+
in
423
+
let calls = ref 0 in
424
+
let result =
425
+
Retry.with_retry ~clock ~config
426
+
~should_retry:(fun _ -> true)
427
+
(fun () ->
428
+
incr calls;
429
+
if !calls < 4 then failwith "not yet";
430
+
"success")
431
+
in
432
+
Alcotest.(check string) "result" "success" result;
433
+
Alcotest.(check int) "called 4 times (1 + 3 retries)" 4 !calls
434
+
435
+
let test_different_exception_types () =
436
+
Eio_main.run @@ fun env ->
437
+
let clock = Eio.Stdenv.clock env in
438
+
let config =
439
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
440
+
in
441
+
let calls = ref 0 in
442
+
let should_retry = function
443
+
| Invalid_argument _ -> true
444
+
| Failure _ -> true
445
+
| Not_found -> false
446
+
| _ -> false
447
+
in
448
+
let result =
449
+
Retry.with_retry ~clock ~config ~should_retry (fun () ->
450
+
incr calls;
451
+
match !calls with
452
+
| 1 -> invalid_arg "arg1"
453
+
| 2 -> failwith "fail2"
454
+
| 3 -> invalid_arg "arg3"
455
+
| _ -> "success")
456
+
in
457
+
Alcotest.(check string) "result" "success" result;
458
+
Alcotest.(check int) "called 4 times" 4 !calls
459
+
460
+
let test_non_retryable_exception () =
461
+
Eio_main.run @@ fun env ->
462
+
let clock = Eio.Stdenv.clock env in
463
+
let config =
464
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
465
+
in
466
+
let calls = ref 0 in
467
+
let should_retry = function Failure _ -> true | _ -> false in
468
+
let raised =
469
+
try
470
+
let _ =
471
+
Retry.with_retry ~clock ~config ~should_retry (fun () ->
472
+
incr calls;
473
+
raise Not_found)
474
+
in
475
+
false
476
+
with Not_found -> true
477
+
in
478
+
Alcotest.(check bool) "raised Not_found" true raised;
479
+
Alcotest.(check int) "called only once" 1 !calls
480
+
481
+
(* with_retry_result tests *)
482
+
483
+
let test_result_success_first_try () =
484
+
Eio_main.run @@ fun env ->
485
+
let clock = Eio.Stdenv.clock env in
486
+
let config = Retry.create_config ~max_retries:3 () in
487
+
let calls = ref 0 in
488
+
let result =
489
+
Retry.with_retry_result ~clock ~config
490
+
~should_retry:(fun _ -> true)
491
+
(fun () ->
492
+
incr calls;
493
+
Ok "success")
494
+
in
495
+
Alcotest.(check (result string string)) "result" (Ok "success") result;
496
+
Alcotest.(check int) "called once" 1 !calls
497
+
498
+
let test_result_retry () =
499
+
Eio_main.run @@ fun env ->
500
+
let clock = Eio.Stdenv.clock env in
501
+
let config =
502
+
Retry.create_config ~max_retries:3 ~backoff_factor:0.001 ~jitter:false ()
503
+
in
504
+
let calls = ref 0 in
505
+
let result =
506
+
Retry.with_retry_result ~clock ~config
507
+
~should_retry:(fun _ -> true)
508
+
(fun () ->
509
+
incr calls;
510
+
if !calls < 2 then Error "not yet" else Ok "success")
511
+
in
512
+
Alcotest.(check (result string string)) "result" (Ok "success") result;
513
+
Alcotest.(check int) "called 2 times" 2 !calls
514
+
515
+
let test_result_exhaust_retries () =
516
+
Eio_main.run @@ fun env ->
517
+
let clock = Eio.Stdenv.clock env in
518
+
let config =
519
+
Retry.create_config ~max_retries:2 ~backoff_factor:0.001 ~jitter:false ()
520
+
in
521
+
let calls = ref 0 in
522
+
let result =
523
+
Retry.with_retry_result ~clock ~config
524
+
~should_retry:(fun _ -> true)
525
+
(fun () ->
526
+
incr calls;
527
+
Error "always fail")
528
+
in
529
+
Alcotest.(check (result string string)) "result" (Error "always fail") result;
530
+
Alcotest.(check int) "called max+1 times" 3 !calls
531
+
532
+
let test_result_should_retry_false () =
533
+
Eio_main.run @@ fun env ->
534
+
let clock = Eio.Stdenv.clock env in
535
+
let config =
536
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
537
+
in
538
+
let calls = ref 0 in
539
+
let result =
540
+
Retry.with_retry_result ~clock ~config
541
+
~should_retry:(fun _ -> false)
542
+
(fun () ->
543
+
incr calls;
544
+
Error "fail")
545
+
in
546
+
Alcotest.(check (result string string)) "result" (Error "fail") result;
547
+
Alcotest.(check int) "called only once" 1 !calls
548
+
549
+
let test_result_selective_retry () =
550
+
Eio_main.run @@ fun env ->
551
+
let clock = Eio.Stdenv.clock env in
552
+
let config =
553
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
554
+
in
555
+
let calls = ref 0 in
556
+
let should_retry err = String.equal err "transient" in
557
+
let result =
558
+
Retry.with_retry_result ~clock ~config ~should_retry (fun () ->
559
+
incr calls;
560
+
if !calls < 3 then Error "transient" else Ok "success")
561
+
in
562
+
Alcotest.(check (result string string)) "result" (Ok "success") result;
563
+
Alcotest.(check int) "called 3 times" 3 !calls
564
+
565
+
let test_result_permanent_error () =
566
+
Eio_main.run @@ fun env ->
567
+
let clock = Eio.Stdenv.clock env in
568
+
let config =
569
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
570
+
in
571
+
let calls = ref 0 in
572
+
let should_retry err = String.equal err "transient" in
573
+
let result =
574
+
Retry.with_retry_result ~clock ~config ~should_retry (fun () ->
575
+
incr calls;
576
+
Error "permanent")
577
+
in
578
+
Alcotest.(check (result string string)) "result" (Error "permanent") result;
579
+
Alcotest.(check int) "called only once" 1 !calls
580
+
581
+
let test_result_zero_retries () =
582
+
Eio_main.run @@ fun env ->
583
+
let clock = Eio.Stdenv.clock env in
584
+
let config =
585
+
Retry.create_config ~max_retries:0 ~backoff_factor:0.001 ~jitter:false ()
586
+
in
587
+
let calls = ref 0 in
588
+
let result =
589
+
Retry.with_retry_result ~clock ~config
590
+
~should_retry:(fun _ -> true)
591
+
(fun () ->
592
+
incr calls;
593
+
Error "fail")
594
+
in
595
+
Alcotest.(check (result string string)) "result" (Error "fail") result;
596
+
Alcotest.(check int) "called only once" 1 !calls
597
+
598
+
let test_result_success_on_last_attempt () =
599
+
Eio_main.run @@ fun env ->
600
+
let clock = Eio.Stdenv.clock env in
601
+
let config =
602
+
Retry.create_config ~max_retries:3 ~backoff_factor:0.001 ~jitter:false ()
603
+
in
604
+
let calls = ref 0 in
605
+
let result =
606
+
Retry.with_retry_result ~clock ~config
607
+
~should_retry:(fun _ -> true)
608
+
(fun () ->
609
+
incr calls;
610
+
if !calls < 4 then Error "not yet" else Ok "success")
611
+
in
612
+
Alcotest.(check (result string string)) "result" (Ok "success") result;
613
+
Alcotest.(check int) "called 4 times" 4 !calls
614
+
615
+
type error_kind = Transient | Permanent | Unknown
616
+
617
+
let error_kind_equal a b =
618
+
match (a, b) with
619
+
| Transient, Transient | Permanent, Permanent | Unknown, Unknown -> true
620
+
| _ -> false
621
+
622
+
let pp_error_kind ppf = function
623
+
| Transient -> Format.pp_print_string ppf "Transient"
624
+
| Permanent -> Format.pp_print_string ppf "Permanent"
625
+
| Unknown -> Format.pp_print_string ppf "Unknown"
626
+
627
+
let error_kind_testable = Alcotest.testable pp_error_kind error_kind_equal
628
+
629
+
let test_result_typed_errors () =
630
+
Eio_main.run @@ fun env ->
631
+
let clock = Eio.Stdenv.clock env in
632
+
let config =
633
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
634
+
in
635
+
let calls = ref 0 in
636
+
let should_retry = function
637
+
| Transient -> true
638
+
| Permanent -> false
639
+
| Unknown -> false
640
+
in
641
+
let result =
642
+
Retry.with_retry_result ~clock ~config ~should_retry (fun () ->
643
+
incr calls;
644
+
match !calls with
645
+
| 1 -> Error Transient
646
+
| 2 -> Error Transient
647
+
| 3 -> Error Transient
648
+
| _ -> Ok "success")
649
+
in
650
+
Alcotest.(check (result string error_kind_testable))
651
+
"result" (Ok "success") result;
652
+
Alcotest.(check int) "called 4 times" 4 !calls
653
+
654
+
let test_result_typed_permanent_error () =
655
+
Eio_main.run @@ fun env ->
656
+
let clock = Eio.Stdenv.clock env in
657
+
let config =
658
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
659
+
in
660
+
let calls = ref 0 in
661
+
let should_retry = function
662
+
| Transient -> true
663
+
| Permanent -> false
664
+
| Unknown -> false
665
+
in
666
+
let result =
667
+
Retry.with_retry_result ~clock ~config ~should_retry (fun () ->
668
+
incr calls;
669
+
match !calls with 1 -> Error Transient | _ -> Error Permanent)
670
+
in
671
+
Alcotest.(check (result string error_kind_testable))
672
+
"result" (Error Permanent) result;
673
+
Alcotest.(check int) "called 2 times" 2 !calls
674
+
675
+
let test_result_unknown_error () =
676
+
Eio_main.run @@ fun env ->
677
+
let clock = Eio.Stdenv.clock env in
678
+
let config =
679
+
Retry.create_config ~max_retries:5 ~backoff_factor:0.001 ~jitter:false ()
680
+
in
681
+
let calls = ref 0 in
682
+
let should_retry = function
683
+
| Transient -> true
684
+
| Permanent -> false
685
+
| Unknown -> false
686
+
in
687
+
let result =
688
+
Retry.with_retry_result ~clock ~config ~should_retry (fun () ->
689
+
incr calls;
690
+
Error Unknown)
691
+
in
692
+
Alcotest.(check (result string error_kind_testable))
693
+
"result" (Error Unknown) result;
694
+
Alcotest.(check int) "called only once" 1 !calls
695
+
696
+
(* Large retry count test *)
697
+
698
+
let test_many_retries () =
699
+
Eio_main.run @@ fun env ->
700
+
let clock = Eio.Stdenv.clock env in
701
+
let config =
702
+
Retry.create_config ~max_retries:20 ~backoff_factor:0.0001 ~jitter:false ()
703
+
in
704
+
let calls = ref 0 in
705
+
let result =
706
+
Retry.with_retry ~clock ~config
707
+
~should_retry:(fun _ -> true)
708
+
(fun () ->
709
+
incr calls;
710
+
if !calls < 15 then failwith "not yet";
711
+
"success")
712
+
in
713
+
Alcotest.(check string) "result" "success" result;
714
+
Alcotest.(check int) "called 15 times" 15 !calls
715
+
716
+
let () =
717
+
Alcotest.run "retry"
718
+
[
719
+
( "config",
720
+
[
721
+
Alcotest.test_case "default config" `Quick test_default_config;
722
+
Alcotest.test_case "create config defaults" `Quick
723
+
test_create_config_defaults;
724
+
Alcotest.test_case "create config custom" `Quick
725
+
test_create_config_custom;
726
+
Alcotest.test_case "create config partial" `Quick
727
+
test_create_config_partial;
728
+
Alcotest.test_case "pp_config" `Quick test_pp_config;
729
+
] );
730
+
( "backoff",
731
+
[
732
+
Alcotest.test_case "test vectors (no cap)" `Quick
733
+
test_backoff_test_vectors;
734
+
Alcotest.test_case "test vectors (default config)" `Quick
735
+
test_backoff_default_config_vectors;
736
+
Alcotest.test_case "AWS-style backoff" `Quick test_backoff_aws_style;
737
+
Alcotest.test_case "GCP-style backoff" `Quick test_backoff_gcp_style;
738
+
Alcotest.test_case "no jitter" `Quick test_backoff_no_jitter;
739
+
Alcotest.test_case "exponential" `Quick test_backoff_exponential;
740
+
Alcotest.test_case "capped" `Quick test_backoff_capped;
741
+
Alcotest.test_case "with jitter" `Quick test_backoff_with_jitter;
742
+
Alcotest.test_case "zero factor" `Quick test_backoff_zero_factor;
743
+
Alcotest.test_case "attempt zero" `Quick test_backoff_attempt_zero;
744
+
] );
745
+
( "with_retry",
746
+
[
747
+
Alcotest.test_case "success first try" `Quick test_success_first_try;
748
+
Alcotest.test_case "retry then success" `Quick test_retry_then_success;
749
+
Alcotest.test_case "exhaust retries" `Quick test_exhaust_retries;
750
+
Alcotest.test_case "should_retry false" `Quick test_should_retry_false;
751
+
Alcotest.test_case "selective retry" `Quick test_selective_retry;
752
+
Alcotest.test_case "selective retry permanent" `Quick
753
+
test_selective_retry_permanent_failure;
754
+
Alcotest.test_case "zero retries" `Quick test_zero_retries;
755
+
Alcotest.test_case "success on last attempt" `Quick
756
+
test_success_on_last_attempt;
757
+
Alcotest.test_case "different exception types" `Quick
758
+
test_different_exception_types;
759
+
Alcotest.test_case "non-retryable exception" `Quick
760
+
test_non_retryable_exception;
761
+
Alcotest.test_case "many retries" `Quick test_many_retries;
762
+
] );
763
+
( "with_retry_result",
764
+
[
765
+
Alcotest.test_case "success first try" `Quick
766
+
test_result_success_first_try;
767
+
Alcotest.test_case "retry" `Quick test_result_retry;
768
+
Alcotest.test_case "exhaust retries" `Quick
769
+
test_result_exhaust_retries;
770
+
Alcotest.test_case "should_retry false" `Quick
771
+
test_result_should_retry_false;
772
+
Alcotest.test_case "selective retry" `Quick
773
+
test_result_selective_retry;
774
+
Alcotest.test_case "permanent error" `Quick
775
+
test_result_permanent_error;
776
+
Alcotest.test_case "zero retries" `Quick test_result_zero_retries;
777
+
Alcotest.test_case "success on last attempt" `Quick
778
+
test_result_success_on_last_attempt;
779
+
Alcotest.test_case "typed errors" `Quick test_result_typed_errors;
780
+
Alcotest.test_case "typed permanent error" `Quick
781
+
test_result_typed_permanent_error;
782
+
Alcotest.test_case "unknown error" `Quick test_result_unknown_error;
783
+
] );
784
+
]