fix(lint): resolve E330, E331, E005 across freebox, git, gpt, hap

+240 -296

2 changed files

expand all

lib

hap.ml

hap.mli

+238 -294

lib/hap.ml

··· 244 244 in 245 245 Ok (Requests.Response.text response) 246 246 247 + (* Build encrypted M5 request with controller credentials *) 248 + let build_m5 ~session_key_bytes ~enc_key (controller_kp : Ed25519.keypair) 249 + controller_id = 250 + let controller_x = 251 + hkdf_sha512 ~salt:"Pair-Setup-Controller-Sign-Salt" ~ikm:session_key_bytes 252 + ~info:"Pair-Setup-Controller-Sign-Info" ~length:32 253 + in 254 + let sign_data = controller_x ^ controller_id ^ controller_kp.public in 255 + let signature = Ed25519.sign ~secret:controller_kp.secret sign_data in 256 + let sub_tlv = 257 + Tlv.( 258 + empty 259 + |> add TlvType.identifier controller_id 260 + |> add TlvType.public_key controller_kp.public 261 + |> add TlvType.signature signature 262 + |> encode) 263 + in 264 + let encrypted = 265 + chacha20_poly1305_encrypt ~key:enc_key ~nonce:"\x00\x00\x00\x00PS-Msg05" 266 + ~aad:"" sub_tlv 267 + in 268 + Tlv.( 269 + empty |> add TlvType.state "\x05" 270 + |> add TlvType.encrypted_data encrypted 271 + |> encode) 272 + 273 + (* Verify M6 accessory response and return pairing info *) 274 + let verify_m6 ~session_key_bytes ~enc_key (controller_kp : Ed25519.keypair) 275 + controller_id m6 = 276 + let enc_data = Tlv.get_exn TlvType.encrypted_data m6 in 277 + let* decrypted = 278 + chacha20_poly1305_decrypt ~key:enc_key ~nonce:"\x00\x00\x00\x00PS-Msg06" 279 + ~aad:"" enc_data 280 + in 281 + let sub_tlv = Tlv.decode decrypted in 282 + let accessory_id = Tlv.get_exn TlvType.identifier sub_tlv in 283 + let accessory_ltpk = Tlv.get_exn TlvType.public_key sub_tlv in 284 + let accessory_sig = Tlv.get_exn TlvType.signature sub_tlv in 285 + let accessory_x = 286 + hkdf_sha512 ~salt:"Pair-Setup-Accessory-Sign-Salt" ~ikm:session_key_bytes 287 + ~info:"Pair-Setup-Accessory-Sign-Info" ~length:32 288 + in 289 + let verify_data = accessory_x ^ accessory_id ^ accessory_ltpk in 290 + if 291 + not 292 + (Ed25519.verify ~public:accessory_ltpk ~signature:accessory_sig 293 + verify_data) 294 + then Error (`Msg "Accessory signature verification failed") 295 + else begin 296 + Log.info (fun f -> f "Pair setup complete! Accessory ID: %s" accessory_id); 297 + Ok 298 + { 299 + accessory_id; 300 + accessory_ltpk; 301 + controller_id; 302 + controller_ltsk = controller_kp.secret; 303 + controller_ltpk = controller_kp.public; 304 + } 305 + end 306 + 307 + (* Pair Setup M5/M6 exchange - derive keys, sign, encrypt, and verify *) 308 + let pair_setup_exchange ~net ~sw ~clock ~ip ~port ~session_key_bytes ~enc_key = 309 + let controller_kp = Ed25519.generate () in 310 + let controller_id = "maison-controller" in 311 + let m5 = build_m5 ~session_key_bytes ~enc_key controller_kp controller_id in 312 + let* m6_body = 313 + http_post ~net ~clock ~sw ~ip ~port ~path:"/pair-setup" 314 + ~content_type:"application/pairing+tlv8" ~body:m5 315 + in 316 + let m6 = Tlv.decode m6_body in 317 + match Tlv.get TlvType.error m6 with 318 + | Some e -> 319 + Error (`Msg (Printf.sprintf "Pair setup M6 error: %d" (Char.code e.[0]))) 320 + | None -> verify_m6 ~session_key_bytes ~enc_key controller_kp controller_id m6 321 + 322 + (* SRP M3/M4 verify exchange and derive encryption key for M5/M6 *) 323 + let srp_verify ~net ~sw ~clock ~ip ~port ~srp_client ~salt ~big_b ~session_key = 324 + let big_a = Srp.Client.public_key srp_client in 325 + let m1_proof = 326 + Srp.Client.compute_proof srp_client ~salt ~big_b ~session_key 327 + in 328 + let n_len = (Z.numbits Srp.n + 7) / 8 in 329 + let m3 = 330 + Tlv.( 331 + empty |> add TlvType.state "\x03" 332 + |> add TlvType.public_key (Srp.bytes_of_z ~pad:n_len big_a) 333 + |> add TlvType.proof m1_proof |> encode) 334 + in 335 + let* m4_body = 336 + http_post ~net ~clock ~sw ~ip ~port ~path:"/pair-setup" 337 + ~content_type:"application/pairing+tlv8" ~body:m3 338 + in 339 + let m4 = Tlv.decode m4_body in 340 + match Tlv.get TlvType.error m4 with 341 + | Some e -> 342 + Error (`Msg (Printf.sprintf "Pair setup M4 error: %d" (Char.code e.[0]))) 343 + | None -> 344 + let m2_proof = Tlv.get_exn TlvType.proof m4 in 345 + if 346 + not 347 + (Srp.Client.verify_proof srp_client ~m1:m1_proof ~m2:m2_proof 348 + ~session_key) 349 + then Error (`Msg "Server proof verification failed") 350 + else begin 351 + Log.info (fun f -> f "SRP verification successful"); 352 + let enc_key = 353 + hkdf_sha512 ~salt:"Pair-Setup-Encrypt-Salt" ~ikm:session_key 354 + ~info:"Pair-Setup-Encrypt-Info" ~length:32 355 + in 356 + pair_setup_exchange ~net ~sw ~clock ~ip ~port 357 + ~session_key_bytes:session_key ~enc_key 358 + end 359 + 247 360 (* Pair Setup - M1 through M6 *) 248 361 let pair_setup ~net ~sw ~clock ~ip ~port ~pin = 249 362 Log.info (fun f -> f "Starting pair setup with %s:%d" ip port); 250 - 251 - (* M1: Controller -> Accessory: Start Request *) 252 363 let m1 = 253 364 Tlv.( 254 365 empty |> add TlvType.state "\x01" |> add TlvType.method_ "\x00" |> encode) ··· 258 369 ~content_type:"application/pairing+tlv8" ~body:m1 259 370 in 260 371 let m2 = Tlv.decode m2_body in 261 - 262 - (* Check for error *) 263 372 match Tlv.get TlvType.error m2 with 264 373 | Some e -> 265 374 Error (`Msg (Printf.sprintf "Pair setup error: %d" (Char.code e.[0]))) 266 - | None -> ( 267 - (* M2: Accessory -> Controller: SRP Start Response *) 375 + | None -> 268 376 let salt = Tlv.get_exn TlvType.salt m2 in 269 377 let big_b_bytes = Tlv.get_exn TlvType.public_key m2 in 270 378 let big_b = Srp.z_of_bytes big_b_bytes in 271 - 272 379 Log.info (fun f -> 273 380 f "Received M2, salt=%d bytes, B=%d bytes" (String.length salt) 274 381 (String.length big_b_bytes)); 275 - 276 - (* Create SRP client with PIN as password *) 277 - let username = "Pair-Setup" in 278 - let srp_client = Srp.Client.create ~username ~password:pin in 279 - let big_a = Srp.Client.public_key srp_client in 280 - 281 - (* Compute session key *) 382 + let srp_client = Srp.Client.create ~username:"Pair-Setup" ~password:pin in 282 383 let* session_key = 283 384 Srp.Client.compute_session_key srp_client ~salt ~big_b 284 385 in 285 - let m1_proof = 286 - Srp.Client.compute_proof srp_client ~salt ~big_b ~session_key 287 - in 288 - 289 - (* M3: Controller -> Accessory: SRP Verify Request *) 290 - let n_len = (Z.numbits Srp.n + 7) / 8 in 291 - let m3 = 292 - Tlv.( 293 - empty |> add TlvType.state "\x03" 294 - |> add TlvType.public_key (Srp.bytes_of_z ~pad:n_len big_a) 295 - |> add TlvType.proof m1_proof |> encode) 296 - in 297 - let* m4_body = 298 - http_post ~net ~clock ~sw ~ip ~port ~path:"/pair-setup" 299 - ~content_type:"application/pairing+tlv8" ~body:m3 300 - in 301 - let m4 = Tlv.decode m4_body in 386 + srp_verify ~net ~sw ~clock ~ip ~port ~srp_client ~salt ~big_b ~session_key 302 387 303 - (* Check for error *) 304 - match Tlv.get TlvType.error m4 with 305 - | Some e -> 306 - Error 307 - (`Msg (Printf.sprintf "Pair setup M4 error: %d" (Char.code e.[0]))) 308 - | None -> 309 - (* M4: Accessory -> Controller: SRP Verify Response *) 310 - let m2_proof = Tlv.get_exn TlvType.proof m4 in 311 - if 312 - not 313 - (Srp.Client.verify_proof srp_client ~m1:m1_proof ~m2:m2_proof 314 - ~session_key) 315 - then Error (`Msg "Server proof verification failed") 316 - else begin 317 - Log.info (fun f -> f "SRP verification successful"); 388 + (* Build encrypted M3 verify request *) 389 + let build_verify_m3 ~enc_key ~pairing ~kp ~accessory_pk = 390 + let sign_data = kp.X25519.public ^ pairing.controller_id ^ accessory_pk in 391 + let signature = Ed25519.sign ~secret:pairing.controller_ltsk sign_data in 392 + let sub_tlv = 393 + Tlv.( 394 + empty 395 + |> add TlvType.identifier pairing.controller_id 396 + |> add TlvType.signature signature 397 + |> encode) 398 + in 399 + let encrypted = 400 + chacha20_poly1305_encrypt ~key:enc_key ~nonce:"\x00\x00\x00\x00PV-Msg03" 401 + ~aad:"" sub_tlv 402 + in 403 + Tlv.( 404 + empty |> add TlvType.state "\x03" 405 + |> add TlvType.encrypted_data encrypted 406 + |> encode) 318 407 319 - (* Derive encryption key for M5/M6 *) 320 - let enc_salt = "Pair-Setup-Encrypt-Salt" in 321 - let enc_info = "Pair-Setup-Encrypt-Info" in 322 - let session_key_bytes = session_key in 323 - let enc_key = 324 - hkdf_sha512 ~salt:enc_salt ~ikm:session_key_bytes ~info:enc_info 325 - ~length:32 326 - in 327 - 328 - (* Generate controller's long-term Ed25519 key pair *) 329 - let controller_kp = Ed25519.generate () in 330 - let controller_id = "maison-controller" in 331 - (* UUID would be better *) 332 - 333 - (* Derive controller key for signing *) 334 - let controller_salt = "Pair-Setup-Controller-Sign-Salt" in 335 - let controller_info = "Pair-Setup-Controller-Sign-Info" in 336 - let controller_x = 337 - hkdf_sha512 ~salt:controller_salt ~ikm:session_key_bytes 338 - ~info:controller_info ~length:32 339 - in 340 - 341 - (* Sign: iOSDeviceX || iOSDevicePairingID || iOSDeviceLTPK *) 342 - let sign_data = 343 - controller_x ^ controller_id ^ controller_kp.public 344 - in 345 - let signature = 346 - Ed25519.sign ~secret:controller_kp.secret sign_data 347 - in 348 - 349 - (* Build sub-TLV *) 350 - let sub_tlv = 351 - Tlv.( 352 - empty 353 - |> add TlvType.identifier controller_id 354 - |> add TlvType.public_key controller_kp.public 355 - |> add TlvType.signature signature 356 - |> encode) 357 - in 358 - 359 - (* Encrypt sub-TLV *) 360 - let nonce = "\x00\x00\x00\x00PS-Msg05" in 361 - let encrypted = 362 - chacha20_poly1305_encrypt ~key:enc_key ~nonce ~aad:"" sub_tlv 363 - in 364 - 365 - (* M5: Controller -> Accessory: Exchange Request *) 366 - let m5 = 367 - Tlv.( 368 - empty |> add TlvType.state "\x05" 369 - |> add TlvType.encrypted_data encrypted 370 - |> encode) 371 - in 372 - let* m6_body = 373 - http_post ~net ~clock ~sw ~ip ~port ~path:"/pair-setup" 374 - ~content_type:"application/pairing+tlv8" ~body:m5 375 - in 376 - let m6 = Tlv.decode m6_body in 377 - 378 - (* Check for error *) 379 - match Tlv.get TlvType.error m6 with 380 - | Some e -> 381 - Error 382 - (`Msg 383 - (Printf.sprintf "Pair setup M6 error: %d" 384 - (Char.code e.[0]))) 385 - | None -> 386 - (* M6: Accessory -> Controller: Exchange Response *) 387 - let enc_data = Tlv.get_exn TlvType.encrypted_data m6 in 388 - let nonce = "\x00\x00\x00\x00PS-Msg06" in 389 - let* decrypted = 390 - chacha20_poly1305_decrypt ~key:enc_key ~nonce ~aad:"" enc_data 391 - in 392 - let sub_tlv = Tlv.decode decrypted in 393 - 394 - let accessory_id = Tlv.get_exn TlvType.identifier sub_tlv in 395 - let accessory_ltpk = Tlv.get_exn TlvType.public_key sub_tlv in 396 - let accessory_sig = Tlv.get_exn TlvType.signature sub_tlv in 408 + (* Derive session keys from shared secret *) 409 + let derive_session_keys ~pairing ~ip ~port ~shared = 410 + let enc_key = 411 + hkdf_sha512 ~salt:"Control-Salt" ~ikm:shared 412 + ~info:"Control-Write-Encryption-Key" ~length:32 413 + in 414 + let dec_key = 415 + hkdf_sha512 ~salt:"Control-Salt" ~ikm:shared 416 + ~info:"Control-Read-Encryption-Key" ~length:32 417 + in 418 + Log.info (fun f -> f "Pair verify successful, session established"); 419 + Ok 420 + { 421 + pairing; 422 + ip; 423 + port; 424 + encrypt_key = enc_key; 425 + decrypt_key = dec_key; 426 + encrypt_count = 0L; 427 + decrypt_count = 0L; 428 + } 397 429 398 - (* Verify accessory signature *) 399 - let accessory_salt = "Pair-Setup-Accessory-Sign-Salt" in 400 - let accessory_info = "Pair-Setup-Accessory-Sign-Info" in 401 - let accessory_x = 402 - hkdf_sha512 ~salt:accessory_salt ~ikm:session_key_bytes 403 - ~info:accessory_info ~length:32 404 - in 405 - let verify_data = accessory_x ^ accessory_id ^ accessory_ltpk in 430 + (* Pair Verify M3/M4 - send M3, handle M4, derive session keys *) 431 + let pair_verify_response ~net ~sw ~clock ~ip ~port ~pairing ~kp ~accessory_pk 432 + ~enc_key ~shared = 433 + let m3 = build_verify_m3 ~enc_key ~pairing ~kp ~accessory_pk in 434 + let* m4_body = 435 + http_post ~net ~clock ~sw ~ip ~port ~path:"/pair-verify" 436 + ~content_type:"application/pairing+tlv8" ~body:m3 437 + in 438 + let m4 = Tlv.decode m4_body in 439 + match Tlv.get TlvType.error m4 with 440 + | Some e -> 441 + Error (`Msg (Printf.sprintf "Pair verify M4 error: %d" (Char.code e.[0]))) 442 + | None -> derive_session_keys ~pairing ~ip ~port ~shared 406 443 407 - if 408 - not 409 - (Ed25519.verify ~public:accessory_ltpk 410 - ~signature:accessory_sig verify_data) 411 - then Error (`Msg "Accessory signature verification failed") 412 - else begin 413 - Log.info (fun f -> 414 - f "Pair setup complete! Accessory ID: %s" accessory_id); 415 - Ok 416 - { 417 - accessory_id; 418 - accessory_ltpk; 419 - controller_id; 420 - controller_ltsk = controller_kp.secret; 421 - controller_ltpk = controller_kp.public; 422 - } 423 - end 424 - end) 444 + (* Verify M2 response: decrypt, check identity and signature *) 445 + let verify_m2 ~pairing ~kp ~enc_key ~enc_data ~accessory_pk = 446 + let* decrypted = 447 + chacha20_poly1305_decrypt ~key:enc_key ~nonce:"\x00\x00\x00\x00PV-Msg02" 448 + ~aad:"" enc_data 449 + in 450 + let sub_tlv = Tlv.decode decrypted in 451 + let accessory_id = Tlv.get_exn TlvType.identifier sub_tlv in 452 + let accessory_sig = Tlv.get_exn TlvType.signature sub_tlv in 453 + if accessory_id <> pairing.accessory_id then 454 + Error (`Msg "Accessory ID mismatch") 455 + else 456 + let verify_data = accessory_pk ^ accessory_id ^ kp.X25519.public in 457 + if 458 + not 459 + (Ed25519.verify ~public:pairing.accessory_ltpk ~signature:accessory_sig 460 + verify_data) 461 + then Error (`Msg "Accessory signature verification failed") 462 + else Ok () 425 463 426 464 (* Pair Verify - establish encrypted session *) 427 465 let pair_verify ~net ~sw ~clock ~ip ~port ~pairing = 428 466 Log.info (fun f -> f "Starting pair verify with %s:%d" ip port); 429 - 430 - (* Generate ephemeral X25519 key pair *) 431 467 let kp = X25519.generate () in 432 - 433 - (* M1: Controller -> Accessory *) 434 468 let m1 = 435 469 Tlv.( 436 470 empty |> add TlvType.state "\x01" ··· 442 476 ~content_type:"application/pairing+tlv8" ~body:m1 443 477 in 444 478 let m2 = Tlv.decode m2_body in 445 - 446 - (* Check for error *) 447 479 match Tlv.get TlvType.error m2 with 448 480 | Some e -> 449 481 Error (`Msg (Printf.sprintf "Pair verify M2 error: %d" (Char.code e.[0]))) 450 482 | None -> 451 - (* M2: Accessory -> Controller *) 452 483 let accessory_pk = Tlv.get_exn TlvType.public_key m2 in 453 484 let enc_data = Tlv.get_exn TlvType.encrypted_data m2 in 454 - 455 - (* Compute shared secret *) 456 485 let* shared = 457 486 X25519.shared_secret ~secret:kp.secret ~public:accessory_pk 458 487 in 459 - 460 - (* Derive encryption key *) 461 488 let enc_key = 462 489 hkdf_sha512 ~salt:"Pair-Verify-Encrypt-Salt" ~ikm:shared 463 490 ~info:"Pair-Verify-Encrypt-Info" ~length:32 464 491 in 465 - 466 - (* Decrypt accessory's sub-TLV *) 467 - let nonce = "\x00\x00\x00\x00PV-Msg02" in 468 - let* decrypted = 469 - chacha20_poly1305_decrypt ~key:enc_key ~nonce ~aad:"" enc_data 470 - in 471 - let sub_tlv = Tlv.decode decrypted in 472 - 473 - let accessory_id = Tlv.get_exn TlvType.identifier sub_tlv in 474 - let accessory_sig = Tlv.get_exn TlvType.signature sub_tlv in 475 - 476 - (* Verify it's the accessory we paired with *) 477 - if accessory_id <> pairing.accessory_id then 478 - Error (`Msg "Accessory ID mismatch") 479 - else begin 480 - (* Verify accessory signature *) 481 - let verify_data = accessory_pk ^ accessory_id ^ kp.public in 482 - if 483 - not 484 - (Ed25519.verify ~public:pairing.accessory_ltpk 485 - ~signature:accessory_sig verify_data) 486 - then Error (`Msg "Accessory signature verification failed") 487 - else begin 488 - (* Sign our response *) 489 - let sign_data = kp.public ^ pairing.controller_id ^ accessory_pk in 490 - let signature = 491 - Ed25519.sign ~secret:pairing.controller_ltsk sign_data 492 - in 493 - 494 - (* Build and encrypt sub-TLV *) 495 - let sub_tlv = 496 - Tlv.( 497 - empty 498 - |> add TlvType.identifier pairing.controller_id 499 - |> add TlvType.signature signature 500 - |> encode) 501 - in 502 - let nonce = "\x00\x00\x00\x00PV-Msg03" in 503 - let encrypted = 504 - chacha20_poly1305_encrypt ~key:enc_key ~nonce ~aad:"" sub_tlv 505 - in 506 - 507 - (* M3: Controller -> Accessory *) 508 - let m3 = 509 - Tlv.( 510 - empty |> add TlvType.state "\x03" 511 - |> add TlvType.encrypted_data encrypted 512 - |> encode) 513 - in 514 - let* m4_body = 515 - http_post ~net ~clock ~sw ~ip ~port ~path:"/pair-verify" 516 - ~content_type:"application/pairing+tlv8" ~body:m3 517 - in 518 - let m4 = Tlv.decode m4_body in 519 - 520 - (* Check for error *) 521 - match Tlv.get TlvType.error m4 with 522 - | Some e -> 523 - Error 524 - (`Msg 525 - (Printf.sprintf "Pair verify M4 error: %d" (Char.code e.[0]))) 526 - | None -> 527 - (* Derive session keys *) 528 - let enc_key = 529 - hkdf_sha512 ~salt:"Control-Salt" ~ikm:shared 530 - ~info:"Control-Write-Encryption-Key" ~length:32 531 - in 532 - let dec_key = 533 - hkdf_sha512 ~salt:"Control-Salt" ~ikm:shared 534 - ~info:"Control-Read-Encryption-Key" ~length:32 535 - in 536 - 537 - Log.info (fun f -> 538 - f "Pair verify successful, session established"); 539 - Ok 540 - { 541 - pairing; 542 - ip; 543 - port; 544 - encrypt_key = enc_key; 545 - decrypt_key = dec_key; 546 - encrypt_count = 0L; 547 - decrypt_count = 0L; 548 - } 549 - end 550 - end 492 + let* () = verify_m2 ~pairing ~kp ~enc_key ~enc_data ~accessory_pk in 493 + pair_verify_response ~net ~sw ~clock ~ip ~port ~pairing ~kp ~accessory_pk 494 + ~enc_key ~shared 551 495 552 496 (* Send encrypted request and read response *) 553 497 let request ~net ~sw session req = ··· 738 682 match Jsont_bytesrw.decode_string Pairing_json.stored content with 739 683 | Ok stored -> Some (Pairing_json.to_pairing stored) 740 684 | Error _ -> None 741 - with _ -> None 685 + with Eio.Io _ -> None 742 686 end 743 687 744 688 (* Save pairing by device_id *) ··· 814 758 let paired = find_int "sf" = Some 0 in 815 759 (device_id, model, config_num, state_num, category, paired) 816 760 761 + (* Build accessory_info from mDNS instance, SRV, TXT, and address records *) 762 + let build_device_info (r : Mdns.response) instance = 763 + match 764 + List.find_opt (fun (n, _, _) -> Domain_name.equal n instance) r.srvs 765 + with 766 + | None -> None 767 + | Some (_, port, target) -> 768 + let txt = 769 + List.find_map 770 + (fun (n, t) -> if Domain_name.equal n instance then Some t else None) 771 + r.txts 772 + |> Option.value ~default:[] |> String.concat " " 773 + in 774 + let ip = 775 + List.find_map 776 + (fun (n, ip) -> 777 + if Domain_name.equal n target then Some (Ipaddr.V4.to_string ip) 778 + else None) 779 + r.addrs 780 + |> Option.value ~default:(Domain_name.to_string target) 781 + in 782 + let device_id, model, config_num, state_num, category, paired = 783 + parse_hap_txt txt 784 + in 785 + let name = 786 + match Domain_name.get_label instance 0 with 787 + | Ok label -> label 788 + | Error _ -> Domain_name.to_string instance 789 + in 790 + Some 791 + { 792 + name; 793 + device_id = Option.value ~default:"" device_id; 794 + ip; 795 + port; 796 + model; 797 + config_num = Option.value ~default:0 config_num; 798 + state_num = Option.value ~default:0 state_num; 799 + category = Option.value ~default:0 category; 800 + paired; 801 + } 802 + 817 803 (* Discover HAP devices using mDNS *) 818 804 let discover ~sw ~net ~clock ?(timeout = 3.0) () = 819 805 let service_name = Domain_name.of_string_exn "_hap._tcp.local" in ··· 827 813 |> List.sort_uniq Domain_name.compare 828 814 in 829 815 (* Build device info for each instance *) 830 - List.filter_map 831 - (fun instance -> 832 - match 833 - List.find_opt (fun (n, _, _) -> Domain_name.equal n instance) r.srvs 834 - with 835 - | None -> None 836 - | Some (_, port, target) -> 837 - let txt = 838 - List.find_map 839 - (fun (n, t) -> 840 - if Domain_name.equal n instance then Some t else None) 841 - r.txts 842 - |> Option.value ~default:[] |> String.concat " " 843 - in 844 - let ip = 845 - List.find_map 846 - (fun (n, ip) -> 847 - if Domain_name.equal n target then Some (Ipaddr.V4.to_string ip) 848 - else None) 849 - r.addrs 850 - |> Option.value ~default:(Domain_name.to_string target) 851 - in 852 - let device_id, model, config_num, state_num, category, paired = 853 - parse_hap_txt txt 854 - in 855 - let name = 856 - match Domain_name.get_label instance 0 with 857 - | Ok label -> label 858 - | Error _ -> Domain_name.to_string instance 859 - in 860 - Some 861 - { 862 - name; 863 - device_id = Option.value ~default:"" device_id; 864 - ip; 865 - port; 866 - model; 867 - config_num = Option.value ~default:0 config_num; 868 - state_num = Option.value ~default:0 state_num; 869 - category = Option.value ~default:0 category; 870 - paired; 871 - }) 872 - instances 816 + List.filter_map (build_device_info r) instances 873 817 874 818 (* Find pairing for an IP by discovering the device first *) 875 819 let pairing_for_ip ~sw ~net ~clock ~fs ip = ··· 880 824 if info.device_id = "" then None else pairing_by_id ~fs info.device_id 881 825 882 826 (* Get accessory info for an IP *) 883 - let find_accessory_info ~sw ~net ~clock ip = 827 + let accessory_info ~sw ~net ~clock ip = 884 828 let devices = discover ~sw ~net ~clock ~timeout:2.0 () in 885 829 List.find_opt (fun (d : accessory_info) -> d.ip = ip) devices 886 830 ··· 1036 980 control_outlet ~net ~sw ~clock ~fs ~ip ~value:false 1037 981 1038 982 (* Extract bool value from characteristics response *) 1039 - let find_bool_value json = 983 + let bool_value json = 1040 984 match decode Hap_json.characteristics_response json with 1041 985 | Error _ -> None 1042 986 | Ok (resp : Hap_json.characteristics_response) -> ( ··· 1066 1010 let* chars_json = 1067 1011 characteristics ~net ~sw session ~ids:[ (aid, iid) ] 1068 1012 in 1069 - match find_bool_value chars_json with 1013 + match bool_value chars_json with 1070 1014 | None -> Error (`Msg "Could not read current state") 1071 1015 | Some v -> 1072 1016 put_characteristic ~net ~sw session ~aid ~iid

+2 -2

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 find_accessory_info : 64 + val 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 - (** [find_accessory_info ~sw ~net ~clock ip] returns info for a specific IP. *) 70 + (** [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. *)

Configure Feed

Configure Feed