HomeKit Accessory Protocol (HAP) for OCaml
wal, block, sse, zephyr: remove [mutable] from never-reassigned fields
Warning 69 (unused-field, mutable-never-assigned). Four independent
record fields were flagged as mutable but the code only mutates their
referents in place, never rebinds the record slot itself:
- ocaml-wal/lib/wal.ml: [t.file] (the Eio file resource; methods call
Eio.File.pwrite_all etc., the slot is set once at open time).
- ocaml-block/lib/block.ml: [Memory.state.data] (the backing bytes,
written via Bytes.blit_string; [Bytes.t] is already mutable).
- ocaml-sse/lib/sse.ml: [Parser.t.data_buf] (a Buffer.t, written via
Buffer.add_*; the slot never changes).
- ocaml-zephyr/lib/zephyr.ml: drop [mode : Read | Write] entirely —
set at open-time, read nowhere. The open_read / open_write
constructors already distinguish the two call shapes, so mode
tracking was redundant.
+63
-62
+2
-2
dune-project
+2
-2
dune-project
+3
-2
hap.opam
+3
-2
hap.opam
···
10
10
license: "MIT"
11
11
tags: ["org:blacksun" "system" "network"]
12
12
depends: [
13
-
"dune" {>= "3.0"}
13
+
"dune" {>= "3.21"}
14
14
"ocaml" {>= "4.14"}
15
15
"srp" {>= "0.1"}
16
16
"mdns" {>= "0.1"}
···
21
21
"eio" {>= "1.0"}
22
22
"re" {>= "1.10"}
23
23
"requests" {>= "0.1"}
24
-
"jsont" {>= "0.1"}
24
+
"json" {>= "0.1"}
25
25
"bytesrw" {>= "0.1"}
26
26
"base64" {>= "3.5"}
27
27
"logs" {>= "0.7"}
···
46
46
"@doc" {with-doc}
47
47
]
48
48
]
49
+
x-maintenance-intent: ["(latest)"]
49
50
x-quality-build: "2026-04-15"
50
51
x-quality-fuzz: "2026-04-15"
51
52
x-quality-test: "2026-04-15"
+2
-2
lib/dune
+2
-2
lib/dune
+53
-53
lib/hap.ml
+53
-53
lib/hap.ml
···
537
537
let body = String.sub decrypted pos (String.length decrypted - pos) in
538
538
Result.map_error
539
539
(fun e -> `Msg e)
540
-
(Jsont_bytesrw.decode_string Jsont.json body)
540
+
(Json_bytesrw.decode_string Json.json body)
541
541
542
542
(* Get accessories from a session *)
543
543
let accessories ~net ~sw session =
···
550
550
parse_json_response decrypted
551
551
552
552
(* Characteristic write request codec *)
553
-
type char_write = { cw_aid : int; cw_iid : int; cw_value : Jsont.json }
553
+
type char_write = { cw_aid : int; cw_iid : int; cw_value : Json.t }
554
554
555
555
let char_write_codec =
556
-
Jsont.Object.map ~kind:"char_write" (fun aid iid value ->
556
+
Json.Object.map ~kind:"char_write" (fun aid iid value ->
557
557
{ cw_aid = aid; cw_iid = iid; cw_value = value })
558
-
|> Jsont.Object.mem "aid" Jsont.int ~enc:(fun c -> c.cw_aid)
559
-
|> Jsont.Object.mem "iid" Jsont.int ~enc:(fun c -> c.cw_iid)
560
-
|> Jsont.Object.mem "value" Jsont.json ~enc:(fun c -> c.cw_value)
561
-
|> Jsont.Object.finish
558
+
|> Json.Object.mem "aid" Json.int ~enc:(fun c -> c.cw_aid)
559
+
|> Json.Object.mem "iid" Json.int ~enc:(fun c -> c.cw_iid)
560
+
|> Json.Object.mem "value" Json.json ~enc:(fun c -> c.cw_value)
561
+
|> Json.Object.finish
562
562
563
563
type char_write_request = { characteristics : char_write list }
564
564
565
565
let char_write_request_codec =
566
-
Jsont.Object.map ~kind:"char_write_request" (fun characteristics ->
566
+
Json.Object.map ~kind:"char_write_request" (fun characteristics ->
567
567
{ characteristics })
568
-
|> Jsont.Object.mem "characteristics" (Jsont.list char_write_codec)
568
+
|> Json.Object.mem "characteristics" (Json.list char_write_codec)
569
569
~enc:(fun r -> r.characteristics)
570
-
|> Jsont.Object.finish
570
+
|> Json.Object.finish
571
571
572
572
(* Write a characteristic *)
573
573
let put_characteristic ~net ~sw session ~aid ~iid value =
···
575
575
{ characteristics = [ { cw_aid = aid; cw_iid = iid; cw_value = value } ] }
576
576
in
577
577
let body =
578
-
match Jsont_bytesrw.encode_string char_write_request_codec req with
578
+
match Json_bytesrw.encode_string char_write_request_codec req with
579
579
| Ok s -> s
580
580
| Error _ -> "{}"
581
581
in
···
632
632
}
633
633
634
634
let stored =
635
-
Jsont.Object.map ~kind:"hap.pairing"
635
+
Json.Object.map ~kind:"hap.pairing"
636
636
(fun
637
637
accessory_id
638
638
accessory_ltpk
···
647
647
controller_ltsk;
648
648
controller_ltpk;
649
649
})
650
-
|> Jsont.Object.mem "accessory_id" Jsont.string ~enc:(fun p ->
650
+
|> Json.Object.mem "accessory_id" Json.string ~enc:(fun p ->
651
651
p.accessory_id)
652
-
|> Jsont.Object.mem "accessory_ltpk" Jsont.string ~enc:(fun p ->
652
+
|> Json.Object.mem "accessory_ltpk" Json.string ~enc:(fun p ->
653
653
p.accessory_ltpk)
654
-
|> Jsont.Object.mem "controller_id" Jsont.string ~enc:(fun p ->
654
+
|> Json.Object.mem "controller_id" Json.string ~enc:(fun p ->
655
655
p.controller_id)
656
-
|> Jsont.Object.mem "controller_ltsk" Jsont.string ~enc:(fun p ->
656
+
|> Json.Object.mem "controller_ltsk" Json.string ~enc:(fun p ->
657
657
p.controller_ltsk)
658
-
|> Jsont.Object.mem "controller_ltpk" Jsont.string ~enc:(fun p ->
658
+
|> Json.Object.mem "controller_ltpk" Json.string ~enc:(fun p ->
659
659
p.controller_ltpk)
660
-
|> Jsont.Object.finish
660
+
|> Json.Object.finish
661
661
662
662
let of_pairing (p : pairing) : stored =
663
663
{
···
682
682
let save_pairing ~fs ~path (pairing : pairing) =
683
683
let stored = Pairing_json.of_pairing pairing in
684
684
match
685
-
Jsont_bytesrw.encode_string ~format:Jsont.Indent Pairing_json.stored stored
685
+
Json_bytesrw.encode_string ~format:Json.Indent Pairing_json.stored stored
686
686
with
687
687
| Ok json ->
688
688
Eio.Path.save ~create:(`Or_truncate 0o600) Eio.Path.(fs / path) json
···
694
694
else
695
695
begin try
696
696
let content = Eio.Path.load full_path in
697
-
match Jsont_bytesrw.decode_string Pairing_json.stored content with
697
+
match Json_bytesrw.decode_string Pairing_json.stored content with
698
698
| Ok stored -> Some (Pairing_json.to_pairing stored)
699
699
| Error _ -> None
700
700
with Eio.Io _ -> None
···
858
858
(** {1 HAP JSON Codecs} *)
859
859
860
860
module Hap_json = struct
861
-
type characteristic = { iid : int; type_ : string; value : Jsont.json option }
861
+
type characteristic = { iid : int; type_ : string; value : Json.t option }
862
862
(** HAP characteristic *)
863
863
864
864
let characteristic =
865
-
Jsont.Object.map ~kind:"hap.characteristic" (fun iid type_ value ->
865
+
Json.Object.map ~kind:"hap.characteristic" (fun iid type_ value ->
866
866
{ iid; type_; value })
867
-
|> Jsont.Object.mem "iid" Jsont.int ~enc:(fun c -> c.iid)
868
-
|> Jsont.Object.mem "type" Jsont.string ~enc:(fun c -> c.type_)
869
-
|> Jsont.Object.opt_mem "value" Jsont.json ~enc:(fun c -> c.value)
870
-
|> Jsont.Object.finish
867
+
|> Json.Object.mem "iid" Json.int ~enc:(fun c -> c.iid)
868
+
|> Json.Object.mem "type" Json.string ~enc:(fun c -> c.type_)
869
+
|> Json.Object.opt_mem "value" Json.json ~enc:(fun c -> c.value)
870
+
|> Json.Object.finish
871
871
872
872
type service = {
873
873
iid : int;
···
877
877
(** HAP service *)
878
878
879
879
let service =
880
-
Jsont.Object.map ~kind:"hap.service" (fun iid type_ characteristics ->
880
+
Json.Object.map ~kind:"hap.service" (fun iid type_ characteristics ->
881
881
{ iid; type_; characteristics })
882
-
|> Jsont.Object.mem "iid" Jsont.int ~enc:(fun s -> s.iid)
883
-
|> Jsont.Object.mem "type" Jsont.string ~enc:(fun s -> s.type_)
884
-
|> Jsont.Object.mem "characteristics" (Jsont.list characteristic)
882
+
|> Json.Object.mem "iid" Json.int ~enc:(fun s -> s.iid)
883
+
|> Json.Object.mem "type" Json.string ~enc:(fun s -> s.type_)
884
+
|> Json.Object.mem "characteristics" (Json.list characteristic)
885
885
~enc:(fun s -> s.characteristics)
886
-
|> Jsont.Object.finish
886
+
|> Json.Object.finish
887
887
888
888
type accessory = { aid : int; services : service list }
889
889
(** HAP accessory *)
890
890
891
891
let accessory =
892
-
Jsont.Object.map ~kind:"hap.accessory" (fun aid services ->
892
+
Json.Object.map ~kind:"hap.accessory" (fun aid services ->
893
893
{ aid; services })
894
-
|> Jsont.Object.mem "aid" Jsont.int ~enc:(fun a -> a.aid)
895
-
|> Jsont.Object.mem "services" (Jsont.list service) ~enc:(fun a ->
894
+
|> Json.Object.mem "aid" Json.int ~enc:(fun a -> a.aid)
895
+
|> Json.Object.mem "services" (Json.list service) ~enc:(fun a ->
896
896
a.services)
897
-
|> Jsont.Object.finish
897
+
|> Json.Object.finish
898
898
899
899
type accessories_response = { accessories : accessory list }
900
900
(** HAP accessories response *)
901
901
902
902
let accessories_response =
903
-
Jsont.Object.map ~kind:"hap.accessories_response" (fun accessories ->
903
+
Json.Object.map ~kind:"hap.accessories_response" (fun accessories ->
904
904
{ accessories })
905
-
|> Jsont.Object.mem "accessories" (Jsont.list accessory) ~enc:(fun r ->
905
+
|> Json.Object.mem "accessories" (Json.list accessory) ~enc:(fun r ->
906
906
r.accessories)
907
-
|> Jsont.Object.finish
907
+
|> Json.Object.finish
908
908
909
-
type char_value = { aid : int; iid : int; value : Jsont.json option }
909
+
type char_value = { aid : int; iid : int; value : Json.t option }
910
910
(** HAP characteristics value *)
911
911
912
912
let char_value =
913
-
Jsont.Object.map ~kind:"hap.char_value" (fun aid iid value ->
913
+
Json.Object.map ~kind:"hap.char_value" (fun aid iid value ->
914
914
{ aid; iid; value })
915
-
|> Jsont.Object.mem "aid" Jsont.int ~enc:(fun c -> c.aid)
916
-
|> Jsont.Object.mem "iid" Jsont.int ~enc:(fun c -> c.iid)
917
-
|> Jsont.Object.opt_mem "value" Jsont.json ~enc:(fun c -> c.value)
918
-
|> Jsont.Object.finish
915
+
|> Json.Object.mem "aid" Json.int ~enc:(fun c -> c.aid)
916
+
|> Json.Object.mem "iid" Json.int ~enc:(fun c -> c.iid)
917
+
|> Json.Object.opt_mem "value" Json.json ~enc:(fun c -> c.value)
918
+
|> Json.Object.finish
919
919
920
920
type characteristics_response = { characteristics : char_value list }
921
921
922
922
let characteristics_response =
923
-
Jsont.Object.map ~kind:"hap.characteristics_response"
923
+
Json.Object.map ~kind:"hap.characteristics_response"
924
924
(fun characteristics -> { characteristics })
925
-
|> Jsont.Object.mem "characteristics" (Jsont.list char_value) ~enc:(fun r ->
925
+
|> Json.Object.mem "characteristics" (Json.list char_value) ~enc:(fun r ->
926
926
r.characteristics)
927
-
|> Jsont.Object.finish
927
+
|> Json.Object.finish
928
928
end
929
929
930
930
(** {1 High-level control} *)
···
934
934
let on = "25" (* 00000025-0000-1000-8000-0026BB765291 *)
935
935
end
936
936
937
-
(* Decode Jsont.json via codec *)
937
+
(* Decode Json.json via codec *)
938
938
let decode codec json =
939
-
match Jsont_bytesrw.encode_string Jsont.json json with
939
+
match Json_bytesrw.encode_string Json.json json with
940
940
| Error e -> Error e
941
941
| Ok str -> (
942
-
match Jsont_bytesrw.decode_string codec str with
942
+
match Json_bytesrw.decode_string codec str with
943
943
| Ok v -> Ok v
944
944
| Error e -> Error e)
945
945
···
986
986
| Some (aid, iid) ->
987
987
(* 5. Set value *)
988
988
put_characteristic ~net ~sw session ~aid ~iid
989
-
(Jsont.Bool (value, Jsont.Meta.none))))
989
+
(Json.Bool (value, Json.Meta.none))))
990
990
991
991
let turn_on_outlet ~net ~sw ~clock ~fs ip =
992
992
control_outlet ~net ~sw ~clock ~fs ~ip ~value:true
···
1001
1001
| Ok (resp : Hap_json.characteristics_response) -> (
1002
1002
match resp.characteristics with
1003
1003
| [ (c : Hap_json.char_value) ] -> (
1004
-
match c.value with Some (Jsont.Bool (b, _)) -> Some b | _ -> None)
1004
+
match c.value with Some (Json.Bool (b, _)) -> Some b | _ -> None)
1005
1005
| _ -> None)
1006
1006
1007
1007
let toggle_outlet ~net ~sw ~clock ~fs ip =
···
1029
1029
| None -> Error (`Msg "Could not read current state")
1030
1030
| Some v ->
1031
1031
put_characteristic ~net ~sw session ~aid ~iid
1032
-
(Jsont.Bool (not v, Jsont.Meta.none)))))
1032
+
(Json.Bool (not v, Json.Meta.none)))))
+3
-3
lib/hap.mli
+3
-3
lib/hap.mli
···
128
128
net:_ Eio.Net.t ->
129
129
sw:Eio.Switch.t ->
130
130
session ->
131
-
(Jsont.json, [ `Msg of string ]) result
131
+
(Json.t, [ `Msg of string ]) result
132
132
(** [accessories ~net ~sw session] returns the accessory database. *)
133
133
134
134
val characteristics :
···
136
136
sw:Eio.Switch.t ->
137
137
session ->
138
138
ids:(int * int) list ->
139
-
(Jsont.json, [ `Msg of string ]) result
139
+
(Json.t, [ `Msg of string ]) result
140
140
(** [characteristics ~net ~sw session ~ids] reads characteristics. Each ID is
141
141
[(aid, iid)]. *)
142
142
···
146
146
session ->
147
147
aid:int ->
148
148
iid:int ->
149
-
Jsont.json ->
149
+
Json.t ->
150
150
(unit, [ `Msg of string ]) result
151
151
(** [put_characteristic ~net ~sw session ~aid ~iid value] writes a
152
152
characteristic value. *)