this repo has no description
gdiazlo.tngl.sh
1open Swim.Types
2open Swim.Protocol_pure
3
4let node1 =
5 make_node_info
6 ~id:(node_id_of_string "node1")
7 ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946))
8 ~meta:""
9
10let node2 =
11 make_node_info
12 ~id:(node_id_of_string "node2")
13 ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\002", 7946))
14 ~meta:""
15
16let node3 =
17 make_node_info
18 ~id:(node_id_of_string "node3")
19 ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\003", 7946))
20 ~meta:""
21
22let now = Mtime.Span.of_uint64_ns 0L
23let alive_state : member_state = Alive
24let suspect_state : member_state = Suspect
25let dead_state : member_state = Dead
26
27let make_member ?(state = alive_state) ?(incarnation = 0) node =
28 {
29 node;
30 state;
31 incarnation = incarnation_of_int incarnation;
32 state_change = now;
33 }
34
35let test_alive_higher_incarnation_wins () =
36 let member = make_member ~incarnation:1 node1 in
37 let msg = Alive { node = node1; incarnation = incarnation_of_int 2 } in
38 let result = handle_alive ~self:(node_id_of_string "self") member msg ~now in
39 Alcotest.(check int)
40 "incarnation" 2
41 (incarnation_to_int result.new_state.incarnation);
42 Alcotest.(check bool) "broadcast" true (List.length result.broadcasts = 1)
43
44let test_alive_lower_incarnation_ignored () =
45 let member = make_member ~incarnation:5 node1 in
46 let msg = Alive { node = node1; incarnation = incarnation_of_int 3 } in
47 let result = handle_alive ~self:(node_id_of_string "self") member msg ~now in
48 Alcotest.(check int)
49 "incarnation unchanged" 5
50 (incarnation_to_int result.new_state.incarnation);
51 Alcotest.(check bool) "no broadcast" true (List.length result.broadcasts = 0)
52
53let test_alive_same_incarnation_unsuspects () =
54 let member = make_member ~state:suspect_state ~incarnation:3 node1 in
55 let msg = Alive { node = node1; incarnation = incarnation_of_int 3 } in
56 let result = handle_alive ~self:(node_id_of_string "self") member msg ~now in
57 Alcotest.(check string)
58 "state alive" "alive"
59 (member_state_to_string result.new_state.state)
60
61let test_alive_revives_dead_node () =
62 let member = make_member ~state:dead_state ~incarnation:1 node1 in
63 let msg = Alive { node = node1; incarnation = incarnation_of_int 5 } in
64 let result = handle_alive ~self:(node_id_of_string "self") member msg ~now in
65 Alcotest.(check string)
66 "state alive" "alive"
67 (member_state_to_string result.new_state.state);
68 match result.events with
69 | [ Join _ ] -> ()
70 | _ -> Alcotest.fail "expected Join event"
71
72let test_suspect_triggers_refute_for_self () =
73 let member = make_member ~incarnation:1 node1 in
74 let msg =
75 Suspect
76 {
77 node = node_id_of_string "node1";
78 incarnation = incarnation_of_int 1;
79 suspector = node_id_of_string "node2";
80 }
81 in
82 let result =
83 handle_suspect ~self:(node_id_of_string "node1") member msg ~now
84 in
85 Alcotest.(check int)
86 "incarnation incremented" 2
87 (incarnation_to_int result.new_state.incarnation);
88 match result.broadcasts with
89 | [ Alive { incarnation; _ } ] ->
90 Alcotest.(check int)
91 "refute incarnation" 2
92 (incarnation_to_int incarnation)
93 | _ -> Alcotest.fail "expected Alive refute broadcast"
94
95let test_suspect_higher_incarnation_suspects () =
96 let member = make_member ~state:alive_state ~incarnation:1 node1 in
97 let msg =
98 Suspect
99 {
100 node = node_id_of_string "node1";
101 incarnation = incarnation_of_int 2;
102 suspector = node_id_of_string "node2";
103 }
104 in
105 let result =
106 handle_suspect ~self:(node_id_of_string "self") member msg ~now
107 in
108 Alcotest.(check string)
109 "state suspect" "suspect"
110 (member_state_to_string result.new_state.state)
111
112let test_suspect_lower_incarnation_ignored () =
113 let member = make_member ~state:alive_state ~incarnation:5 node1 in
114 let msg =
115 Suspect
116 {
117 node = node_id_of_string "node1";
118 incarnation = incarnation_of_int 3;
119 suspector = node_id_of_string "node2";
120 }
121 in
122 let result =
123 handle_suspect ~self:(node_id_of_string "self") member msg ~now
124 in
125 Alcotest.(check string)
126 "state unchanged" "alive"
127 (member_state_to_string result.new_state.state);
128 Alcotest.(check bool) "no broadcast" true (List.length result.broadcasts = 0)
129
130let test_suspect_dead_node_ignored () =
131 let member = make_member ~state:dead_state ~incarnation:1 node1 in
132 let msg =
133 Suspect
134 {
135 node = node_id_of_string "node1";
136 incarnation = incarnation_of_int 5;
137 suspector = node_id_of_string "node2";
138 }
139 in
140 let result =
141 handle_suspect ~self:(node_id_of_string "self") member msg ~now
142 in
143 Alcotest.(check string)
144 "state dead" "dead"
145 (member_state_to_string result.new_state.state)
146
147let test_dead_marks_node_dead () =
148 let member = make_member ~state:alive_state ~incarnation:1 node1 in
149 let msg =
150 Dead
151 {
152 node = node_id_of_string "node1";
153 incarnation = incarnation_of_int 2;
154 declarator = node_id_of_string "node2";
155 }
156 in
157 let result = handle_dead member msg ~now in
158 Alcotest.(check string)
159 "state dead" "dead"
160 (member_state_to_string result.new_state.state);
161 match result.events with
162 | [ Leave _ ] -> ()
163 | _ -> Alcotest.fail "expected Leave event"
164
165let test_dead_already_dead_ignored () =
166 let member = make_member ~state:dead_state ~incarnation:5 node1 in
167 let msg =
168 Dead
169 {
170 node = node_id_of_string "node1";
171 incarnation = incarnation_of_int 10;
172 declarator = node_id_of_string "node2";
173 }
174 in
175 let result = handle_dead member msg ~now in
176 Alcotest.(check bool) "no events" true (List.length result.events = 0)
177
178let test_dead_lower_incarnation_ignored () =
179 let member = make_member ~state:alive_state ~incarnation:10 node1 in
180 let msg =
181 Dead
182 {
183 node = node_id_of_string "node1";
184 incarnation = incarnation_of_int 5;
185 declarator = node_id_of_string "node2";
186 }
187 in
188 let result = handle_dead member msg ~now in
189 Alcotest.(check string)
190 "state alive" "alive"
191 (member_state_to_string result.new_state.state)
192
193let test_invalidates_dead_beats_all () =
194 let dead_msg =
195 Dead
196 {
197 node = node_id_of_string "node1";
198 incarnation = incarnation_of_int 1;
199 declarator = node_id_of_string "node2";
200 }
201 in
202 let alive_msg = Alive { node = node1; incarnation = incarnation_of_int 5 } in
203 let suspect_msg =
204 Suspect
205 {
206 node = node_id_of_string "node1";
207 incarnation = incarnation_of_int 5;
208 suspector = node_id_of_string "node2";
209 }
210 in
211 Alcotest.(check bool)
212 "dead invalidates alive" true
213 (invalidates ~newer:dead_msg ~older:alive_msg);
214 Alcotest.(check bool)
215 "dead invalidates suspect" true
216 (invalidates ~newer:dead_msg ~older:suspect_msg)
217
218let test_invalidates_alive_beats_suspect_same_inc () =
219 let alive_msg = Alive { node = node1; incarnation = incarnation_of_int 5 } in
220 let suspect_msg =
221 Suspect
222 {
223 node = node_id_of_string "node1";
224 incarnation = incarnation_of_int 5;
225 suspector = node_id_of_string "node2";
226 }
227 in
228 Alcotest.(check bool)
229 "alive beats suspect" true
230 (invalidates ~newer:alive_msg ~older:suspect_msg)
231
232let test_invalidates_higher_incarnation_wins () =
233 let alive_old = Alive { node = node1; incarnation = incarnation_of_int 1 } in
234 let alive_new = Alive { node = node1; incarnation = incarnation_of_int 2 } in
235 Alcotest.(check bool)
236 "higher inc wins" true
237 (invalidates ~newer:alive_new ~older:alive_old);
238 Alcotest.(check bool)
239 "lower inc doesnt" false
240 (invalidates ~newer:alive_old ~older:alive_new)
241
242let test_invalidates_different_nodes_false () =
243 let alive1 = Alive { node = node1; incarnation = incarnation_of_int 10 } in
244 let alive2 = Alive { node = node2; incarnation = incarnation_of_int 1 } in
245 Alcotest.(check bool)
246 "different nodes" false
247 (invalidates ~newer:alive1 ~older:alive2)
248
249let test_merge_dead_local_wins () =
250 let local = make_member ~state:dead_state ~incarnation:1 node1 in
251 let remote = make_member ~state:alive_state ~incarnation:10 node1 in
252 let result = merge_member_state ~local ~remote in
253 Alcotest.(check string)
254 "local dead wins" "dead"
255 (member_state_to_string result.state)
256
257let test_merge_remote_dead_higher_inc_wins () =
258 let local = make_member ~state:alive_state ~incarnation:1 node1 in
259 let remote = make_member ~state:dead_state ~incarnation:5 node1 in
260 let result = merge_member_state ~local ~remote in
261 Alcotest.(check string)
262 "remote dead wins" "dead"
263 (member_state_to_string result.state)
264
265let test_merge_higher_incarnation_wins () =
266 let local = make_member ~state:alive_state ~incarnation:1 node1 in
267 let remote = make_member ~state:alive_state ~incarnation:5 node1 in
268 let result = merge_member_state ~local ~remote in
269 Alcotest.(check int) "higher inc" 5 (incarnation_to_int result.incarnation)
270
271let test_merge_suspect_beats_alive_higher_inc () =
272 let local = make_member ~state:alive_state ~incarnation:1 node1 in
273 let remote = make_member ~state:suspect_state ~incarnation:5 node1 in
274 let result = merge_member_state ~local ~remote in
275 Alcotest.(check string)
276 "suspect" "suspect"
277 (member_state_to_string result.state)
278
279let test_merge_alive_beats_suspect_same_or_higher_inc () =
280 let local = make_member ~state:suspect_state ~incarnation:3 node1 in
281 let remote = make_member ~state:alive_state ~incarnation:3 node1 in
282 let result = merge_member_state ~local ~remote in
283 Alcotest.(check string) "alive" "alive" (member_state_to_string result.state)
284
285let test_suspicion_timeout_increases_with_nodes () =
286 let config = default_config in
287 let t1 = suspicion_timeout config ~node_count:10 in
288 let t2 = suspicion_timeout config ~node_count:100 in
289 Alcotest.(check bool) "more nodes = longer timeout" true (t2 > t1)
290
291let test_suspicion_timeout_bounded () =
292 let config = { default_config with suspicion_max_timeout = 30.0 } in
293 let t = suspicion_timeout config ~node_count:1000000 in
294 Alcotest.(check bool) "bounded" true (t <= 30.0)
295
296let test_suspicion_timeout_zero_nodes () =
297 let config = default_config in
298 let t = suspicion_timeout config ~node_count:0 in
299 Alcotest.(check bool) "handles zero" true (t >= 0.0)
300
301let test_retransmit_limit_increases_with_nodes () =
302 let config = default_config in
303 let r1 = retransmit_limit config ~node_count:10 in
304 let r2 = retransmit_limit config ~node_count:100 in
305 Alcotest.(check bool) "more nodes = higher limit" true (r2 > r1)
306
307let test_next_probe_empty_list () =
308 let result =
309 next_probe_target ~self:(node_id_of_string "self") ~probe_index:0
310 ~members:[]
311 in
312 match result with None -> () | Some _ -> Alcotest.fail "expected None"
313
314let test_next_probe_skips_self () =
315 let self = node_id_of_string "node1" in
316 let result =
317 next_probe_target ~self ~probe_index:0 ~members:[ node1; node2 ]
318 in
319 match result with
320 | Some (target, _) ->
321 Alcotest.(check bool) "not self" false (equal_node_id target.id self)
322 | None -> Alcotest.fail "expected Some"
323
324let test_next_probe_wraps_around () =
325 let self = node_id_of_string "self" in
326 let result =
327 next_probe_target ~self ~probe_index:5 ~members:[ node1; node2 ]
328 in
329 match result with Some _ -> () | None -> Alcotest.fail "expected Some"
330
331let test_next_probe_all_self_returns_none () =
332 let self = node_id_of_string "node1" in
333 let result = next_probe_target ~self ~probe_index:0 ~members:[ node1 ] in
334 match result with
335 | None -> ()
336 | Some _ -> Alcotest.fail "expected None when only self"
337
338let test_select_indirect_targets_excludes_self_and_target () =
339 let self = node_id_of_string "node1" in
340 let exclude = node_id_of_string "node2" in
341 let result =
342 select_indirect_targets ~self ~exclude ~count:10
343 ~members:[ node1; node2; node3 ]
344 in
345 Alcotest.(check int) "only node3" 1 (List.length result);
346 Alcotest.(check bool)
347 "is node3" true
348 (equal_node_id (List.hd result).id node3.id)
349
350let test_select_indirect_targets_limits_count () =
351 let self = node_id_of_string "self" in
352 let exclude = node_id_of_string "exclude" in
353 let result =
354 select_indirect_targets ~self ~exclude ~count:1
355 ~members:[ node1; node2; node3 ]
356 in
357 Alcotest.(check int) "limited to 1" 1 (List.length result)
358
359let clamp_incarnation inc =
360 incarnation_of_int (incarnation_to_int inc land 0x7FFFFFFF)
361
362let test_merge_converges =
363 QCheck.Test.make ~count:200
364 ~name:"merge converges (applying twice yields same result)"
365 (QCheck.pair Generators.arb_member_snapshot Generators.arb_member_snapshot)
366 (fun (a, b) ->
367 let a =
368 { a with node = node1; incarnation = clamp_incarnation a.incarnation }
369 in
370 let b =
371 { b with node = node1; incarnation = clamp_incarnation b.incarnation }
372 in
373 let ab = merge_member_state ~local:a ~remote:b in
374 let ab2 = merge_member_state ~local:ab ~remote:b in
375 ab.state = ab2.state && ab.incarnation = ab2.incarnation)
376
377let test_merge_idempotent =
378 QCheck.Test.make ~count:200 ~name:"merge is idempotent"
379 Generators.arb_member_snapshot (fun a ->
380 let result = merge_member_state ~local:a ~remote:a in
381 result.state = a.state && result.incarnation = a.incarnation)
382
383let qcheck_tests =
384 List.map QCheck_alcotest.to_alcotest
385 [ test_merge_converges; test_merge_idempotent ]
386
387let unit_tests =
388 [
389 ("alive_higher_incarnation_wins", `Quick, test_alive_higher_incarnation_wins);
390 ( "alive_lower_incarnation_ignored",
391 `Quick,
392 test_alive_lower_incarnation_ignored );
393 ( "alive_same_incarnation_unsuspects",
394 `Quick,
395 test_alive_same_incarnation_unsuspects );
396 ("alive_revives_dead_node", `Quick, test_alive_revives_dead_node);
397 ( "suspect_triggers_refute_for_self",
398 `Quick,
399 test_suspect_triggers_refute_for_self );
400 ( "suspect_higher_incarnation_suspects",
401 `Quick,
402 test_suspect_higher_incarnation_suspects );
403 ( "suspect_lower_incarnation_ignored",
404 `Quick,
405 test_suspect_lower_incarnation_ignored );
406 ("suspect_dead_node_ignored", `Quick, test_suspect_dead_node_ignored);
407 ("dead_marks_node_dead", `Quick, test_dead_marks_node_dead);
408 ("dead_already_dead_ignored", `Quick, test_dead_already_dead_ignored);
409 ( "dead_lower_incarnation_ignored",
410 `Quick,
411 test_dead_lower_incarnation_ignored );
412 ("invalidates_dead_beats_all", `Quick, test_invalidates_dead_beats_all);
413 ( "invalidates_alive_beats_suspect_same_inc",
414 `Quick,
415 test_invalidates_alive_beats_suspect_same_inc );
416 ( "invalidates_higher_incarnation_wins",
417 `Quick,
418 test_invalidates_higher_incarnation_wins );
419 ( "invalidates_different_nodes_false",
420 `Quick,
421 test_invalidates_different_nodes_false );
422 ("merge_dead_local_wins", `Quick, test_merge_dead_local_wins);
423 ( "merge_remote_dead_higher_inc_wins",
424 `Quick,
425 test_merge_remote_dead_higher_inc_wins );
426 ("merge_higher_incarnation_wins", `Quick, test_merge_higher_incarnation_wins);
427 ( "merge_suspect_beats_alive_higher_inc",
428 `Quick,
429 test_merge_suspect_beats_alive_higher_inc );
430 ( "merge_alive_beats_suspect_same_or_higher_inc",
431 `Quick,
432 test_merge_alive_beats_suspect_same_or_higher_inc );
433 ( "suspicion_timeout_increases_with_nodes",
434 `Quick,
435 test_suspicion_timeout_increases_with_nodes );
436 ("suspicion_timeout_bounded", `Quick, test_suspicion_timeout_bounded);
437 ("suspicion_timeout_zero_nodes", `Quick, test_suspicion_timeout_zero_nodes);
438 ( "retransmit_limit_increases_with_nodes",
439 `Quick,
440 test_retransmit_limit_increases_with_nodes );
441 ("next_probe_empty_list", `Quick, test_next_probe_empty_list);
442 ("next_probe_skips_self", `Quick, test_next_probe_skips_self);
443 ("next_probe_wraps_around", `Quick, test_next_probe_wraps_around);
444 ( "next_probe_all_self_returns_none",
445 `Quick,
446 test_next_probe_all_self_returns_none );
447 ( "select_indirect_targets_excludes",
448 `Quick,
449 test_select_indirect_targets_excludes_self_and_target );
450 ( "select_indirect_targets_limits",
451 `Quick,
452 test_select_indirect_targets_limits_count );
453 ]
454
455let () =
456 Alcotest.run "protocol_pure"
457 [ ("property", qcheck_tests); ("unit", unit_tests) ]