this repo has no description
gdiazlo.tngl.sh
1open Swim.Types
2open Swim.Codec
3
4let clamp_int32 n = n land 0x7FFFFFFF
5
6let clamp_incarnation inc =
7 incarnation_of_int (clamp_int32 (incarnation_to_int inc))
8
9let normalize_msg msg =
10 match msg with
11 | Ping { seq; target; sender } ->
12 Ping { seq = clamp_int32 seq; target; sender }
13 | Ping_req { seq; target; sender } ->
14 Ping_req { seq = clamp_int32 seq; target; sender }
15 | Ack { seq; responder; payload } ->
16 Ack { seq = clamp_int32 seq; responder; payload }
17 | Alive { node; incarnation } ->
18 Alive { node; incarnation = clamp_incarnation incarnation }
19 | Suspect { node; incarnation; suspector } ->
20 Suspect { node; incarnation = clamp_incarnation incarnation; suspector }
21 | Dead { node; incarnation; declarator } ->
22 Dead { node; incarnation = clamp_incarnation incarnation; declarator }
23 | User_msg _ as msg -> msg
24
25let normalize_packet packet =
26 let primary = normalize_msg packet.primary in
27 let piggyback = List.map normalize_msg packet.piggyback in
28 { packet with primary; piggyback }
29
30let test_roundtrip_packet =
31 QCheck.Test.make ~count:500 ~name:"codec packet roundtrip"
32 Generators.arb_packet (fun packet ->
33 let packet = normalize_packet packet in
34 let size = 8192 in
35 let buf = Cstruct.create size in
36 match encode_packet packet ~buf with
37 | Error _ -> true
38 | Ok len -> (
39 let encoded = Cstruct.sub buf 0 len in
40 match decode_packet encoded with
41 | Ok decoded ->
42 List.length decoded.piggyback = List.length packet.piggyback
43 | Error _ -> true))
44
45let test_empty_piggyback () =
46 let node =
47 make_node_info
48 ~id:(node_id_of_string "node1")
49 ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946))
50 ~meta:""
51 in
52 let packet =
53 {
54 cluster = "test";
55 primary =
56 Ping { seq = 1; target = node_id_of_string "target"; sender = node };
57 piggyback = [];
58 }
59 in
60 let buf = Cstruct.create 1000 in
61 match encode_packet packet ~buf with
62 | Error _ -> Alcotest.fail "encode failed"
63 | Ok len -> (
64 let encoded = Cstruct.sub buf 0 len in
65 match decode_packet encoded with
66 | Ok decoded ->
67 Alcotest.(check int)
68 "piggyback count" 0
69 (List.length decoded.piggyback)
70 | Error e -> Alcotest.failf "decode failed: %s" (decode_error_to_string e)
71 )
72
73let test_multiple_piggyback () =
74 let node =
75 make_node_info
76 ~id:(node_id_of_string "node1")
77 ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946))
78 ~meta:""
79 in
80 let alive_state : member_state = Alive in
81 let _ = alive_state in
82 let piggyback =
83 [
84 Alive { node; incarnation = incarnation_of_int 1 };
85 Suspect
86 {
87 node = node_id_of_string "node2";
88 incarnation = incarnation_of_int 2;
89 suspector = node_id_of_string "node1";
90 };
91 Dead
92 {
93 node = node_id_of_string "node3";
94 incarnation = incarnation_of_int 3;
95 declarator = node_id_of_string "node1";
96 };
97 ]
98 in
99 let packet =
100 {
101 cluster = "test";
102 primary =
103 Ping { seq = 1; target = node_id_of_string "target"; sender = node };
104 piggyback;
105 }
106 in
107 let buf = Cstruct.create 2000 in
108 match encode_packet packet ~buf with
109 | Error _ -> Alcotest.fail "encode failed"
110 | Ok len -> (
111 let encoded = Cstruct.sub buf 0 len in
112 match decode_packet encoded with
113 | Ok decoded ->
114 Alcotest.(check int)
115 "piggyback count" 3
116 (List.length decoded.piggyback)
117 | Error e -> Alcotest.failf "decode failed: %s" (decode_error_to_string e)
118 )
119
120let test_crc_roundtrip () =
121 let data = "hello world" in
122 let with_crc = add_crc data in
123 match verify_and_strip_crc_string with_crc with
124 | Ok stripped -> Alcotest.(check string) "stripped" data stripped
125 | Error _ -> Alcotest.fail "CRC verification failed"
126
127let test_crc_corruption_detected () =
128 let data = "hello world" in
129 let with_crc = add_crc data in
130 let corrupted = Bytes.of_string with_crc in
131 Bytes.set corrupted 6 '\xFF';
132 match verify_and_strip_crc_string (Bytes.to_string corrupted) with
133 | Error Invalid_crc -> ()
134 | _ -> Alcotest.fail "expected CRC error"
135
136let test_label_roundtrip () =
137 let label = "my-label" in
138 let data = "payload data" in
139 let with_label = add_label label data in
140 match strip_label_string with_label with
141 | Ok (stripped, extracted_label) ->
142 Alcotest.(check string) "payload" data stripped;
143 Alcotest.(check string) "label" label extracted_label
144 | Error _ -> Alcotest.fail "label extraction failed"
145
146let test_empty_label () =
147 let data = "payload data" in
148 let with_label = add_label "" data in
149 Alcotest.(check string) "no change" data with_label
150
151let test_compound_msg_roundtrip () =
152 let msgs = [ "msg1"; "msg2"; "msg3" ] in
153 let compound = make_compound_msg msgs in
154 let payload = String.sub compound 1 (String.length compound - 1) in
155 match decode_compound_msg payload with
156 | Ok (decoded, trunc) ->
157 Alcotest.(check int) "no truncation" 0 trunc;
158 Alcotest.(check int) "msg count" 3 (List.length decoded);
159 Alcotest.(check string) "msg1" "msg1" (List.nth decoded 0);
160 Alcotest.(check string) "msg2" "msg2" (List.nth decoded 1);
161 Alcotest.(check string) "msg3" "msg3" (List.nth decoded 2)
162 | Error _ -> Alcotest.fail "compound decode failed"
163
164let qcheck_tests =
165 List.map QCheck_alcotest.to_alcotest [ test_roundtrip_packet ]
166
167let unit_tests =
168 [
169 ("empty_piggyback", `Quick, test_empty_piggyback);
170 ("multiple_piggyback", `Quick, test_multiple_piggyback);
171 ("crc_roundtrip", `Quick, test_crc_roundtrip);
172 ("crc_corruption_detected", `Quick, test_crc_corruption_detected);
173 ("label_roundtrip", `Quick, test_label_roundtrip);
174 ("empty_label", `Quick, test_empty_label);
175 ("compound_msg_roundtrip", `Quick, test_compound_msg_roundtrip);
176 ]
177
178let () =
179 Alcotest.run "codec" [ ("property", qcheck_tests); ("unit", unit_tests) ]