HomeKit Accessory Protocol (HAP) for OCaml
hap: Extract hap_request and parse_json_response helpers
+27
-66
+27
-66
lib/hap.ml
+27
-66
lib/hap.ml
···
549
549
end
550
550
end
551
551
552
-
(* Get accessories from a session *)
553
-
let get_accessories ~net ~sw session =
554
-
let path = "/accessories" in
555
-
let request =
556
-
Printf.sprintf "GET %s HTTP/1.1\r\nHost: %s:%d\r\n\r\n" path session.ip
557
-
session.port
558
-
in
552
+
(* Send encrypted request and read response *)
553
+
let hap_request ~net ~sw session request =
559
554
let encrypted = encrypt_frame session request in
560
-
561
555
let addr = `Tcp (ipv4_of_string session.ip, session.port) in
562
556
let flow = Eio.Net.connect ~sw net addr in
563
557
Eio.Flow.copy_string encrypted flow;
564
-
565
558
let buf = Buffer.create 4096 in
566
559
let rec read () =
567
560
let chunk = Cstruct.create 1024 in
···
573
566
in
574
567
read ();
575
568
Eio.Flow.close flow;
569
+
decrypt_frame session (Buffer.contents buf)
576
570
577
-
let* decrypted = decrypt_frame session (Buffer.contents buf) in
578
-
(* Parse HTTP response to get JSON body *)
571
+
(* Parse HTTP response body as JSON *)
572
+
let parse_json_response decrypted =
579
573
match Re.(exec_opt (compile (str "\r\n\r\n")) decrypted) with
580
574
| None -> Error (`Msg "Invalid response")
581
-
| Some g -> (
575
+
| Some g ->
582
576
let pos = Re.Group.stop g 0 in
583
577
let body = String.sub decrypted pos (String.length decrypted - pos) in
584
-
match Jsont_bytesrw.decode_string Jsont.json body with
585
-
| Ok json -> Ok json
586
-
| Error e -> Error (`Msg e))
578
+
Result.map_error
579
+
(fun e -> `Msg e)
580
+
(Jsont_bytesrw.decode_string Jsont.json body)
581
+
582
+
(* Get accessories from a session *)
583
+
let get_accessories ~net ~sw session =
584
+
let path = "/accessories" in
585
+
let request =
586
+
Printf.sprintf "GET %s HTTP/1.1\r\nHost: %s:%d\r\n\r\n" path session.ip
587
+
session.port
588
+
in
589
+
let* decrypted = hap_request ~net ~sw session request in
590
+
parse_json_response decrypted
587
591
588
592
(* Characteristic write request codec *)
589
593
type char_write = { cw_aid : int; cw_iid : int; cw_value : Jsont.json }
···
626
630
%s"
627
631
path session.ip session.port (String.length body) body
628
632
in
629
-
let encrypted = encrypt_frame session request in
630
-
631
-
let addr = `Tcp (ipv4_of_string session.ip, session.port) in
632
-
let flow = Eio.Net.connect ~sw net addr in
633
-
Eio.Flow.copy_string encrypted flow;
634
-
635
-
let buf = Buffer.create 4096 in
636
-
let rec read () =
637
-
let chunk = Cstruct.create 1024 in
638
-
match Eio.Flow.single_read flow chunk with
639
-
| n ->
640
-
Buffer.add_string buf (Cstruct.to_string (Cstruct.sub chunk 0 n));
641
-
read ()
642
-
| exception End_of_file -> ()
643
-
in
644
-
read ();
645
-
Eio.Flow.close flow;
646
-
647
-
let* _decrypted = decrypt_frame session (Buffer.contents buf) in
633
+
let* _decrypted = hap_request ~net ~sw session request in
648
634
Ok ()
649
635
650
636
(* Read characteristics *)
···
658
644
Printf.sprintf "GET %s HTTP/1.1\r\nHost: %s:%d\r\n\r\n" path session.ip
659
645
session.port
660
646
in
661
-
let encrypted = encrypt_frame session request in
662
-
663
-
let addr = `Tcp (ipv4_of_string session.ip, session.port) in
664
-
let flow = Eio.Net.connect ~sw net addr in
665
-
Eio.Flow.copy_string encrypted flow;
666
-
667
-
let buf = Buffer.create 4096 in
668
-
let rec read () =
669
-
let chunk = Cstruct.create 1024 in
670
-
match Eio.Flow.single_read flow chunk with
671
-
| n ->
672
-
Buffer.add_string buf (Cstruct.to_string (Cstruct.sub chunk 0 n));
673
-
read ()
674
-
| exception End_of_file -> ()
675
-
in
676
-
read ();
677
-
Eio.Flow.close flow;
678
-
679
-
let* decrypted = decrypt_frame session (Buffer.contents buf) in
680
-
match Re.(exec_opt (compile (str "\r\n\r\n")) decrypted) with
681
-
| None -> Error (`Msg "Invalid response")
682
-
| Some g -> (
683
-
let pos = Re.Group.stop g 0 in
684
-
let body = String.sub decrypted pos (String.length decrypted - pos) in
685
-
match Jsont_bytesrw.decode_string Jsont.json body with
686
-
| Ok json -> Ok json
687
-
| Error e -> Error (`Msg e))
647
+
let* decrypted = hap_request ~net ~sw session request in
648
+
parse_json_response decrypted
688
649
689
650
(* Pairing storage directory *)
690
651
let pairings_dir = ".hap/pairings"
···
844
805
| _ -> None)
845
806
pairs
846
807
in
808
+
let find_int key = Option.bind (find key) int_of_string_opt in
847
809
let device_id = find "id" in
848
810
let model = find "md" in
849
-
let config_num = Option.bind (find "c#") (fun s -> int_of_string_opt s) in
850
-
let state_num = Option.bind (find "s#") (fun s -> int_of_string_opt s) in
851
-
let category = Option.bind (find "ci") (fun s -> int_of_string_opt s) in
852
-
let status_flags = Option.bind (find "sf") (fun s -> int_of_string_opt s) in
853
-
let paired = match status_flags with Some 0 -> true | _ -> false in
811
+
let config_num = find_int "c#" in
812
+
let state_num = find_int "s#" in
813
+
let category = find_int "ci" in
814
+
let paired = find_int "sf" = Some 0 in
854
815
(device_id, model, config_num, state_num, category, paired)
855
816
856
817
(* Discover HAP devices using mDNS *)