Sigstore signing and verification for OCaml
Fix merlint E005/E010: split long functions and flatten deep nesting
Refactored 21 functions across 17 files to bring them under merlint
thresholds. Pure structural refactoring — no behavior changes.
Packages: irmin, merlint, monopam, ocaml-btree, ocaml-cdm, ocaml-git,
ocaml-globe, ocaml-kepler, ocaml-osv, ocaml-sigstore, ocaml-stix, prune.
+54
-58
+54
-58
lib/sigstore.ml
+54
-58
lib/sigstore.ml
···
534
534
in
535
535
match json_to_string json with Ok s -> s | Error e -> failwith e
536
536
537
+
let req_str key mems err =
538
+
match find_string key mems with
539
+
| Some s -> Ok s
540
+
| None -> Error (Verification_failed (Fmt.str "missing %s" err))
541
+
542
+
let req_obj key mems err =
543
+
match find_object key mems with
544
+
| Some o -> Ok o
545
+
| None -> Error (Verification_failed (Fmt.str "missing %s" err))
546
+
547
+
let parse_certificate_chain vm =
548
+
match find_object "certificateChain" vm with
549
+
| Some cc_mems -> (
550
+
match find_array "certificates" cc_mems with
551
+
| Some certs ->
552
+
List.filter_map
553
+
(fun c ->
554
+
match get_string_v c with
555
+
| Some s -> (
556
+
match b64_decode s with Ok d -> Some d | Error _ -> None)
557
+
| None -> None)
558
+
certs
559
+
| None -> [])
560
+
| None -> []
561
+
562
+
let parse_tlog_entry vm =
563
+
match find_array "tlogEntries" vm with
564
+
| Some (entry :: _) -> (
565
+
match get_object_v entry with
566
+
| Some e_mems -> (
567
+
match
568
+
( find_number "logIndex" e_mems,
569
+
find_string "logId" e_mems,
570
+
find_number "integratedTime" e_mems,
571
+
find_string "body" e_mems )
572
+
with
573
+
| Some log_index, Some uuid, Some integrated_time, Some body_b64 -> (
574
+
match b64_decode body_b64 with
575
+
| Ok body ->
576
+
Some
577
+
Rekor.
578
+
{
579
+
uuid;
580
+
log_index = int_of_float log_index;
581
+
body;
582
+
integrated_time = int_of_float integrated_time;
583
+
}
584
+
| Error _ -> None)
585
+
| _ -> None)
586
+
| None -> None)
587
+
| _ -> None
588
+
537
589
let bundle_of_json body =
538
590
match json_of_string body with
539
591
| Error e -> Error (Verification_failed (Fmt.str "invalid bundle JSON: %s" e))
540
592
| Ok (Jsont.Object (mems, _)) -> (
541
-
let req_str key mems err =
542
-
match find_string key mems with
543
-
| Some s -> Ok s
544
-
| None -> Error (Verification_failed (Fmt.str "missing %s" err))
545
-
in
546
-
let req_obj key mems err =
547
-
match find_object key mems with
548
-
| Some o -> Ok o
549
-
| None -> Error (Verification_failed (Fmt.str "missing %s" err))
550
-
in
551
593
Result.bind (req_str "mediaType" mems "mediaType") @@ fun media_type ->
552
594
Result.bind (req_obj "verificationMaterial" mems "verificationMaterial")
553
595
@@ fun vm ->
554
596
Result.bind (req_obj "messageSignature" mems "messageSignature")
555
597
@@ fun ms ->
556
-
(* Parse certificate chain *)
557
-
let certificate_chain =
558
-
match find_object "certificateChain" vm with
559
-
| Some cc_mems -> (
560
-
match find_array "certificates" cc_mems with
561
-
| Some certs ->
562
-
List.filter_map
563
-
(fun c ->
564
-
match get_string_v c with
565
-
| Some s -> (
566
-
match b64_decode s with
567
-
| Ok d -> Some d
568
-
| Error _ -> None)
569
-
| None -> None)
570
-
certs
571
-
| None -> [])
572
-
| None -> []
573
-
in
574
-
(* Parse tlog entries *)
575
-
let tlog_entry =
576
-
match find_array "tlogEntries" vm with
577
-
| Some (entry :: _) -> (
578
-
match get_object_v entry with
579
-
| Some e_mems -> (
580
-
match
581
-
( find_number "logIndex" e_mems,
582
-
find_string "logId" e_mems,
583
-
find_number "integratedTime" e_mems,
584
-
find_string "body" e_mems )
585
-
with
586
-
| Some log_index, Some uuid, Some integrated_time, Some body_b64
587
-
-> (
588
-
match b64_decode body_b64 with
589
-
| Ok body ->
590
-
Some
591
-
Rekor.
592
-
{
593
-
uuid;
594
-
log_index = int_of_float log_index;
595
-
body;
596
-
integrated_time = int_of_float integrated_time;
597
-
}
598
-
| Error _ -> None)
599
-
| _ -> None)
600
-
| None -> None)
601
-
| _ -> None
602
-
in
603
-
(* Parse message signature *)
598
+
let certificate_chain = parse_certificate_chain vm in
599
+
let tlog_entry = parse_tlog_entry vm in
604
600
Result.bind (req_obj "messageDigest" ms "messageDigest") @@ fun md ->
605
601
Result.bind (req_str "algorithm" md "algorithm") @@ fun alg_str ->
606
602
match hash_algorithm_of_string alg_str with