Source file ShellPrepareCi.ml

type ci = GitHub

let ci = ref GitHub
let majmin = ref None

let registry =
  SecPackageRegistry.create
    ~show:(fun _distcore item -> MlFront_Core.FilePath.to_string item)
    ()

let quick_error msg =
  let lines = String.split_on_char '\n' msg in
  Format.eprintf "@[<v 1>FATAL: The prepare failed.@;%a@]@."
    Format.(pp_print_list ~pp_sep:pp_print_cut pp_print_string)
    lines;
  exit 1

let left_pad s =
  let lines = String.split_on_char '\n' s in
  String.concat "\n" (List.map (fun line -> "  " ^ line) lines)

let anon_fun s =
  match !majmin with
  | None -> majmin := Some s
  | Some _ -> raise (Arg.Bad "Too many arguments")

let speclist ~usage_msg =
  [
    ( "--ci",
      Arg.String
        (function
        | "github" -> ci := GitHub
        | _ -> raise (Arg.Bad "Invalid CI provider")),
      "" );
    ( "-help",
      Arg.Unit
        (fun () ->
          print_endline usage_msg;
          exit 0),
      "" );
    ( "--help",
      Arg.Unit
        (fun () ->
          print_endline usage_msg;
          exit 0),
      "" );
  ]

let zerorangeplus =
  MlFront_Thunk.ThunkLexers.Ranges.Raw_range Fmlib_parse.Position.(start, start)

(** The GitHub Secrets name for the public build key or secret build key.

    Works with:
    - GitHub. "HTTP 422: Secret names can only contain alphanumeric characters
      ([a-z], [A-Z], [0-9]) or underscores (_). Spaces are not allowed. Must
      start with a letter ([a-z], [A-Z]) or underscores (_)." *)
let distributionkey_secretname ~majmin = function
  | `PublicKey ->
      Printf.sprintf "distribute_%Ld_%Ld_pubkey" (fst majmin) (snd majmin)
  | `SecretKey ->
      Printf.sprintf "distribute_%Ld_%Ld_seckey" (fst majmin) (snd majmin)

let read_dot_terminated_text () =
  let rec read_lines acc =
    try
      match input_line stdin with
      | "." -> List.rev acc
      | line -> read_lines (line :: acc)
    with End_of_file -> List.rev acc
  in
  let lines = read_lines [] in
  if lines = [] then None else Some (String.concat "\n" lines)

let rec process_prepare_ci_version_command ~usage_msg ~random_seed module_or
    args =
  (* Parse *)
  let current = ref 1 in
  (try
     Arg.parse_argv ~current
       (Array.of_list ("mlfront-shell" :: "prepare-version" :: args))
       (speclist ~usage_msg) anon_fun usage_msg
   with
  | Arg.Bad msg ->
      prerr_endline msg;
      exit 1
  | Arg.Help msg ->
      prerr_endline msg;
      exit 0);

  (* Convert and validate *)
  let major, minor =
    match !majmin with
    | None ->
        prerr_endline "Missing MAJOR.MINOR version argument";
        exit 1
    | Some majmin ->
    match MlFront_Thunk.ThunkDist.InternalUse.parse_major_minor majmin with
    | Ok v -> v
    | Error m ->
        prerr_endline m;
        exit 1
  in
  let majmin = (major, minor) in

  (* RNG *)
  let rng = SecCore.get_rng ~random_seed () in

  (* Load existing dist core or use a continuation or make a new one *)
  let pkg_opt, registry = SecDist.scan_dist_dir module_or in
  let dist_core =
    match pkg_opt with
    | None -> SecPackageRegistry.create_dist_core ()
    | Some pkg ->
    match SecPackageRegistry.characterize ~majmin pkg registry with
    | `Exists (_dist_core, dist_file) ->
        quick_error
          (Printf.sprintf "The version %Ld.%Ld already exists in `%s`" major
             minor
             (MlFront_Core.FilePath.to_string dist_file))
    | `Superseded latest ->
        quick_error
          (Printf.sprintf
             "Version %Ld.%Ld has been superseded by the latest released \
              version %s"
             major minor
             (MlFront_Thunk.ThunkSemver64.to_string latest))
    | `Continued dist_core -> dist_core
    | `Error msg -> quick_error msg
    | `NoMatchingContinuation ->
        let next_versions =
          SecPackageRegistry.get_next_versions_desc registry pkg
          |> List.map (fun (major, minor) ->
                 Printf.sprintf "%Ld.%Ld" major minor)
        in
        quick_error
          (Printf.sprintf
             "There are no distribution files with %Ld.%Ld as a continuation. \
              The versions that you can prepare are: %s"
             major minor
             (String.concat ", " next_versions))
  in

  (* Fill in missing fields *)
  let idrange, library_id, version = fill_id ~majmin dist_core.id in
  let dist_core : MlFront_Thunk.ThunkDist.DistCore.t =
    let producer, `SecretKey seckey =
      fill_producer ~library_id ~majmin ~rng dist_core.producer
    in
    let license = fill_license dist_core.license in
    let continuations =
      fill_continuations ~library_id ~majmin ~seckey ~rng
        dist_core.continuations
    in
    {
      id = Some (idrange, library_id, version);
      producer;
      license;
      continuations;
    }
  in

  (* Print *)
  MlFront_Thunk.ThunkDist.pp_core Format.std_formatter dist_core;
  Format.pp_print_flush Format.std_formatter ();
  prerr_newline ();
  flush stdout;

  (* Create dist.json *)
  let dist_file_fp =
    MlFront_Core.FilePath.append_exn
      (Printf.sprintf "%s.dist.json"
         (MlFront_Thunk.ThunkSemver64.to_string version))
      SecDist.dist_dir_fp
  in
  MlFront_Thunk_IoDisk.ThunkIoDisk.make_directory_recursively
    ~return:(function `Error msg -> quick_error msg | `Created -> ())
    SecDist.dist_dir_fp;
  let dist_json =
    Format.asprintf "%a" MlFront_Thunk.ThunkDist.pp_core dist_core
  in
  ShellCore.save_file ~contents:dist_json dist_file_fp;

  (* CI specifics *)
  match !ci with
  | GitHub -> do_github ~library_id ~majmin dist_core

and do_github ~library_id ~majmin dist_core =
  let workflow_dir = MlFront_Core.FilePath.of_string_exn ".github/workflows" in
  let workflow_file =
    MlFront_Core.FilePath.append_exn
      (Printf.sprintf "distribute-%Ld.%Ld.yml" (fst majmin) (snd majmin))
      workflow_dir
  in
  (* Get GitHub details *)
  let producer_github_slsa_v1_l2, producer_github_slsa_v1_l3 =
    match (dist_core : MlFront_Thunk.ThunkDist.DistCore.t) with
    | {
     id = _;
     producer =
       {
         producer_openbsd_signify = _;
         producer_github_slsa_v1_l2;
         producer_github_slsa_v1_l3;
       };
     license = _;
     continuations = _;
    } ->
        (producer_github_slsa_v1_l2, producer_github_slsa_v1_l3)
  in
  let caller_github_repository =
    match producer_github_slsa_v1_l3 with
    | Some
        {
          github_slsa_v1_l3_caller = _range, `Repository repo;
          github_slsa_v1_l3_signer = _;
        } ->
        Some repo
    | Some
        {
          github_slsa_v1_l3_caller = _, `Organization _;
          github_slsa_v1_l3_signer = _;
        }
    | None ->
    match producer_github_slsa_v1_l2 with
    | Some { github_slsa_v1_l2_repository = _range, repo } -> Some repo
    | None -> None
  in
  let gh_secret_instructions =
    match caller_github_repository with
    | Some repo ->
        let keypairname' = keypairname ~library_id ~majmin in
        (* Why [gh api] to create an environment?
        
        See https://github.com/cli/cli/issues/5149; mitigation is commented as
        https://stackoverflow.com/questions/70943164/create-environment-for-repository-using-gh/71388564#71388564 *)
        Printf.sprintf
          {|
You can set these secrets now with the GitHub CLI!
1. Download GitHub CLI from https://cli.github.com/.

2. Create the dk-distribution environment with:

  gh api --method PUT -H "Accept: application/vnd.github+json" repos/%s/environments/dk-distribution

3. Run the following, then copy and paste the text
("untrusted comment: ...|RW...") of the PUBLIC key
`%s`:

  gh secret set --repo %s --env dk-distribution %s

4. Run the following, then copy and paste the text
("untrusted comment: ...|RW...") of the SECRET key
`%s`:

  gh secret set --repo %s --env dk-distribution %s
|}
          repo keypairname' repo
          (distributionkey_secretname ~majmin `PublicKey)
          keypairname' repo
          (distributionkey_secretname ~majmin `SecretKey)
    | None -> ""
  in

  (* Create workflow file if needed *)
  if not (Sys.file_exists (MlFront_Core.FilePath.show workflow_file)) then begin
    (* No workflow file exists. *)
    let workflow_contents =
      let library_name = MlFront_Core.LibraryId.full_name library_id in
      let majmin_dot = Printf.sprintf "%Ld.%Ld" (fst majmin) (snd majmin) in
      let majmin_under = Printf.sprintf "%Ld_%Ld" (fst majmin) (snd majmin) in
      String.trim
      @@ Printf.sprintf
           {|
name: %s@%s.x
on:
  push:
    tags:
      - '%s.*' # build if tag is pushed
  workflow_dispatch: # allow manual triggering from GitHub Actions page

jobs:
    distribute:
        runs-on: ubuntu-latest # or windows-latest or macos-latest
        if: github.ref_type == 'tag' && startsWith(github.ref_name, '%s.')
        permissions:
          id-token: write
          contents: write # for action-gh-release
          attestations: write

        # The secrets created by `dk0/mlfront-shell -- prepare-version --ci github VERSION`
        # are tied to this `dk-distribution` environment only.
        environment: dk-distribution
        steps:
            - name: Harden Runner # Optional but recommended
              uses: step-security/harden-runner@c6295a65d1254861815972266d5933fd6e532bdf # v2.11.1
              with: { egress-policy: audit }

            - name: Checkout project
              uses: actions/checkout@v5

            - name: Distribute Modules
              uses: diskuv/dk-distribute@v1
              with:
                  id: %s@${{ github.ref_name }}
                  # faster but less safe?   use-cache: true
                  pubkey: ${{ secrets.distribute_%s_pubkey }}
                  seckey: ${{ secrets.distribute_%s_seckey }}
# CHANGE THE `slots` FIELD!
#                 vvvvvvvv
                  slots: |
                    Debug.Agnostic
                    Release.Agnostic
# CHANGE THE `forms` FIELD!
#                 vvvvvvvv
                  forms: |
                    %s.Change.Me.Including.Version@1.2.3
                    %s.This.Should.Be.One.Of.Your.Forms@4.5.6

            - name: Generate artifact attestation
              id: attest
              uses: actions/attest-build-provenance@v3
              with: { subject-path: dk-dist/* }

            - name: Release ${{ github.workflow }}
              uses: softprops/action-gh-release@f38efdea4c5ffe13e9424b0aa2833bee28f1e34c # v2. Oct. 6, 2025
              with: { files: dk-dist/* }
|}
           library_name majmin_dot majmin_dot majmin_dot library_name
           majmin_under majmin_under library_name library_name
    in
    MlFront_Thunk_IoDisk.ThunkIoDisk.make_directory_recursively
      ~return:(function `Error msg -> quick_error msg | `Created -> ())
      workflow_dir;
    ShellCore.save_file ~contents:workflow_contents workflow_file
  end;

  (* Instructions for GitHub *)
  let keypairname' = keypairname ~library_id ~majmin in
  Printf.eprintf
    {|
------------

Your workflow `%s`
requires two GitHub secrets set in a `dk-distribution` environment
to sign the distributions:

  - `%s` - the public key for `%s`
  - `%s` - the secret key for `%s`
%s
Full docs at https://docs.github.com/en/actions/how-tos/write-workflows/choose-what-workflows-do/use-secrets#creating-secrets-for-an-environment.
%!|}
    (MlFront_Core.FilePath.to_string workflow_file)
    (distributionkey_secretname ~majmin `PublicKey)
    keypairname'
    (distributionkey_secretname ~majmin `SecretKey)
    keypairname' gh_secret_instructions

and fill_id ~majmin :
    (MlFront_Thunk.ThunkLexers.Ranges.range_plus
    * MlFront_Core.LibraryId.t
    * MlFront_Thunk.ThunkSemver64.t)
    option ->
    MlFront_Thunk.ThunkLexers.Ranges.range_plus
    * MlFront_Core.LibraryId.t
    * MlFront_Thunk.ThunkSemver64.t = function
  | Some (range, library_id, id) -> (range, library_id, id)
  | None -> (
      let rec ask () =
        Printf.printf
          {|
-----------------
Define Library Id
-----------------

The library id is the hierarchical base of all the modules that your
distributions export. It is in the three-part form `VendorQualifier_Unit`
like `FooBar_Baz` or `FooBar_FizzBizz`.

To share your modules with others and avoid naming conflicts, your library
id must be registered and have a distribution key (we'll generate one for
you later).

Good "Vendors" and "Qualifiers" relate to your domain or real name.
Reserved "Vendors" include:
  `Commons`, `Std`, `Dk`, `Ml`, `Our`, `Thunk`, `Zz`

A good "Unit" is either `Std`, or is related to your product or project.

Enter library id (leave blank to quit): %!|};
        flush stdout;
        try
          match String.trim (input_line stdin) with
          | "" ->
              prerr_endline "exited";
              exit 1
          | answer -> (
              print_endline answer;
              match MlFront_Core.LibraryId.parse answer with
              | Some id -> id
              | None ->
                  print_endline
                    "The library id must be in the form VendorQualifier_Unit";
                  ask ())
        with End_of_file ->
          prerr_endline "exited";
          exit 1
      in
      let library_id = ask () in
      let major = fst majmin in
      let minor = snd majmin in
      match MlFront_Thunk.ThunkSemver64.from_parts major minor 0L [] [] with
      | None ->
          Printf.eprintf "unexpected unparseable version %Ld.%Ld\n%!" major
            minor;
          exit 1
      | Some version -> (zerorangeplus, library_id, version))

and fill_producer ~library_id ~majmin ~rng :
    MlFront_Thunk.ThunkDist.DistCore.producer ->
    MlFront_Thunk.ThunkDist.DistCore.producer * [ `SecretKey of string ] =
  function
  | {
      producer_openbsd_signify = None;
      producer_github_slsa_v1_l2 = _;
      producer_github_slsa_v1_l3 = _;
    } ->
      ask_producer ~what:"current version" ~library_id ~majmin ~rng ()
  | {
      producer_openbsd_signify = Some { openbsd_signify_public_key };
      producer_github_slsa_v1_l2 = _;
      producer_github_slsa_v1_l3 = _;
    } as producer ->
      (* ask for seceret key that corresponds to [openbsd_signify_public_key] *)
      let rec ask () =
        Printf.printf
          {|
To sign the next versions for auth with public key:

%s

you must enter the secret key for `%s-%Ld.%Ld`, followed by a dot `.`
on a line by itself.

Please enter the secret key (`quit` to exit): %!|}
          (left_pad (String.trim (snd openbsd_signify_public_key)))
          (MlFront_Core.LibraryId.full_name library_id)
          (fst majmin) (snd majmin);
        match read_dot_terminated_text () with
        | None ->
            Printf.eprintf "quit\n%!";
            exit 1
        | Some answer -> (
            Printf.eprintf "received secret key\n%!";
            (* does it contain pipes? if so, change to newlines *)
            Assumptions.build_keys_have_no_pipes_and_store_pipe_separated ();
            let answer = String.map (function '|' -> '\n' | c -> c) answer in
            (* the format must be [COMMENT NEWLINE SECRET_KEY NEWLINE] *)
            let seckey = String.trim answer ^ "\n" in
            (* verify that the secret key can sign a message that can be auth'd by the public key *)
            let probe_message =
              Printf.sprintf "%Ld %Ld" (Random.bits64 ()) (Random.bits64 ())
            in
            match
              let probe_signature =
                MlFront_Signify.Signify.sign_message_exn ~seckey
                  ~message:probe_message ()
              in
              MlFront_Signify.Signify.verify_message
                ~pubkey:(snd openbsd_signify_public_key)
                ~message:probe_message ~signature_:probe_signature ()
            with
            | Error (`Msg msg) ->
                Printf.eprintf "secret key error: %s\n\n------\n%!" msg;
                ask ()
            | Ok _ -> `SecretKey seckey
            | exception Invalid_argument msg ->
                Printf.eprintf "secret key error: %s\n\n------\n%!" msg;
                ask ())
      in
      let packed_seckey = ask () in
      (producer, packed_seckey)

and fill_license :
    MlFront_Thunk.ThunkDist.DistCore.license ->
    MlFront_Thunk.ThunkDist.DistCore.license = function
  | { spdx = None; plaintext = None; markdown = None } -> ask_license ()
  | license -> license

and fill_continuations ~library_id ~majmin ~seckey ~rng
    (kont : MlFront_Thunk.ThunkDist.DistCore.continuations) :
    MlFront_Thunk.ThunkDist.DistCore.continuations =
  match majmin with
  | maj, min ->
      (* minor bump *)
      let kont =
        fill_continuations_version ~what:"next minor version bump" ~library_id
          ~majmin:(maj, Int64.succ min)
          ~rng kont
      in
      (* even minor bump *)
      let next_even n =
        if Int64.rem n 2L = 0L then Int64.(succ (succ n)) else Int64.succ n
      in
      let kont =
        fill_continuations_version ~what:"next even minor version bump"
          ~library_id
          ~majmin:(maj, next_even min)
          ~rng kont
      in
      (* major bump *)
      let kont =
        fill_continuations_version ~what:"next major version bump" ~library_id
          ~majmin:(Int64.succ maj, 0L)
          ~rng kont
      in
      (* sign the canonical id *)
      let signature_ =
        let canonical_continuations_to_sign_id =
          MlFront_Thunk.ThunkDist.canonical_continuations_to_sign_id
            kont.continuations_to_sign
        in
        MlFront_Signify.Signify.sign_message_exn ~seckey
          ~message:canonical_continuations_to_sign_id ()
      in
      let kont =
        {
          kont with
          continuations_attestation =
            Some
              {
                continuations_attestation_openbsd_signify =
                  Some
                    {
                      openbsd_signify_signature =
                        Some (zerorangeplus, signature_);
                    };
              };
        }
      in
      (* reverse [continuations_to_sign] to get correct insertion order *)
      let kont =
        {
          kont with
          continuations_to_sign = List.rev kont.continuations_to_sign;
        }
      in
      kont

and fill_continuations_version ~what ~library_id ~majmin ~rng :
    MlFront_Thunk.ThunkDist.DistCore.continuations ->
    MlFront_Thunk.ThunkDist.DistCore.continuations = function
  | { continuations_attestation = _; continuations_to_sign } as continuations
    when List.exists
           (fun ({ majmin = _range, major, minor; _ } :
                  MlFront_Thunk.ThunkDist.DistCore.continuation_to_sign) ->
             Int64.equal major (fst majmin) && Int64.equal minor (snd majmin))
           continuations_to_sign ->
      continuations
  | { continuations_attestation; continuations_to_sign } ->
      let producer, _seckey =
        producer_of_openbsd_signify ~what ~library_id ~majmin ~rng ()
      in
      {
        continuations_attestation;
        continuations_to_sign =
          { majmin = (zerorangeplus, fst majmin, snd majmin); producer }
          :: continuations_to_sign;
      }

and keypairname ~library_id ~majmin =
  Printf.sprintf "%s-%Ld.%Ld"
    (MlFront_Core.LibraryId.full_name library_id)
    (fst majmin) (snd majmin)

and pipe_separate_secret s =
  let s = MlFront_Thunk.ThunkLexers.Characters.dos2unix s in
  (* fail if the secret already contains a pipe *)
  if String.contains s '|' then failwith "The secret contains a pipe"
  else String.map (function '\n' -> '|' | c -> c) (String.trim s)

and create_openbsd_signify_key_pair ~what ~library_id ~majmin ~rng () :
    MlFront_Thunk.ThunkDist.DistCore.openbsd_signify_producer
    * [ `SecretKey of string ] =
  let keypairname' = keypairname ~library_id ~majmin in
  let `PublicKey pubkey, (`SecretKey seckey as packed_seckey) =
    let comment = keypairname' in
    SecCore.generate_build_keypair ~comment ~rng ()
  in
  let majmin_s = Printf.sprintf "%Ld.%Ld" (fst majmin) (snd majmin) in
  let rec ask () =
    let title =
      let title = Printf.sprintf "Key Pair for %s %s" what majmin_s in
      let title_len = String.length title in
      Printf.sprintf "%s\n%s\n%s"
        (String.make title_len '-')
        title
        (String.make title_len '-')
    in
    Printf.printf
      {|
%s

STORE the following key pair safely (ex. secure password manager) -or-
PRINT it and store it in two or more safe places.

    -- name of keypair --
%s

    -- public key %s --
%s

    -- secret key %s --
%s

Did you securely store the keypair above?

Y. Yes, I have saved the keypair
Q. Quit

Enter Y or Q: %!|}
      title keypairname' majmin_s
      (Assumptions.build_keys_have_no_pipes_and_store_pipe_separated ();
       pipe_separate_secret pubkey)
      majmin_s
      (Assumptions.build_keys_have_no_pipes_and_store_pipe_separated ();
       pipe_separate_secret seckey);
    try
      match String.trim (input_line stdin) with
      | answer when String.equal "Y" answer || String.equal "y" answer ->
          print_endline answer;
          ( MlFront_Thunk.ThunkDist.DistCore.
              { openbsd_signify_public_key = (zerorangeplus, pubkey) },
            packed_seckey )
      | answer when String.equal "Q" answer || String.equal "q" answer ->
          print_endline answer;
          prerr_endline "exited";
          exit 1
      | "" ->
          prerr_endline "exited";
          exit 1
      | _ -> ask ()
    with End_of_file ->
      prerr_endline "exited";
      exit 1
  in
  ask ()

and producer_of_openbsd_signify ~what ~library_id ~majmin ~rng () =
  let producer_openbsd_signify, seckey =
    create_openbsd_signify_key_pair ~what ~library_id ~majmin ~rng ()
  in
  ( MlFront_Thunk.ThunkDist.DistCore.
      {
        producer_openbsd_signify = Some producer_openbsd_signify;
        producer_github_slsa_v1_l2 = None;
        producer_github_slsa_v1_l3 = None;
      },
    seckey )

and ask_producer ~what ~library_id ~majmin ~rng () :
    MlFront_Thunk.ThunkDist.DistCore.producer * [ `SecretKey of string ] =
  let p, seckey =
    producer_of_openbsd_signify ~what ~library_id ~majmin ~rng ()
  in
  let producer = ref p in
  let rec ask () =
    print_string
      {|
----------------------------------------------
CI Identity Information for You (the Producer)
----------------------------------------------

1. (simple; most common) Enter GitHub SLSA v1 Level 2 details.
   https://docs.github.com/en/actions/how-tos/secure-your-work/use-artifact-attestations/use-artifact-attestations#generating-artifact-attestations-for-your-builds
   Details to attest (prove) that your builds have no tampering of values
   after GitHub Actions finishes.
2. (most secure) Enter GitHub SLSA v1 Level 3 details.
   https://docs.github.com/en/actions/how-tos/secure-your-work/use-artifact-attestations/increase-security-rating 
   Details to attest (prove) that there will be no tampering of values
   during your builds by using a known, vetted GitHub Actions script.
C. Continue without CI identity
Q. Quit

Enter 1, 2, C or Q: |};
    flush stdout;
    try
      match String.trim (input_line stdin) with
      | answer when String.equal "1" answer -> begin
          print_endline answer;
          match ask_github_slsa_v1_l2 () with
          | None -> ask ()
          | Some github_repository ->
              MlFront_Thunk.ThunkDist.DistCore.
                {
                  !producer with
                  producer_github_slsa_v1_l2 =
                    Some
                      {
                        github_slsa_v1_l2_repository =
                          (zerorangeplus, github_repository);
                      };
                }
        end
      | answer when String.equal "2" answer -> begin
          print_endline answer;
          match ask_github_slsa_v1_l3 () with
          | None -> ask ()
          | Some (org, github_signer_workflow) ->
              MlFront_Thunk.ThunkDist.DistCore.
                {
                  !producer with
                  producer_github_slsa_v1_l3 =
                    Some
                      {
                        github_slsa_v1_l3_caller = (zerorangeplus, org);
                        github_slsa_v1_l3_signer =
                          (zerorangeplus, github_signer_workflow);
                      };
                }
        end
      | answer when String.equal "C" answer || String.equal "c" answer ->
          !producer
      | answer when String.equal "Q" answer || String.equal "q" answer ->
          print_endline answer;
          prerr_endline "exited";
          exit 1
      | "" ->
          prerr_endline "exited";
          exit 1
      | _ -> ask ()
    with End_of_file ->
      prerr_endline "exited";
      exit 1
  in
  let producer = ask () in
  (producer, seckey)

and ask_github_slsa_v1_l2 () =
  let ask () =
    print_newline ();
    print_string "Enter GitHub repository (ex. \"owner/repo\"): ";
    flush stdout;
    try
      match String.trim (input_line stdin) with
      | "" -> None
      | answer ->
          print_endline answer;
          Some answer
    with End_of_file -> None
  in
  ask ()

and ask_organization_or_repo () :
    [ `Organization of string | `Repository of string ] option =
  let ask () =
    print_newline ();
    print_string
      "Enter GitHub organization (ex. \"owner\") or repository (ex. \
       \"owner/repo\" or \"host/owner/repo\"): ";
    flush stdout;
    try
      match String.trim (input_line stdin) with
      | "" -> None
      | answer ->
          let org_or_repo = String.trim answer in
          if String.contains org_or_repo '/' then Some (`Repository org_or_repo)
          else Some (`Organization org_or_repo)
    with End_of_file -> None
  in
  ask ()

and ask_signer_repo_or_workflow () :
    [ `Repository of string | `Workflow of string ] option =
  let ask () =
    print_newline ();
    print_string
      "Enter GitHub signer repository (ex. \
       \"REUSABLE_ORGANIZATION_NAME/REUSABLE_REPOSITORY_NAME\") or GitHub \
       signer workflow (ex. \
       \"REUSABLE_ORGANIZATION_NAME/REUSABLE_REPOSITORY_NAME/.github/workflows/reusable.yml\"): ";
    flush stdout;
    try
      match String.trim (input_line stdin) with
      | "" -> None
      | answer ->
          let repo_or_workflow = String.trim answer in
          if
            String.ends_with ~suffix:".yml" repo_or_workflow
            || String.ends_with ~suffix:".yaml" repo_or_workflow
          then Some (`Workflow repo_or_workflow)
          else Some (`Repository repo_or_workflow)
    with End_of_file -> None
  in
  ask ()

and ask_github_slsa_v1_l3 () :
    ([ `Organization of string | `Repository of string ]
    * [ `Repository of string | `Workflow of string ])
    option =
  let ask () =
    match ask_organization_or_repo () with
    | None -> None
    | Some org ->
    match ask_signer_repo_or_workflow () with
    | None -> None
    | Some github_signer_workflow -> Some (org, github_signer_workflow)
  in
  ask ()

and ask_license () : MlFront_Thunk.ThunkDist.DistCore.license =
  let rec ask () =
    print_string
      {|
--------------------------------
Define Your Distribution License
--------------------------------

1. Enter SPDX license (ex. "Apache-2.0"). Strongly permissive licenses
   like BlueOak-1.0.0, BSD-2-Clause-Patent and Apache-2.0 will not
   prompt your users to accept the license.
2. Enter plain license text
3. Enter license text in Markdown format
Q. Quit

Enter 1, 2, 3 or Q: |};
    flush stdout;
    try
      match String.trim (input_line stdin) with
      | answer when String.equal "1" answer -> begin
          print_endline answer;
          match ask_spdx_license () with
          | None -> ask ()
          | Some spdx ->
              {
                MlFront_Thunk.ThunkDist.DistCore.spdx =
                  Some (zerorangeplus, spdx);
                plaintext = None;
                markdown = None;
              }
        end
      | answer when String.equal "2" answer -> begin
          print_endline answer;
          match ask_plain_license () with
          | None -> ask ()
          | Some plaintext ->
              {
                MlFront_Thunk.ThunkDist.DistCore.spdx = None;
                plaintext = Some (zerorangeplus, plaintext);
                markdown = None;
              }
        end
      | answer when String.equal "3" answer -> begin
          print_endline answer;
          match ask_markdown_license () with
          | None -> ask ()
          | Some markdown ->
              {
                MlFront_Thunk.ThunkDist.DistCore.spdx = None;
                plaintext = None;
                markdown = Some (zerorangeplus, markdown);
              }
        end
      | answer when String.equal "Q" answer || String.equal "q" answer ->
          print_endline answer;
          prerr_endline "exited";
          exit 1
      | "" ->
          prerr_endline "exited";
          exit 1
      | _ -> ask ()
    with End_of_file ->
      prerr_endline "exited";
      exit 1
  in
  ask ()

and ask_spdx_license () =
  let ask () =
    print_string
      "Enter SPDX license identifier (ex. \"Apache-2.0\"; \"q\" to quit): ";
    flush stdout;
    try
      match String.trim (input_line stdin) with
      | "" -> None
      | ("Q" | "q") as quit ->
          print_endline quit;
          prerr_endline "exited";
          exit 1
      | answer ->
          print_endline answer;
          Some answer
    with End_of_file -> None
  in
  ask ()

and ask_plain_license () =
  let ask () =
    print_endline
      "Enter plain license text. End with a single dot (.) on a line by itself:";
    read_dot_terminated_text ()
  in
  ask ()

and ask_markdown_license () =
  let ask () =
    print_endline
      "Enter license text in Markdown format. End with a single dot (.) on a \
       line by itself:";
    read_dot_terminated_text ()
  in
  ask ()