HomeKit Accessory Protocol (HAP) for OCaml
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

hap: Extract hap_request and parse_json_response helpers

+27 -66
+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 *)