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
6(** HomeKit Accessory Protocol (HAP).
7
8 This module implements the HAP protocol for controlling HomeKit accessories:
9 - Discovery via mDNS ({!discover})
10 - Pair Setup using SRP-6a ({!pair_setup})
11 - Pair Verify using Curve25519 ({!pair_verify})
12 - Encrypted sessions using ChaCha20-Poly1305
13
14 {2 Protocol Overview}
15
16 1. {b Discovery}: Find HomeKit accessories via mDNS (_hap._tcp.local) 2.
17 {b Pair Setup}: One-time pairing using the accessory's PIN code 3.
18 {b Pair Verify}: Establish encrypted session using stored pairing 4.
19 {b Control}: Read/write characteristics over encrypted session
20
21 {2 References}
22 - {{:https://developer.apple.com/homekit/} Apple HomeKit}
23 - HAP Non-Commercial Specification *)
24
25(** {1 Types} *)
26
27type pairing = {
28 accessory_id : string; (** Accessory device ID *)
29 accessory_ltpk : string; (** Accessory long-term public key (Ed25519) *)
30 controller_id : string; (** Controller identifier *)
31 controller_ltsk : string; (** Controller long-term secret key (Ed25519) *)
32 controller_ltpk : string; (** Controller long-term public key (Ed25519) *)
33}
34(** Controller pairing data. Stored after successful pair setup. *)
35
36type accessory_info = {
37 name : string; (** Display name *)
38 device_id : string; (** HAP device ID (MAC address format) *)
39 ip : string; (** IPv4 address *)
40 port : int; (** TCP port *)
41 model : string option; (** Model identifier *)
42 config_num : int; (** Configuration number *)
43 state_num : int; (** State number *)
44 category : int; (** HAP category code *)
45 paired : bool; (** Whether accessory is paired *)
46}
47(** Accessory info from mDNS discovery. *)
48
49type session
50(** Encrypted HAP session. *)
51
52(** {1 Discovery} *)
53
54val discover :
55 sw:Eio.Switch.t ->
56 net:_ Eio.Net.t ->
57 clock:_ Eio.Time.clock ->
58 ?timeout:float ->
59 unit ->
60 accessory_info list
61(** [discover ~sw ~net ~clock ?timeout ()] finds HomeKit accessories on the
62 local network using mDNS. Default timeout is 3 seconds. *)
63
64val accessory_info :
65 sw:Eio.Switch.t ->
66 net:_ Eio.Net.t ->
67 clock:_ Eio.Time.clock ->
68 string ->
69 accessory_info option
70(** [accessory_info ~sw ~net ~clock ip] returns info for a specific IP. *)
71
72val category_name : int -> string
73(** [category_name code] returns the human-readable name for a HAP category. *)
74
75val pp_accessory_info : accessory_info Fmt.t
76(** Pretty-printer for accessory info. *)
77
78(** {1 Pairing} *)
79
80val pair_setup :
81 net:_ Eio.Net.t ->
82 sw:Eio.Switch.t ->
83 clock:_ Eio.Time.clock ->
84 ip:string ->
85 port:int ->
86 pin:string ->
87 (pairing, [ `Msg of string ]) result
88(** [pair_setup ~net ~sw ~clock ~ip ~port ~pin] performs HAP pair setup with an
89 accessory using its PIN code. The PIN is typically in the format
90 "XXX-XX-XXX".
91
92 This is a one-time operation. Save the resulting {!pairing} for future
93 connections. *)
94
95val pair_verify :
96 net:_ Eio.Net.t ->
97 sw:Eio.Switch.t ->
98 clock:_ Eio.Time.clock ->
99 ip:string ->
100 port:int ->
101 pairing:pairing ->
102 (session, [ `Msg of string ]) result
103(** [pair_verify ~net ~sw ~clock ~ip ~port ~pairing] establishes an encrypted
104 session with a previously paired accessory. *)
105
106(** {1 Pairing Storage} *)
107
108val save_pairing_by_id : fs:_ Eio.Path.t -> pairing -> string
109(** [save_pairing_by_id ~fs pairing] saves the pairing to disk. Returns the file
110 path. Pairings are stored in [~/.hap/pairings/]. *)
111
112val 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
115val pairing_for_ip :
116 sw:Eio.Switch.t ->
117 net:_ Eio.Net.t ->
118 clock:_ Eio.Time.clock ->
119 fs:_ Eio.Path.t ->
120 string ->
121 pairing option
122(** [pairing_for_ip ~sw ~net ~clock ~fs ip] discovers the device at [ip] and
123 returns its pairing if one exists. *)
124
125(** {1 Session Operations} *)
126
127val accessories :
128 net:_ Eio.Net.t ->
129 sw:Eio.Switch.t ->
130 session ->
131 (Jsont.json, [ `Msg of string ]) result
132(** [accessories ~net ~sw session] returns the accessory database. *)
133
134val characteristics :
135 net:_ Eio.Net.t ->
136 sw:Eio.Switch.t ->
137 session ->
138 ids:(int * int) list ->
139 (Jsont.json, [ `Msg of string ]) result
140(** [characteristics ~net ~sw session ~ids] reads characteristics. Each ID is
141 [(aid, iid)]. *)
142
143val put_characteristic :
144 net:_ Eio.Net.t ->
145 sw:Eio.Switch.t ->
146 session ->
147 aid:int ->
148 iid:int ->
149 Jsont.json ->
150 (unit, [ `Msg of string ]) result
151(** [put_characteristic ~net ~sw session ~aid ~iid value] writes a
152 characteristic value. *)
153
154(** {1 High-level Control} *)
155
156val turn_on_outlet :
157 net:_ Eio.Net.t ->
158 sw:Eio.Switch.t ->
159 clock:_ Eio.Time.clock ->
160 fs:_ Eio.Path.t ->
161 string ->
162 (unit, [ `Msg of string ]) result
163(** [turn_on_outlet ~net ~sw ~clock ~fs ip] turns on an outlet at [ip]. Requires
164 existing pairing. *)
165
166val turn_off_outlet :
167 net:_ Eio.Net.t ->
168 sw:Eio.Switch.t ->
169 clock:_ Eio.Time.clock ->
170 fs:_ Eio.Path.t ->
171 string ->
172 (unit, [ `Msg of string ]) result
173(** [turn_off_outlet ~net ~sw ~clock ~fs ip] turns off an outlet at [ip]. *)
174
175val toggle_outlet :
176 net:_ Eio.Net.t ->
177 sw:Eio.Switch.t ->
178 clock:_ Eio.Time.clock ->
179 fs:_ Eio.Path.t ->
180 string ->
181 (unit, [ `Msg of string ]) result
182(** [toggle_outlet ~net ~sw ~clock ~fs ip] toggles an outlet at [ip]. *)
183
184(** {1 TLV Encoding} *)
185
186(** HAP uses TLV8 encoding for pair setup/verify messages. *)
187module Tlv : sig
188 type t = (int * string) list
189
190 val empty : t
191 (** The empty TLV container. *)
192
193 val add : int -> string -> t -> t
194 (** [add typ value t] adds a TLV entry with the given type and value. *)
195
196 val get : int -> t -> string option
197 (** [get typ t] returns the value for [typ], or [None] if absent. *)
198
199 val get_exn : int -> t -> string
200 (** [get_exn typ t] returns the value for [typ]. Raises [Failure] if absent.
201 *)
202
203 val encode : t -> string
204 (** [encode t] serializes the TLV container to bytes. Values exceeding 255
205 bytes are automatically chunked. *)
206
207 val decode : string -> t
208 (** [decode s] deserializes bytes into a TLV container. Consecutive same-type
209 chunks are concatenated. Truncated input is handled gracefully by
210 returning entries parsed so far. *)
211end
212
213(** TLV type codes. *)
214module Tlv_type : sig
215 val method_ : int
216 (** Pairing method (0x00). *)
217
218 val identifier : int
219 (** Identifier (0x01). *)
220
221 val salt : int
222 (** SRP salt (0x02). *)
223
224 val public_key : int
225 (** SRP or Ed25519 public key (0x03). *)
226
227 val proof : int
228 (** SRP proof (0x04). *)
229
230 val encrypted_data : int
231 (** Encrypted data with auth tag (0x05). *)
232
233 val state : int
234 (** Pair setup/verify state (0x06). *)
235
236 val error : int
237 (** Error code (0x07). *)
238
239 val retry_delay : int
240 (** Retry delay in seconds (0x08). *)
241
242 val certificate : int
243 (** X.509 certificate (0x09). *)
244
245 val signature : int
246 (** Ed25519 signature (0x0A). *)
247
248 val permissions : int
249 (** Pairing permissions (0x0B). *)
250
251 val fragment_data : int
252 (** Fragment data (0x0C). *)
253
254 val fragment_last : int
255 (** Last fragment (0x0D). *)
256
257 val separator : int
258 (** Separator between TLV items (0xFF). *)
259end
260
261(** HAP error codes. *)
262module Hap_error : sig
263 val unknown : int
264 (** Unknown error (0x01). *)
265
266 val authentication : int
267 (** Authentication failed (0x02). *)
268
269 val backoff : int
270 (** Too many attempts, client must back off (0x03). *)
271
272 val max_peers : int
273 (** Maximum number of peers reached (0x04). *)
274
275 val max_tries : int
276 (** Maximum authentication attempts reached (0x05). *)
277
278 val unavailable : int
279 (** Accessory is not available for pairing (0x06). *)
280
281 val busy : int
282 (** Accessory is busy with another pairing (0x07). *)
283end