HomeKit Accessory Protocol (HAP) for OCaml
fix(lint): resolve E325, E330, E340, E300, E405 across freebox, git, hap
E325 naming convention:
- freebox: find_correlated → correlated (returns list, not option)
- git: Config.get → Config.find (returns string option)
- hap: get_accessory_info → find_accessory_info, get_bool_value → find_bool_value
E330 redundant module prefix:
- freebox: auth_result → result, wifi_config → config
- git: Diff.diff_trees → trees, diff_commits → commits,
diff_tree_to_empty → tree_to_empty, diff_empty_to_tree → empty_to_tree,
Pack_index.pack_index_magic → magic, Remote.remote_head → head,
remote_matches_local → matches_local, Worktree.worktree_name → name
- hap: hap_request → request
E340 error patterns: crow/bin/main.ml err_* helpers
E300 variant naming: conpool AllPresets → All_presets, ListPresets → List_presets
E405 missing docs: freebox, hap, git, gpt .mli files
+50
-52
+24
-25
lib/hap.ml
+24
-25
lib/hap.ml
···
550
550
end
551
551
552
552
(* Send encrypted request and read response *)
553
-
let hap_request ~net ~sw session request =
554
-
let encrypted = encrypt_frame session request in
553
+
let request ~net ~sw session req =
554
+
let encrypted = encrypt_frame session req in
555
555
let addr = `Tcp (ipv4_of_string session.ip, session.port) in
556
556
let flow = Eio.Net.connect ~sw net addr in
557
557
Eio.Flow.copy_string encrypted flow;
···
580
580
(Jsont_bytesrw.decode_string Jsont.json body)
581
581
582
582
(* Get accessories from a session *)
583
-
let get_accessories ~net ~sw session =
583
+
let accessories ~net ~sw session =
584
584
let path = "/accessories" in
585
-
let request =
585
+
let req =
586
586
Printf.sprintf "GET %s HTTP/1.1\r\nHost: %s:%d\r\n\r\n" path session.ip
587
587
session.port
588
588
in
589
-
let* decrypted = hap_request ~net ~sw session request in
589
+
let* decrypted = request ~net ~sw session req in
590
590
parse_json_response decrypted
591
591
592
592
(* Characteristic write request codec *)
···
620
620
| Error _ -> "{}"
621
621
in
622
622
let path = "/characteristics" in
623
-
let request =
623
+
let req =
624
624
Printf.sprintf
625
625
"PUT %s HTTP/1.1\r\n\
626
626
Host: %s:%d\r\n\
···
630
630
%s"
631
631
path session.ip session.port (String.length body) body
632
632
in
633
-
let* _decrypted = hap_request ~net ~sw session request in
633
+
let* _decrypted = request ~net ~sw session req in
634
634
Ok ()
635
635
636
636
(* Read characteristics *)
637
-
let get_characteristics ~net ~sw session ~ids =
637
+
let characteristics ~net ~sw session ~ids =
638
638
let ids_str =
639
639
String.concat ","
640
640
(List.map (fun (aid, iid) -> Printf.sprintf "%d.%d" aid iid) ids)
641
641
in
642
642
let path = Printf.sprintf "/characteristics?id=%s" ids_str in
643
-
let request =
643
+
let req =
644
644
Printf.sprintf "GET %s HTTP/1.1\r\nHost: %s:%d\r\n\r\n" path session.ip
645
645
session.port
646
646
in
647
-
let* decrypted = hap_request ~net ~sw session request in
647
+
let* decrypted = request ~net ~sw session req in
648
648
parse_json_response decrypted
649
649
650
650
(* Pairing storage directory *)
···
749
749
path
750
750
751
751
(* Find pairing for a device by its HAP device_id *)
752
-
let find_pairing_by_id ~fs device_id =
752
+
let pairing_by_id ~fs device_id =
753
753
let path = pairing_path_for_id device_id in
754
754
load_pairing ~fs ~path
755
755
···
872
872
instances
873
873
874
874
(* Find pairing for an IP by discovering the device first *)
875
-
let find_pairing_for_ip ~sw ~net ~clock ~fs ip =
875
+
let pairing_for_ip ~sw ~net ~clock ~fs ip =
876
876
let devices = discover ~sw ~net ~clock ~timeout:2.0 () in
877
877
match List.find_opt (fun (d : accessory_info) -> d.ip = ip) devices with
878
878
| None -> None
879
879
| Some info ->
880
-
if info.device_id = "" then None
881
-
else find_pairing_by_id ~fs info.device_id
880
+
if info.device_id = "" then None else pairing_by_id ~fs info.device_id
882
881
883
882
(* Get accessory info for an IP *)
884
-
let get_accessory_info ~sw ~net ~clock ip =
883
+
let find_accessory_info ~sw ~net ~clock ip =
885
884
let devices = discover ~sw ~net ~clock ~timeout:2.0 () in
886
885
List.find_opt (fun (d : accessory_info) -> d.ip = ip) devices
887
886
···
986
985
| Error e -> Error e)
987
986
988
987
(* Find the On characteristic IID from accessories JSON *)
989
-
let find_on_characteristic_iid json =
988
+
let on_characteristic_iid json =
990
989
match decode Hap_json.accessories_response json with
991
990
| Error _ -> None
992
991
| Ok resp ->
···
1013
1012
if info.device_id = "" then Error (`Msg "Device has no device_id")
1014
1013
else
1015
1014
(* 2. Find pairing *)
1016
-
match find_pairing_by_id ~fs info.device_id with
1015
+
match pairing_by_id ~fs info.device_id with
1017
1016
| None ->
1018
1017
Error (`Msg "No pairing found for device - run 'plug pair' first")
1019
1018
| Some pairing -> (
···
1022
1021
pair_verify ~net ~sw ~clock ~ip ~port:info.port ~pairing
1023
1022
in
1024
1023
(* 4. Get accessories to find On characteristic *)
1025
-
let* accessories_json = get_accessories ~net ~sw session in
1026
-
match find_on_characteristic_iid accessories_json with
1024
+
let* accessories_json = accessories ~net ~sw session in
1025
+
match on_characteristic_iid accessories_json with
1027
1026
| None -> Error (`Msg "Could not find On characteristic")
1028
1027
| Some (aid, iid) ->
1029
1028
(* 5. Set value *)
···
1037
1036
control_outlet ~net ~sw ~clock ~fs ~ip ~value:false
1038
1037
1039
1038
(* Extract bool value from characteristics response *)
1040
-
let get_bool_value json =
1039
+
let find_bool_value json =
1041
1040
match decode Hap_json.characteristics_response json with
1042
1041
| Error _ -> None
1043
1042
| Ok (resp : Hap_json.characteristics_response) -> (
···
1054
1053
| Some info -> (
1055
1054
if info.device_id = "" then Error (`Msg "Device has no device_id")
1056
1055
else
1057
-
match find_pairing_by_id ~fs info.device_id with
1056
+
match pairing_by_id ~fs info.device_id with
1058
1057
| None -> Error (`Msg "No pairing found for device")
1059
1058
| Some pairing -> (
1060
1059
let* session =
1061
1060
pair_verify ~net ~sw ~clock ~ip ~port:info.port ~pairing
1062
1061
in
1063
-
let* accessories_json = get_accessories ~net ~sw session in
1064
-
match find_on_characteristic_iid accessories_json with
1062
+
let* accessories_json = accessories ~net ~sw session in
1063
+
match on_characteristic_iid accessories_json with
1065
1064
| None -> Error (`Msg "Could not find On characteristic")
1066
1065
| Some (aid, iid) -> (
1067
1066
let* chars_json =
1068
-
get_characteristics ~net ~sw session ~ids:[ (aid, iid) ]
1067
+
characteristics ~net ~sw session ~ids:[ (aid, iid) ]
1069
1068
in
1070
-
match get_bool_value chars_json with
1069
+
match find_bool_value chars_json with
1071
1070
| None -> Error (`Msg "Could not read current state")
1072
1071
| Some v ->
1073
1072
put_characteristic ~net ~sw session ~aid ~iid
+12
-12
lib/hap.mli
+12
-12
lib/hap.mli
···
61
61
(** [discover ~sw ~net ~clock ?timeout ()] finds HomeKit accessories on the
62
62
local network using mDNS. Default timeout is 3 seconds. *)
63
63
64
-
val get_accessory_info :
64
+
val find_accessory_info :
65
65
sw:Eio.Switch.t ->
66
66
net:_ Eio.Net.t ->
67
67
clock:_ Eio.Time.clock ->
68
68
string ->
69
69
accessory_info option
70
-
(** [get_accessory_info ~sw ~net ~clock ip] returns info for a specific IP. *)
70
+
(** [find_accessory_info ~sw ~net ~clock ip] returns info for a specific IP. *)
71
71
72
72
val category_name : int -> string
73
73
(** [category_name code] returns the human-readable name for a HAP category. *)
···
109
109
(** [save_pairing_by_id ~fs pairing] saves the pairing to disk. Returns the file
110
110
path. Pairings are stored in [~/.hap/pairings/]. *)
111
111
112
-
val find_pairing_by_id : fs:_ Eio.Path.t -> string -> pairing option
113
-
(** [find_pairing_by_id ~fs device_id] loads a pairing for the given device. *)
112
+
val pairing_by_id : fs:_ Eio.Path.t -> string -> pairing option
113
+
(** [pairing_by_id ~fs device_id] loads a pairing for the given device. *)
114
114
115
-
val find_pairing_for_ip :
115
+
val pairing_for_ip :
116
116
sw:Eio.Switch.t ->
117
117
net:_ Eio.Net.t ->
118
118
clock:_ Eio.Time.clock ->
119
119
fs:_ Eio.Path.t ->
120
120
string ->
121
121
pairing option
122
-
(** [find_pairing_for_ip ~sw ~net ~clock ~fs ip] discovers the device at [ip]
123
-
and returns its pairing if one exists. *)
122
+
(** [pairing_for_ip ~sw ~net ~clock ~fs ip] discovers the device at [ip] and
123
+
returns its pairing if one exists. *)
124
124
125
125
(** {1 Session Operations} *)
126
126
127
-
val get_accessories :
127
+
val accessories :
128
128
net:_ Eio.Net.t ->
129
129
sw:Eio.Switch.t ->
130
130
session ->
131
131
(Jsont.json, [ `Msg of string ]) result
132
-
(** [get_accessories ~net ~sw session] returns the accessory database. *)
132
+
(** [accessories ~net ~sw session] returns the accessory database. *)
133
133
134
-
val get_characteristics :
134
+
val characteristics :
135
135
net:_ Eio.Net.t ->
136
136
sw:Eio.Switch.t ->
137
137
session ->
138
138
ids:(int * int) list ->
139
139
(Jsont.json, [ `Msg of string ]) result
140
-
(** [get_characteristics ~net ~sw session ~ids] reads characteristics. Each ID
141
-
is [(aid, iid)]. *)
140
+
(** [characteristics ~net ~sw session ~ids] reads characteristics. Each ID is
141
+
[(aid, iid)]. *)
142
142
143
143
val put_characteristic :
144
144
net:_ Eio.Net.t ->
+1
-1
test/test.ml
+1
-1
test/test.ml
+10
-14
test/test_hap.ml
+10
-14
test/test_hap.ml
···
72
72
Alcotest.(check int) "busy" 0x07 Hap.HapError.busy
73
73
74
74
let suite =
75
-
[
76
-
( "TLV",
77
-
[
78
-
Alcotest.test_case "empty" `Quick test_tlv_empty;
79
-
Alcotest.test_case "single" `Quick test_tlv_single;
80
-
Alcotest.test_case "roundtrip" `Quick test_tlv_roundtrip;
81
-
Alcotest.test_case "long value" `Quick test_tlv_long_value;
82
-
] );
83
-
("Category", [ Alcotest.test_case "names" `Quick test_category_names ]);
84
-
( "TlvType",
85
-
[ Alcotest.test_case "constants" `Quick test_tlv_type_constants ] );
86
-
( "HapError",
87
-
[ Alcotest.test_case "constants" `Quick test_hap_error_constants ] );
88
-
]
75
+
( "hap",
76
+
[
77
+
Alcotest.test_case "TLV empty" `Quick test_tlv_empty;
78
+
Alcotest.test_case "TLV single" `Quick test_tlv_single;
79
+
Alcotest.test_case "TLV roundtrip" `Quick test_tlv_roundtrip;
80
+
Alcotest.test_case "TLV long value" `Quick test_tlv_long_value;
81
+
Alcotest.test_case "category names" `Quick test_category_names;
82
+
Alcotest.test_case "TlvType constants" `Quick test_tlv_type_constants;
83
+
Alcotest.test_case "HapError constants" `Quick test_hap_error_constants;
84
+
] )