Add lint checks for the archive repo (#412)

* Refactor lint checks to support optional kinds

Extends the Lint api to allow specifying sets of lint checks to run,
allowing us to control which kinds of checks we run in a given case.

The changes in this commit to not add any new checks, but in factoring
out the checks into distinct sets, we do change the order in which lint
errors are reported. The expectations for those tests are updated here
accordingly.

* Expose the check kinds from the CLI

Allows specifing subsets of the cli checks to run. Note that this commit
only updates tests to adapt to the new help output on our existing
erroneous CLI input tests. This all the content of tests stays the same.
This helps to show that this CLI change does not break our existing API.

* Add test of using the --checks flag

This shows that we can now just run a subset of the checks.

* Add linting check for upper bounds on archives

As per  https://github.com/ocaml/opam-repository/wiki/Package-Archiving:-Plan#preliminaries-for-phase-2-from-infra-team-ci

* Add lint for the x-reason-for-archiving field

* Add lint checks for x-opam-repository-commit-hash-at-time-of-archiving

* Avoid data fetch when not required by lint check

Only some of our lint checks require fetching data. This adds predicates
to record whether a set of checks requires fetching e.g., the newness of
a package or its source code, and avoids those fetches when not needed.

* Add --quiet flag for lint subcommand

Prevents output that is noisome when running in large batches.

opam-ci-check/bin/main.ml

@@ -62,30 +62,30 @@ type package_spec = {
   newly_published : bool option;
 }
 
-let lint package_specs local_repo_dir =
+let lint quiet checks package_specs local_repo_dir =
   match local_repo_dir with
   | None -> failwith "TODO: default to using the opam repository"
   | Some opam_repo_dir -> (
-      print_endline
-      @@ Printf.sprintf "Linting opam-repository at %s ..." opam_repo_dir;
+      if not quiet then
+        print_endline
+        @@ Printf.sprintf "Linting opam-repository at %s ..." opam_repo_dir;
       OpamFilename.with_tmp_dir @@ fun dir ->
       let process_package { pkg; src; newly_published } =
         let opam = read_package_opam ~opam_repo_dir pkg in
         let pkg_src_dir =
-          if Option.is_none src then
-            let dir =
-              OpamFilename.Dir.to_string dir // OpamPackage.to_string pkg
-            in
+          if Option.is_none src && Lint.Checks.wants_source checks then
+            let dir = OpamFilename.Dir.to_string dir // OpamPackage.to_string pkg in
             fetch_package_src ~dir ~pkg opam
-          else src
+          else
+            src
         in
         Lint.v ~pkg ~newly_published ~pkg_src_dir opam
       in
       let all_lint_packages = List.map process_package package_specs in
-      let errors = Lint.lint_packages ~opam_repo_dir all_lint_packages in
+      let errors = Lint.lint_packages ~checks:checks ~opam_repo_dir all_lint_packages in
       match errors with
       | Ok [] ->
-          print_endline "No errors";
+          if not quiet then print_endline "No errors";
           Ok ()
       | Ok errors ->
           errors |> List.map Lint.msg_of_error |> String.concat "\n"
@@ -304,8 +304,28 @@ let package_specs_term =
 
 let lint_cmd =
   let doc = "Lint the opam repository directory" in
+  let quiet =
+    Arg.(value @@ flag @@
+         info ["q"; "quiet"] ~doc:"Run without any extraneous output.")
+  in
+  let check_kinds : Lint.Checks.kind list Term.t =
+    let info = Arg.info [ "checks" ]
+        ~doc:"The kinds of lint checks to run. $(b,opam-file) for checks that \
+              should hold for any opam file. $(b,primary-repo) for the additional \
+              checks run on packages published on the primary opam repostory. \
+              $(b,archive-repo) for additional checks run on the opam archive \
+              repository."
+    in
+    let options = Arg.list (Arg.enum Lint.Checks.[
+        "opam-file", General_opam_file;
+        "primary-repo", Opam_repo_publication;
+        "archive-repo", Opam_repo_archive])
+    in
+    let defaults = Lint.Checks.[General_opam_file; Opam_repo_publication] in
+    Arg.value (Arg.opt options defaults info)
+  in
   let term =
-    Term.(const lint $ package_specs_term $ local_opam_repo_term)
+    Term.(const lint $ quiet $ check_kinds $ package_specs_term $ local_opam_repo_term)
     |> to_exit_code
   in
   let info =

opam-ci-check/lib/lint.ml

@@ -10,6 +10,20 @@ let get_files dir = dir |> Sys.readdir |> Array.to_list
 include Lint_error
 
 module Checks = struct
+  type kind =
+    | General_opam_file
+    | Opam_repo_publication
+    | Opam_repo_archive
+
+  (* The kinds of checks that need to take account of whether a package is newly published *)
+  let needs_newness : kind list -> bool
+    = List.mem Opam_repo_publication
+
+  (* The kinds of checks that want to inspect package source (tho it may not be available) *)
+  let wants_source : kind list -> bool
+    = List.mem Opam_repo_publication
+
+
   module Prefix = struct
     (* For context, see https://github.com/ocurrent/opam-repo-ci/pull/316#issuecomment-2160069803 *)
     let prefix_conflict_class_map =
@@ -336,36 +350,102 @@ module Checks = struct
         else None)
       other_pkgs
 
-  let checks ~newly_published ~opam_repo_dir ~pkg_src_dir repo_package_names =
-    let newly_published_checks =
+  let check_deps_have_upper_bounds ~pkg opam =
+    (* See https://github.com/ocaml/opam-repository/blob/master/governance/policies/archiving.md#archiving-a-package *)
+    let is_upper_bound_constraint
+      : OpamTypes.filter OpamTypes.filter_or_constraint -> bool
+      = function
+        | Constraint ((`Eq | `Leq | `Lt), _) -> true
+        | _ -> false
+    in
+    OpamFile.OPAM.depends opam
+    |> OpamFormula.fold_left (fun acc ((name, condition) : OpamTypes.name * OpamTypes.condition) ->
+        if OpamPackage.Name.to_string name = "ocaml" (* The compiler is special *)
+        || OpamFormula.exists is_upper_bound_constraint condition
+        then
+          acc
+        else
+          (pkg, MissingUpperBound (OpamPackage.Name.to_string name)) :: acc
+      )
+      []
+
+  let check_x_reason_for_archival ~pkg opam =
+    let is_valid_reason (item : OpamParserTypes.FullPos.value) =
+      match item.pelem with
+      | String reason -> List.mem reason x_reason_for_archiving_valid_reasons
+      | _ -> false (* Must be a string *)
+    in
+    opam
+    |> OpamFile.OPAM.extensions
+    |> OpamStd.String.Map.find_opt x_reason_for_archiving_field
+    |> function
+    | None ->
+      [(pkg, InvalidReasonForArchiving)] (* Field must be present *)
+    | Some field ->
+      match field.pelem with
+      (* Must be a non-empty list of valid reasons *)
+      | List {pelem = (_::_ as reasons); _} when List.for_all is_valid_reason reasons -> []
+      | _ -> [(pkg, InvalidReasonForArchiving)]
+
+  let x_opam_repository_commit_hash_at_time_of_archival ~pkg  opam  =
+    opam
+    |> OpamFile.OPAM.extensions
+    |> OpamStd.String.Map.find_opt x_opam_repository_commit_hash_at_time_of_archiving_field
+    |> function
+    | Some {pelem = String _; _} -> []
+    | _ -> [(pkg, InvalidOpamRepositoryCommitHash)]
+
+  let checks kinds ~newly_published ~opam_repo_dir ~pkg_src_dir repo_package_names =
+    let general_opam_file_checks () =
       [
-        check_name_collisions repo_package_names;
-        Prefix.check_name_restricted_prefix;
+        opam_lint;
       ]
     in
-    let checks =
+    let opam_repo_publication_checks () =
+      let newly_published_checks =
+        [
+          check_name_collisions repo_package_names;
+          Prefix.check_name_restricted_prefix;
+        ]
+      in
+      let checks =
+        [
+          check_dune_subst;
+          check_name_field;
+          check_version_field;
+          check_dune_constraints ~pkg_src_dir;
+          check_checksums;
+          check_package_dir ~opam_repo_dir;
+          check_maintainer_contact;
+          check_tags;
+          check_no_pin_depends;
+          check_no_extra_files;
+          Prefix.check_prefix_conflict_class_mismatch;
+        ]
+      in
+      if newly_published then checks @ newly_published_checks else checks
+    in
+    let opam_repo_archive_checks () =
       [
-        check_name_field;
-        check_version_field;
-        check_dune_subst;
-        check_dune_constraints ~pkg_src_dir;
-        check_checksums;
-        check_package_dir ~opam_repo_dir;
-        opam_lint;
-        check_maintainer_contact;
-        check_tags;
-        check_no_pin_depends;
-        check_no_extra_files;
-        Prefix.check_prefix_conflict_class_mismatch;
+        check_deps_have_upper_bounds;
+        check_x_reason_for_archival;
+        x_opam_repository_commit_hash_at_time_of_archival;
       ]
     in
-    if newly_published then checks @ newly_published_checks else checks
+    List.concat_map
+      (function
+        | General_opam_file -> general_opam_file_checks ()
+        | Opam_repo_publication -> opam_repo_publication_checks ()
+        | Opam_repo_archive -> opam_repo_archive_checks ())
+      kinds
+
 
-  let lint_package ~opam_repo_dir ~pkg ~pkg_src_dir ~repo_package_names
+  let lint_package
+      ~kinds
+      ~opam_repo_dir ~pkg ~pkg_src_dir ~repo_package_names
       ~newly_published opam =
-    checks ~newly_published ~opam_repo_dir ~pkg_src_dir repo_package_names
-    |> List.map (fun f -> f ~pkg opam)
-    |> List.concat
+    checks kinds ~newly_published ~opam_repo_dir ~pkg_src_dir repo_package_names
+    |> List.concat_map (fun f -> f ~pkg opam)
 end
 
 type t = {
@@ -395,17 +475,25 @@ let is_newly_published ~opam_repo_dir pkg =
 let get_package_names repo_dir =
   get_files (repo_dir // "packages") |> List.sort String.compare
 
-let lint_packages ~opam_repo_dir metas =
+let lint_packages
+    ?(checks=Checks.[General_opam_file; Opam_repo_publication])
+    ~opam_repo_dir
+    metas
+  =
   if Sys.file_exists (opam_repo_dir // "packages") then
     let repo_package_names = get_package_names opam_repo_dir in
     metas
     |> List.map (fun { pkg; newly_published; pkg_src_dir; opam } ->
            let newly_published =
              match newly_published with
              | Some v -> v
-             | None -> is_newly_published ~opam_repo_dir pkg
+             | None ->
+               if Checks.needs_newness checks then
+                 is_newly_published ~opam_repo_dir pkg
+               else
+                 false
            in
-           Checks.lint_package ~opam_repo_dir ~pkg ~pkg_src_dir
+           Checks.lint_package ~kinds:checks ~opam_repo_dir ~pkg ~pkg_src_dir
              ~repo_package_names ~newly_published opam)
     |> List.concat |> Result.ok
   else Error (Printf.sprintf "Invalid opam repository: %s" opam_repo_dir)

opam-ci-check/lib/lint.mli

@@ -5,6 +5,15 @@
 include module type of Lint_error
 
 module Checks : sig
+  type kind =
+    | General_opam_file (** Linting checks run for all opam files in general *)
+    | Opam_repo_publication (** Linting checks run on the primary opam repo *)
+    | Opam_repo_archive (** Linting checks run on the opam archive repo *)
+
+  val wants_source : kind list -> bool
+  (** [wants_source checks] is [true] iff the kinds of [checks] want to inspect the
+      package's source code *)
+
   val package_name_collision : string -> string -> bool
   (** [package_name_collision p0 p1] returns true if [p0] is similar to [p1].
     Similarity is defined to be:
@@ -14,6 +23,7 @@ module Checks : sig
 end
 
 type t
+(** The data describing a package that is needed for linting it. *)
 
 val v :
   pkg:OpamPackage.t ->
@@ -31,6 +41,7 @@ val v :
  *)
 
 val lint_packages :
+  ?checks: Checks.kind list ->
   opam_repo_dir:string ->
   t list ->
   ((OpamPackage.t * error) list, string) result

opam-ci-check/lib/lint_error.ml

@@ -36,9 +36,19 @@ type error =
   | RestrictedPrefix of string
   | PrefixConflictClassMismatch of prefix_conflict_class_mismatch
   | DefaultTagsPresent of string list
+  | MissingUpperBound of string
+  | InvalidReasonForArchiving
+  | InvalidOpamRepositoryCommitHash
 
 (**/**)
 
+(* These x_ fields are used in the opam repo archive *)
+let x_reason_for_archiving_field = "x-reason-for-archiving"
+let x_reason_for_archiving_valid_reasons =
+  ["ocaml-version"; "source-unavailable"; "maintenance-intent"; "uninstallable" ]
+let x_opam_repository_commit_hash_at_time_of_archiving_field =
+  "x-opam-repository-commit-hash-at-time-of-archiving"
+
 let msg_of_prefix_conflict_class_mismatch ~pkg = function
   | WrongPrefix { conflict_class; required_prefix } ->
       Printf.sprintf
@@ -163,3 +173,19 @@ let msg_of_error (package, (err : error)) =
         "Warning in %s: The package has not replaced the following default, \
          example tags: %s"
         pkg (String.concat ", " tags)
+  | MissingUpperBound dep_name ->
+      Printf.sprintf
+        "Error in %s: An upper bound constraint is missing on dependency '%s'"
+        pkg dep_name
+  | InvalidReasonForArchiving ->
+      Printf.sprintf
+        "Error in %s: The field '%s' must be present and hold a nonempty list \
+         of one or more of the valid reasons %s"
+        pkg x_reason_for_archiving_field
+        (String.concat ", " x_reason_for_archiving_valid_reasons)
+  | InvalidOpamRepositoryCommitHash ->
+      Printf.sprintf
+        "Error in %s: The field '%s' must be present and hold a string \
+         recording the commit hash of the primary repo at the time the package \
+         version is archived."
+        pkg x_opam_repository_commit_hash_at_time_of_archiving_field