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; sender } -> Ping { seq = clamp_int32 seq; sender }
12 | Ping_req { seq; target; sender } ->
13 Ping_req { seq = clamp_int32 seq; target; sender }
14 | Ack { seq; responder; payload } ->
15 Ack { seq = clamp_int32 seq; responder; payload }
16 | Alive { node; incarnation } ->
17 Alive { node; incarnation = clamp_incarnation incarnation }
18 | Suspect { node; incarnation; suspector } ->
19 Suspect { node; incarnation = clamp_incarnation incarnation; suspector }
20 | Dead { node; incarnation; declarator } ->
21 Dead { node; incarnation = clamp_incarnation incarnation; declarator }
22 | User_msg _ as msg -> msg
23
24let normalize_packet packet =
25 let primary = normalize_msg packet.primary in
26 let piggyback = List.map normalize_msg packet.piggyback in
27 { packet with primary; piggyback }
28
29let test_roundtrip_msg =
30 QCheck.Test.make ~count:1000 ~name:"codec message roundtrip"
31 Generators.arb_protocol_msg (fun msg ->
32 let msg = normalize_msg msg in
33 let size = encoded_size msg + 100 in
34 let buf = Cstruct.create size in
35 let enc = Encoder.create ~buf in
36 encode_msg enc msg;
37 let encoded = Encoder.to_cstruct enc in
38 let dec = Decoder.create encoded in
39 match decode_msg dec with Ok decoded -> decoded = msg | Error _ -> false)
40
41let test_roundtrip_packet =
42 QCheck.Test.make ~count:500 ~name:"codec packet roundtrip"
43 Generators.arb_packet (fun packet ->
44 let packet = normalize_packet packet in
45 let size =
46 4 + 1 + 2
47 + String.length packet.cluster
48 + 2
49 + encoded_size packet.primary
50 + List.fold_left (fun acc m -> acc + encoded_size m) 0 packet.piggyback
51 + 100
52 in
53 let buf = Cstruct.create size in
54 match encode_packet packet ~buf with
55 | Error _ -> false
56 | Ok len -> (
57 let encoded = Cstruct.sub buf 0 len in
58 match decode_packet encoded with
59 | Ok decoded -> decoded = packet
60 | Error _ -> false))
61
62let test_encoded_size_accurate =
63 QCheck.Test.make ~count:1000 ~name:"encoded_size matches actual encoding"
64 Generators.arb_protocol_msg (fun msg ->
65 let predicted = encoded_size msg in
66 let buf = Cstruct.create (predicted + 100) in
67 let enc = Encoder.create ~buf in
68 encode_msg enc msg;
69 let actual = Encoder.pos enc in
70 predicted = actual)
71
72let make_valid_packet_buf () =
73 let node =
74 make_node_info ~id:(node_id_of_string "n1")
75 ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946))
76 ~meta:""
77 in
78 let packet =
79 {
80 cluster = "test";
81 primary = Ping { seq = 1; sender = node };
82 piggyback = [];
83 }
84 in
85 let buf = Cstruct.create 1000 in
86 match encode_packet packet ~buf with
87 | Ok len -> Cstruct.sub buf 0 len
88 | Error _ -> failwith "encode failed"
89
90let test_invalid_magic_rejected () =
91 let buf = make_valid_packet_buf () in
92 Cstruct.blit_from_string "FAIL" 0 buf 0 4;
93 match decode_packet buf with
94 | Error Invalid_magic -> ()
95 | _ -> Alcotest.fail "expected Invalid_magic error"
96
97let test_unsupported_version_rejected () =
98 let buf = make_valid_packet_buf () in
99 Cstruct.set_uint8 buf 4 0x99;
100 match decode_packet buf with
101 | Error (Unsupported_version 0x99) -> ()
102 | Error (Unsupported_version v) ->
103 Alcotest.failf "expected version 0x99 but got %d" v
104 | _ -> Alcotest.fail "expected Unsupported_version error"
105
106let test_invalid_tag_rejected () =
107 let buf = Cstruct.create 100 in
108 let enc = Encoder.create ~buf in
109 Encoder.write_bytes enc (Cstruct.of_string "SWIM");
110 Encoder.write_byte enc 1;
111 Encoder.write_string enc "default";
112 Encoder.write_int16_be enc 1;
113 Encoder.write_byte enc 0xFF;
114 let encoded = Encoder.to_cstruct enc in
115 match decode_packet encoded with
116 | Error (Invalid_tag 0xFF) -> ()
117 | Error (Invalid_tag t) -> Alcotest.failf "expected tag 0xFF but got %d" t
118 | _ -> Alcotest.fail "expected Invalid_tag error"
119
120let test_encoder_write_byte () =
121 let buf = Cstruct.create 10 in
122 let enc = Encoder.create ~buf in
123 Encoder.write_byte enc 0x42;
124 Encoder.write_byte enc 0xFF;
125 let result = Encoder.to_cstruct enc in
126 Alcotest.(check int) "length" 2 (Cstruct.length result);
127 Alcotest.(check int) "byte 0" 0x42 (Cstruct.get_uint8 result 0);
128 Alcotest.(check int) "byte 1" 0xFF (Cstruct.get_uint8 result 1)
129
130let test_encoder_write_int16_be () =
131 let buf = Cstruct.create 10 in
132 let enc = Encoder.create ~buf in
133 Encoder.write_int16_be enc 0x1234;
134 let result = Encoder.to_cstruct enc in
135 Alcotest.(check int) "length" 2 (Cstruct.length result);
136 Alcotest.(check int) "value" 0x1234 (Cstruct.BE.get_uint16 result 0)
137
138let test_encoder_write_int32_be () =
139 let buf = Cstruct.create 10 in
140 let enc = Encoder.create ~buf in
141 Encoder.write_int32_be enc 0x12345678l;
142 let result = Encoder.to_cstruct enc in
143 Alcotest.(check int) "length" 4 (Cstruct.length result);
144 Alcotest.(check int32) "value" 0x12345678l (Cstruct.BE.get_uint32 result 0)
145
146let test_encoder_write_string () =
147 let buf = Cstruct.create 100 in
148 let enc = Encoder.create ~buf in
149 Encoder.write_string enc "hello";
150 let result = Encoder.to_cstruct enc in
151 Alcotest.(check int) "length" 7 (Cstruct.length result);
152 Alcotest.(check int) "str_len" 5 (Cstruct.BE.get_uint16 result 0);
153 Alcotest.(check string)
154 "content" "hello"
155 (Cstruct.to_string ~off:2 ~len:5 result)
156
157let test_encoder_write_empty_string () =
158 let buf = Cstruct.create 10 in
159 let enc = Encoder.create ~buf in
160 Encoder.write_string enc "";
161 let result = Encoder.to_cstruct enc in
162 Alcotest.(check int) "length" 2 (Cstruct.length result);
163 Alcotest.(check int) "str_len" 0 (Cstruct.BE.get_uint16 result 0)
164
165let test_decoder_read_byte () =
166 let buf = Cstruct.of_string "\x42\xFF" in
167 let dec = Decoder.create buf in
168 Alcotest.(check int) "byte 0" 0x42 (Decoder.read_byte dec);
169 Alcotest.(check int) "byte 1" 0xFF (Decoder.read_byte dec)
170
171let test_decoder_read_int16_be () =
172 let buf = Cstruct.create 2 in
173 Cstruct.BE.set_uint16 buf 0 0x1234;
174 let dec = Decoder.create buf in
175 Alcotest.(check int) "value" 0x1234 (Decoder.read_int16_be dec)
176
177let test_decoder_read_int32_be () =
178 let buf = Cstruct.create 4 in
179 Cstruct.BE.set_uint32 buf 0 0x12345678l;
180 let dec = Decoder.create buf in
181 Alcotest.(check int32) "value" 0x12345678l (Decoder.read_int32_be dec)
182
183let test_decoder_read_string () =
184 let buf = Cstruct.create 10 in
185 Cstruct.BE.set_uint16 buf 0 5;
186 Cstruct.blit_from_string "hello" 0 buf 2 5;
187 let dec = Decoder.create buf in
188 Alcotest.(check string) "value" "hello" (Decoder.read_string dec)
189
190let test_decoder_remaining () =
191 let buf = Cstruct.create 10 in
192 let dec = Decoder.create buf in
193 Alcotest.(check int) "initial" 10 (Decoder.remaining dec);
194 let _ = Decoder.read_byte dec in
195 Alcotest.(check int) "after byte" 9 (Decoder.remaining dec);
196 let _ = Decoder.read_int32_be dec in
197 Alcotest.(check int) "after int32" 5 (Decoder.remaining dec)
198
199let test_decoder_is_empty () =
200 let buf = Cstruct.create 1 in
201 let dec = Decoder.create buf in
202 Alcotest.(check bool) "not empty" false (Decoder.is_empty dec);
203 let _ = Decoder.read_byte dec in
204 Alcotest.(check bool) "empty" true (Decoder.is_empty dec)
205
206let test_empty_piggyback () =
207 let node =
208 make_node_info
209 ~id:(node_id_of_string "node1")
210 ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946))
211 ~meta:""
212 in
213 let packet =
214 {
215 cluster = "test";
216 primary = Ping { seq = 1; sender = node };
217 piggyback = [];
218 }
219 in
220 let buf = Cstruct.create 1000 in
221 match encode_packet packet ~buf with
222 | Error _ -> Alcotest.fail "encode failed"
223 | Ok len -> (
224 let encoded = Cstruct.sub buf 0 len in
225 match decode_packet encoded with
226 | Ok decoded ->
227 Alcotest.(check int)
228 "piggyback count" 0
229 (List.length decoded.piggyback)
230 | Error e -> Alcotest.failf "decode failed: %s" (decode_error_to_string e)
231 )
232
233let test_multiple_piggyback () =
234 let node =
235 make_node_info
236 ~id:(node_id_of_string "node1")
237 ~addr:(`Udp (Eio.Net.Ipaddr.of_raw "\127\000\000\001", 7946))
238 ~meta:""
239 in
240 let alive_state : member_state = Alive in
241 let _ = alive_state in
242 let piggyback =
243 [
244 Alive { node; incarnation = incarnation_of_int 1 };
245 Suspect
246 {
247 node = node_id_of_string "node2";
248 incarnation = incarnation_of_int 2;
249 suspector = node_id_of_string "node1";
250 };
251 Dead
252 {
253 node = node_id_of_string "node3";
254 incarnation = incarnation_of_int 3;
255 declarator = node_id_of_string "node1";
256 };
257 ]
258 in
259 let packet =
260 { cluster = "test"; primary = Ping { seq = 1; sender = node }; piggyback }
261 in
262 let buf = Cstruct.create 2000 in
263 match encode_packet packet ~buf with
264 | Error _ -> Alcotest.fail "encode failed"
265 | Ok len -> (
266 let encoded = Cstruct.sub buf 0 len in
267 match decode_packet encoded with
268 | Ok decoded ->
269 Alcotest.(check int)
270 "piggyback count" 3
271 (List.length decoded.piggyback)
272 | Error e -> Alcotest.failf "decode failed: %s" (decode_error_to_string e)
273 )
274
275let qcheck_tests =
276 List.map QCheck_alcotest.to_alcotest
277 [ test_roundtrip_msg; test_roundtrip_packet; test_encoded_size_accurate ]
278
279let unit_tests =
280 [
281 ("invalid_magic_rejected", `Quick, test_invalid_magic_rejected);
282 ("unsupported_version_rejected", `Quick, test_unsupported_version_rejected);
283 ("invalid_tag_rejected", `Quick, test_invalid_tag_rejected);
284 ("encoder_write_byte", `Quick, test_encoder_write_byte);
285 ("encoder_write_int16_be", `Quick, test_encoder_write_int16_be);
286 ("encoder_write_int32_be", `Quick, test_encoder_write_int32_be);
287 ("encoder_write_string", `Quick, test_encoder_write_string);
288 ("encoder_write_empty_string", `Quick, test_encoder_write_empty_string);
289 ("decoder_read_byte", `Quick, test_decoder_read_byte);
290 ("decoder_read_int16_be", `Quick, test_decoder_read_int16_be);
291 ("decoder_read_int32_be", `Quick, test_decoder_read_int32_be);
292 ("decoder_read_string", `Quick, test_decoder_read_string);
293 ("decoder_remaining", `Quick, test_decoder_remaining);
294 ("decoder_is_empty", `Quick, test_decoder_is_empty);
295 ("empty_piggyback", `Quick, test_empty_piggyback);
296 ("multiple_piggyback", `Quick, test_multiple_piggyback);
297 ]
298
299let () =
300 Alcotest.run "codec" [ ("property", qcheck_tests); ("unit", unit_tests) ]