gazagnaire.org
HomeKit Accessory Protocol (HAP) for OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6open Crowbar
7
8(* TLV roundtrip: encode(decode(x)) should produce valid TLV *)
9let test_tlv_decode_encode input =
10 let decoded = Hap.Tlv.decode input in
11 let _ = Hap.Tlv.encode decoded in
12 check true
13
14(* TLV encode/decode roundtrip for valid TLV *)
15let test_tlv_roundtrip typ value =
16 let tlv = Hap.Tlv.(add typ value empty) in
17 let encoded = Hap.Tlv.encode tlv in
18 let decoded = Hap.Tlv.decode encoded in
19 let retrieved = Hap.Tlv.get typ decoded in
20 check_eq ~pp:Format.pp_print_bool (retrieved = Some value) true
21
22(* Multiple TLV entries roundtrip - deduplicate types since later adds overwrite *)
23let test_tlv_multi_roundtrip entries =
24 (* Keep only the last value for each type, matching add semantics *)
25 let deduped =
26 List.fold_left
27 (fun acc (typ, value) ->
28 List.filter (fun (t, _) -> t <> typ) acc @ [ (typ, value) ])
29 [] entries
30 in
31 let tlv =
32 List.fold_left
33 (fun acc (typ, value) -> Hap.Tlv.add typ value acc)
34 Hap.Tlv.empty deduped
35 in
36 let encoded = Hap.Tlv.encode tlv in
37 let decoded = Hap.Tlv.decode encoded in
38 List.iter
39 (fun (typ, value) ->
40 let retrieved = Hap.Tlv.get typ decoded in
41 check_eq ~pp:Format.pp_print_bool (retrieved = Some value) true)
42 deduped
43
44(* Category name should never crash *)
45let test_category_name code =
46 let _ = Hap.category_name code in
47 check true
48
49let suite =
50 ( "hap",
51 [
52 test_case "TLV decode/encode no crash" [ bytes ] test_tlv_decode_encode;
53 test_case "TLV roundtrip" [ range 256; bytes ] test_tlv_roundtrip;
54 test_case "TLV multi roundtrip"
55 [ list (pair (range 256) bytes) ]
56 test_tlv_multi_roundtrip;
57 test_case "category_name no crash" [ int ] test_category_name;
58 ] )