From ddb7cdd7d0c09e1f4a4d6f6e20db4b7f67bcc76b Mon Sep 17 00:00:00 2001 From: Alpha DIALLO Date: Thu, 5 Oct 2023 18:10:44 +0200 Subject: [PATCH] Fixing the issue of the CI not responding With Mark Elvers we identify where the issue about the CI not responding when there's a lot of activity, meaning when there's a new push in opam-repo the analysis of all user repositroy is restarted. An analysis makes a tmp copy of an user repository in order to extract all the information needed for the solver-service. There's some IO access involved and take time when there's a lot of analysis running at same time in the CI. This is an attempt to fix that, by cache the extraction without keep doing it for each new opam repository commit. --- gitlab/pipeline.ml | 5 +- lib/analyse.ml | 181 +++++------------------------ lib/analyse.mli | 5 +- lib/analyse_ocamlformat.ml | 9 +- lib/analyse_ocamlformat.mli | 9 +- lib/opam_monorepo.ml | 5 +- lib/opam_monorepo.mli | 2 +- lib/repo_content.ml | 217 +++++++++++++++++++++++++++++++++++ lib/repo_content.mli | 20 ++++ service/pipeline.ml | 5 +- test/service/test_analyse.ml | 11 +- 11 files changed, 295 insertions(+), 174 deletions(-) create mode 100644 lib/repo_content.ml create mode 100644 lib/repo_content.mli diff --git a/gitlab/pipeline.ml b/gitlab/pipeline.ml index e63488a1..04e2e281 100644 --- a/gitlab/pipeline.ml +++ b/gitlab/pipeline.ml @@ -187,9 +187,10 @@ let local_test ~solver repo () = Conf.fetch_platforms ~include_macos:false ~include_freebsd:false () in let src = Git.Local.head_commit repo in + let src_content = Repo_content.extract src in let repo = Current.return { Repo_id.owner = "local"; name = "test" } and analysis = - Analyse.examine ~solver ~platforms ~opam_repository_commit src + Analyse.examine ~solver ~platforms ~opam_repository_commit src src_content in Current.component "summarise" |> let> results = build_with_docker ~repo ~analysis ~platforms src in @@ -227,8 +228,10 @@ let v ?ocluster ~app ~solver ~migrations () = refs |> Current.list_iter (module Gitlab.Api.Commit) @@ fun head -> let src = Git.fetch (Current.map Gitlab.Api.Commit.id head) in + let src_content = Repo_content.extract src in let analysis = Analyse.examine ~solver ~platforms ~opam_repository_commit src + src_content in let* on_cancel = match ocluster with diff --git a/lib/analyse.ml b/lib/analyse.ml index 75799818..d73c651f 100644 --- a/lib/analyse.ml +++ b/lib/analyse.ml @@ -1,26 +1,11 @@ open Lwt.Infix open Current.Syntax module Worker = Ocaml_ci_api.Worker +module Content = Repo_content.Content -let pool = Current.Pool.create ~label:"analyse" 20 - -let is_empty_file x = - match Unix.lstat (Fpath.to_string x) with - | Unix.{ st_kind = S_REG; st_size = 0; _ } -> true - | _ -> false - +let pool = Current.Pool.create ~label:"analyse" 150 let ( >>!= ) = Lwt_result.bind -let read_file ~max_len path = - Lwt_io.with_file ~mode:Lwt_io.input path (fun ch -> - Lwt_io.length ch >>= fun len -> - let len = - if len <= Int64.of_int max_len then Int64.to_int len - else Fmt.failwith "File %S too big (%Ld bytes)" path len - in - let buf = Bytes.create len in - Lwt_io.read_into_exactly ch buf 0 len >|= fun () -> Bytes.to_string buf) - (* A logging service that logs to [job]. *) let job_log job = let module X = Ocaml_ci_api.Raw.Solve.Service.Log in @@ -58,81 +43,6 @@ module Analysis = struct let ocamlformat_selection t = t.ocamlformat_selection let ocamlformat_source t = t.ocamlformat_source let selections t = t.selections - let is_test_dir = Astring.String.is_prefix ~affix:"test" - - let check_opam_version = - let version_2 = OpamVersion.of_string "2" in - fun name opam -> - let opam_version = OpamFile.OPAM.opam_version opam in - if OpamVersion.compare opam_version version_2 < 0 then - Fmt.failwith "Package %S uses unsupported opam version %s (need >= 2)" - name - (OpamVersion.to_string opam_version) - - (* For each package in [root_pkgs], parse the opam file and check whether it uses pin-depends. - Fetch and return all pinned opam files. Also, ensure we're using opam format version 2. *) - let handle_opam_files ~job ~root_pkgs ~pinned_pkgs = - pinned_pkgs - |> List.iter (fun (name, contents) -> - check_opam_version name (OpamFile.OPAM.read_from_string contents)); - let pin_depends = - root_pkgs - |> List.map (fun (name, contents) -> - let opam = - try OpamFile.OPAM.read_from_string contents - with ex -> - Fmt.failwith "Invalid opam file %S: %a" name Fmt.exn ex - in - check_opam_version name opam; - let pin_depends = OpamFile.OPAM.pin_depends opam in - pin_depends - |> List.map (fun (pkg, url) -> - Current.Job.log job "%s: found pin-depends: %s -> %s" name - (OpamPackage.to_string pkg) - (OpamUrl.to_string url); - (name, pkg, url))) - |> List.concat - in - pin_depends - |> Lwt_list.map_s (fun (root_pkg, pkg, url) -> - Lwt.catch - (fun () -> - Pin_depends.get_opam ~job ~pkg url >|= fun contents -> - (OpamPackage.to_string pkg, contents)) - (function - | Failure msg -> - Fmt.failwith "%s (processing pin-depends in %s)" msg root_pkg - | ex -> Lwt.fail ex)) - - let opam_selections ~solve ~job ~platforms ~opam_files dir = - let src = Fpath.to_string dir in - let ( / ) = Filename.concat in - opam_files - |> Lwt_list.fold_left_s - (fun (root_pkgs, pinned_pkgs) path -> - let name = Filename.basename path |> Filename.chop_extension in - let name = - if String.contains name '.' then name else name ^ ".dev" - in - read_file ~max_len:102400 (src / path) >|= fun file -> - let item = (name, file) in - if Filename.dirname path = "." then (item :: root_pkgs, pinned_pkgs) - else (root_pkgs, item :: pinned_pkgs)) - ([], []) - >>= fun (root_pkgs, pinned_pkgs) -> - Lwt.try_bind - (fun () -> handle_opam_files ~job ~root_pkgs ~pinned_pkgs) - (fun pin_depends -> - let pinned_pkgs = pin_depends @ pinned_pkgs in - Lwt_result.map - (fun selections -> `Opam_build selections) - (solve ~root_pkgs ~pinned_pkgs ~platforms)) - (function Failure msg -> Lwt_result.fail (`Msg msg) | ex -> Lwt.fail ex) - - let type_of_dir dir = - match Opam_monorepo.detect ~dir with - | Some info -> `Opam_monorepo info - | None -> `Ocaml_repo (** Call the solver with a request containing these packages. When it returns a list, it is nonempty. *) @@ -153,6 +63,8 @@ module Analysis = struct root_pkgs; pinned_pkgs; platforms; + (* TODO ocamlformat in the request (option)*) + (* TODO opam_monorepo in the request (option)*) } in Current.Job.log job "Solving with opam-repository commit: %a" @@ -235,76 +147,32 @@ module Analysis = struct Ocaml_version.compare (Variant.ocaml_version v0) (Variant.ocaml_version v1)) - let of_dir ~solver ~job ~platforms ~opam_repository_commit root = - let cancelled = Atomic.make None in - let fold_on_opam_files () = - let module M = struct - exception Exit of string - end in - let module S = Astring.String.Set in - let opam_files full_path = - let path = Option.get (Fpath.rem_prefix root full_path) in - let consider_opam_file = - match Fpath.segs path with - | [] | [ _ ] -> true - | segs -> - if List.exists is_test_dir segs then ( - Current.Job.log job "Ignoring test directory %a" Fpath.pp path; - false) - else true - in - if is_empty_file full_path then ( - Current.Job.log job "WARNING: ignoring empty opam file %a" Fpath.pp - path; - None) - else if consider_opam_file then Some path - else None - in - let is_opam_ext path = Ok (Fpath.has_ext "opam" path) in - let traverse path = - match Fpath.rem_prefix root path with - (* maxdepth=3 *) - | Some suffix -> Ok (List.compare_length_with (Fpath.segs suffix) 3 <= 0) - | None when Fpath.equal root path -> Ok true - | None -> - Fmt.error_msg "%a is not a prefix of %a" Fpath.pp root Fpath.pp path - in - let add_opam_files path acc = - Option.iter (fun s -> raise_notrace (M.Exit s)) (Atomic.get cancelled); - match opam_files path with - | Some path -> S.add (Fpath.to_string path) acc - | None -> acc - in - (try - Bos.OS.Path.fold ~elements:(`Sat is_opam_ext) ~traverse:(`Sat traverse) - add_opam_files S.empty [ root ] - with M.Exit reason -> - Fmt.error_msg "Cancelling opam file lookup (%s)" reason) - |> Result.map S.elements - in - Current.Job.on_cancel job (fun reason -> - Atomic.set cancelled (Some reason); - Lwt.return_unit) - >>= fun () -> - Lwt_preemptive.detach fold_on_opam_files () >>!= fun opam_files -> + let of_content ~solver ~job ~platforms ~opam_repository_commit src = + let opam_files = Content.opam_files src in + let version = Content.ocamlformat_version src in let solve = solve ~opam_repository_commit ~job ~solver in let find_opam_repo_commit = find_opam_repo_commit_for_ocamlformat ~solve ~platforms:(filter_linux_x86_64_platforms platforms) in - Analyse_ocamlformat.get_ocamlformat_source job ~opam_files ~root + Analyse_ocamlformat.get_ocamlformat_source job ~opam_files ~version ~find_opam_repo_commit >>!= fun (ocamlformat_source, ocamlformat_selection) -> if opam_files = [] then Lwt_result.fail (`Msg "No opam files found!") else if List.filter Fpath.is_seg opam_files = [] then Lwt_result.fail (`Msg "No top-level opam files found!") else - (match type_of_dir root with + (match Content.dir_type src with | `Opam_monorepo builds -> lwt_result_list_mapm builds ~f:(fun info -> Opam_monorepo.selection ~info ~solve ~platforms) |> Lwt_result.map (fun l -> `Opam_monorepo l) - | `Ocaml_repo -> opam_selections ~solve ~job ~platforms ~opam_files root) + | `Ocaml_repo -> + let root_pkgs = Content.root_pkgs src in + let pinned_pkgs = Content.pinned_pkgs src in + Lwt_result.map + (fun selections -> `Opam_build selections) + (solve ~root_pkgs ~pinned_pkgs ~platforms)) >>!= fun selections -> let r = { opam_files; ocamlformat_selection; ocamlformat_source; selections } @@ -330,6 +198,7 @@ module Examine = struct type t = { opam_repository_commit : Current_git.Commit_id.t; platforms : (Variant.t * Worker.Vars.t) list; + src_content : Repo_content.Content.t; } let platform_to_yojson (variant, vars) = @@ -339,13 +208,14 @@ module Examine = struct ("vars", Worker.Vars.to_yojson vars); ] - let digest { opam_repository_commit; platforms } = + let digest { opam_repository_commit; platforms; src_content } = let json = `Assoc [ ( "opam-repository", `String (Current_git.Commit_id.hash opam_repository_commit) ); ("platforms", `List (List.map platform_to_yojson platforms)); + ("src_content", `String (Repo_content.Content.marshal src_content)); ] in Yojson.Safe.to_string json @@ -355,10 +225,11 @@ module Examine = struct let id = "ci-analyse" - let run solver job src { Value.opam_repository_commit; platforms } = - Current.Job.start job ~level:Current.Level.Harmless >>= fun () -> - Current_git.with_checkout ~job ~pool src @@ fun src -> - Analysis.of_dir ~solver ~platforms ~opam_repository_commit ~job src + let run solver job _ { Value.opam_repository_commit; platforms; src_content } + = + Current.Job.start job ~pool ~level:Current.Level.Harmless >>= fun () -> + Analysis.of_content ~solver ~platforms ~opam_repository_commit ~job + src_content let pp f _ = Fmt.string f "Analyse" let auto_cancel = true @@ -367,12 +238,12 @@ end module Examine_cache = Current_cache.Generic (Examine) -let examine ~solver ~platforms ~opam_repository_commit src = +let examine ~solver ~platforms ~opam_repository_commit src src_content = Current.component "Analyse" - |> let> src and> opam_repository_commit and> platforms in + |> let> src and> opam_repository_commit and> platforms and> src_content in let platforms = platforms |> List.map (fun { Platform.variant; vars; _ } -> (variant, vars)) in Examine_cache.run solver src - { Examine.Value.opam_repository_commit; platforms } + { Examine.Value.opam_repository_commit; platforms; src_content } diff --git a/lib/analyse.mli b/lib/analyse.mli index e718a478..738f16d0 100644 --- a/lib/analyse.mli +++ b/lib/analyse.mli @@ -12,12 +12,12 @@ module Analysis : sig [ `Opam_build of Selection.t list | `Opam_monorepo of Opam_monorepo.config list ] - val of_dir : + val of_content : solver:Backend_solver.t -> job:Current.Job.t -> platforms:(Variant.t * Ocaml_ci_api.Worker.Vars.t) list -> opam_repository_commit:Current_git.Commit_id.t -> - Fpath.t -> + Repo_content.Content.t -> (t, [ `Msg of string ]) result Lwt.t end @@ -26,6 +26,7 @@ val examine : platforms:Platform.t list Current.t -> opam_repository_commit:Current_git.Commit_id.t Current.t -> Current_git.Commit.t Current.t -> + Repo_content.Content.t Current.t -> Analysis.t Current.t (** [examine ~solver ~platforms ~opam_repository_commit src] analyses the source code [src] and selects package versions to test using diff --git a/lib/analyse_ocamlformat.ml b/lib/analyse_ocamlformat.ml index c7d5a5c4..edd2029d 100644 --- a/lib/analyse_ocamlformat.ml +++ b/lib/analyse_ocamlformat.ml @@ -73,9 +73,8 @@ let ocamlformat_version_from_file ~root job path = | _ :: _ :: _ -> Lwt.return (Error (`Msg "Multiple 'version=' lines in .ocamlformat")) -let get_ocamlformat_source job ~opam_files ~root ~find_opam_repo_commit = +let get_ocamlformat_source job ~opam_files ~version ~find_opam_repo_commit = let open Lwt.Infix in - let ( let* ) = Lwt_result.Infix.( >>= ) in let proj_is_ocamlformat p = String.equal (Filename.basename p) "ocamlformat.opam" in @@ -84,11 +83,7 @@ let get_ocamlformat_source job ~opam_files ~root ~find_opam_repo_commit = let path = Filename.dirname opam_file in Lwt_result.return (Some (Vendored { path }), None) | None -> ( - let* version_in_dot_ocamlformat = - ocamlformat_version_from_file ~root job - Fpath.(to_string (root / ".ocamlformat")) - in - match version_in_dot_ocamlformat with + match version with | None -> Lwt_result.return (None, None) | Some version -> ( find_opam_repo_commit version >>= function diff --git a/lib/analyse_ocamlformat.mli b/lib/analyse_ocamlformat.mli index f3b019db..6325a920 100644 --- a/lib/analyse_ocamlformat.mli +++ b/lib/analyse_ocamlformat.mli @@ -10,10 +10,17 @@ type source = val pp_source : source Fmt.t (** Pretty print [source]. *) +val ocamlformat_version_from_file : + root:Fpath.t -> + Current.Job.t -> + string -> + (string option, [ `Msg of string ]) Lwt_result.t +(** Extract the version in .ocamlformat file if the file exists in the project *) + val get_ocamlformat_source : Current.Job.t -> opam_files:string list -> - root:Fpath.t -> + version:string option -> find_opam_repo_commit: (string -> (string * Selection.t, [ `Msg of string ]) Lwt_result.t) -> (source option * Selection.t option, [ `Msg of string ]) Lwt_result.t diff --git a/lib/opam_monorepo.ml b/lib/opam_monorepo.ml index 8f9c3aca..1044c85a 100644 --- a/lib/opam_monorepo.ml +++ b/lib/opam_monorepo.ml @@ -1,4 +1,4 @@ -type info = string * OpamFile.OPAM.t +type info = string * string [@@deriving yojson] type lock_file_version = V0_2 | V0_3 [@@deriving yojson, ord] (** The kind of switch the package will be built in. *) @@ -58,7 +58,7 @@ let detect ~dir = OpamFile.OPAM.read (OpamFile.make (OpamFilename.of_string full_path)) in let* _ = x_opam_monorepo_version lock_file_contents in - Some (lock_file_path, lock_file_contents)) + Some (lock_file_path, OpamFile.OPAM.write_to_string lock_file_contents)) let packages_in_depends f = let get_atom = function OpamFormula.Atom a -> a | _ -> assert false in @@ -124,6 +124,7 @@ let adjust_ocaml_version platform ~version = let selection ~info:(lock_file_path, lock_file) ~platforms ~solve = let open Lwt_result.Infix in + let lock_file = OpamFile.OPAM.read_from_string lock_file in let ocaml_version = opam_monorepo_dep_version ~lock_file ~package:"ocaml" in let dune_version = opam_monorepo_dep_version ~lock_file ~package:"dune" in let lock_file_version = diff --git a/lib/opam_monorepo.mli b/lib/opam_monorepo.mli index bc423582..4ce28c7d 100644 --- a/lib/opam_monorepo.mli +++ b/lib/opam_monorepo.mli @@ -1,6 +1,6 @@ (** Generate obuilder specs for building opam packages with opam-monorepo. *) -type info +type info [@@deriving yojson] val detect : dir:Fpath.t -> info list option (** Detect whether a project uses opam-monorepo or something else. *) diff --git a/lib/repo_content.ml b/lib/repo_content.ml new file mode 100644 index 00000000..5bfb593b --- /dev/null +++ b/lib/repo_content.ml @@ -0,0 +1,217 @@ +open Lwt.Infix +open Current.Syntax +module Commit = Current_git.Commit +module Commit_id = Current_git.Commit_id + +let pool = Current.Pool.create ~label:"extract_commit" 20 + +let is_empty_file x = + match Unix.lstat (Fpath.to_string x) with + | Unix.{ st_kind = S_REG; st_size = 0; _ } -> true + | _ -> false + +let ( >>!= ) = Lwt_result.bind + +let read_file ~max_len path = + Lwt_io.with_file ~mode:Lwt_io.input path (fun ch -> + Lwt_io.length ch >>= fun len -> + let len = + if len <= Int64.of_int max_len then Int64.to_int len + else Fmt.failwith "File %S too big (%Ld bytes)" path len + in + let buf = Bytes.create len in + Lwt_io.read_into_exactly ch buf 0 len >|= fun () -> Bytes.to_string buf) + +module Content = struct + type t = { + opam_files : string list; + root_pkgs : (string * string) list; + pinned_pkgs : (string * string) list; + ocamlformat_version : string option; + dir_type : [ `Opam_monorepo of Opam_monorepo.info list | `Ocaml_repo ]; + } + [@@deriving yojson] + + let marshal t = to_yojson t |> Yojson.Safe.to_string + + let unmarshal s = + match Yojson.Safe.from_string s |> of_yojson with + | Ok x -> x + | Error e -> failwith e + + let root_pkgs t = t.root_pkgs + let pinned_pkgs t = t.pinned_pkgs + let ocamlformat_version t = t.ocamlformat_version + let opam_files t = t.opam_files + let dir_type t = t.dir_type + let is_test_dir = Astring.String.is_prefix ~affix:"test" + + let check_opam_version = + let version_2 = OpamVersion.of_string "2" in + fun name opam -> + let opam_version = OpamFile.OPAM.opam_version opam in + if OpamVersion.compare opam_version version_2 < 0 then + Fmt.failwith "Package %S uses unsupported opam version %s (need >= 2)" + name + (OpamVersion.to_string opam_version) + + (* For each package in [root_pkgs], parse the opam file and check whether it uses pin-depends. + Fetch and return all pinned opam files. Also, ensure we're using opam format version 2. *) + let handle_opam_files ~job ~root_pkgs ~pinned_pkgs = + pinned_pkgs + |> List.iter (fun (name, contents) -> + check_opam_version name (OpamFile.OPAM.read_from_string contents)); + let pin_depends = + root_pkgs + |> List.map (fun (name, contents) -> + let opam = + try OpamFile.OPAM.read_from_string contents + with ex -> + Fmt.failwith "Invalid opam file %S: %a" name Fmt.exn ex + in + check_opam_version name opam; + let pin_depends = OpamFile.OPAM.pin_depends opam in + pin_depends + |> List.map (fun (pkg, url) -> + Current.Job.log job "%s: found pin-depends: %s -> %s" name + (OpamPackage.to_string pkg) + (OpamUrl.to_string url); + (name, pkg, url))) + |> List.concat + in + pin_depends + |> Lwt_list.map_s (fun (root_pkg, pkg, url) -> + Lwt.catch + (fun () -> + Pin_depends.get_opam ~job ~pkg url >|= fun contents -> + (OpamPackage.to_string pkg, contents)) + (function + | Failure msg -> + Fmt.failwith "%s (processing pin-depends in %s)" msg root_pkg + | ex -> Lwt.fail ex)) + + let get_all_pinned_pkgs job opam_files dir = + let src = Fpath.to_string dir in + let ( / ) = Filename.concat in + opam_files + |> Lwt_list.fold_left_s + (fun (root_pkgs, pinned_pkgs) path -> + let name = Filename.basename path |> Filename.chop_extension in + let name = + if String.contains name '.' then name else name ^ ".dev" + in + read_file ~max_len:102400 (src / path) >|= fun file -> + let item = (name, file) in + if Filename.dirname path = "." then (item :: root_pkgs, pinned_pkgs) + else (root_pkgs, item :: pinned_pkgs)) + ([], []) + >>= fun (root_pkgs, pinned_pkgs) -> + Lwt.try_bind + (fun () -> handle_opam_files ~job ~root_pkgs ~pinned_pkgs) + (fun pin_depends -> + Lwt_result.return (root_pkgs, pin_depends @ pinned_pkgs)) + (function Failure msg -> Lwt_result.fail (`Msg msg) | ex -> Lwt.fail ex) + + let get_ocamlformat_version job ~root = + Analyse_ocamlformat.ocamlformat_version_from_file ~root job + Fpath.(to_string (root / ".ocamlformat")) + + let type_of_dir dir : + [ `Opam_monorepo of Opam_monorepo.info list | `Ocaml_repo ] = + match Opam_monorepo.detect ~dir with + | Some info -> `Opam_monorepo info + | None -> `Ocaml_repo + + let of_dir ~job root = + let dir_type = type_of_dir root in + let cancelled = Atomic.make None in + let fold_on_opam_files () = + let module M = struct + exception Exit of string + end in + let module S = Astring.String.Set in + let opam_files full_path = + let path = Option.get (Fpath.rem_prefix root full_path) in + let consider_opam_file = + match Fpath.segs path with + | [] | [ _ ] -> true + | segs -> + if List.exists is_test_dir segs then ( + Current.Job.log job "Ignoring test directory %a" Fpath.pp path; + false) + else true + in + if is_empty_file full_path then ( + Current.Job.log job "WARNING: ignoring empty opam file %a" Fpath.pp + path; + None) + else if consider_opam_file then Some path + else None + in + let is_opam_ext path = Ok (Fpath.has_ext "opam" path) in + let traverse path = + match Fpath.rem_prefix root path with + (* maxdepth=3 *) + | Some suffix -> Ok (List.compare_length_with (Fpath.segs suffix) 3 <= 0) + | None when Fpath.equal root path -> Ok true + | None -> + Fmt.error_msg "%a is not a prefix of %a" Fpath.pp root Fpath.pp path + in + let add_opam_files path acc = + Option.iter (fun s -> raise_notrace (M.Exit s)) (Atomic.get cancelled); + match opam_files path with + | Some path -> S.add (Fpath.to_string path) acc + | None -> acc + in + (try + Bos.OS.Path.fold ~elements:(`Sat is_opam_ext) ~traverse:(`Sat traverse) + add_opam_files S.empty [ root ] + with M.Exit reason -> + Fmt.error_msg "Cancelling opam file lookup (%s)" reason) + |> Result.map S.elements + in + Current.Job.on_cancel job (fun reason -> + Atomic.set cancelled (Some reason); + Lwt.return_unit) + >>= fun () -> + Lwt_preemptive.detach fold_on_opam_files () >>!= fun opam_files -> + get_ocamlformat_version job ~root >>!= fun ocamlformat_version -> + get_all_pinned_pkgs job opam_files root >>!= fun (root_pkgs, pinned_pkgs) -> + Lwt_result.return + { root_pkgs; pinned_pkgs; ocamlformat_version; opam_files; dir_type } +end + +module Extract = struct + let id = "ci-extract" + + type t = No_context + + module Key = struct + type t = Commit.t + + let digest t = Commit.hash t + end + + module Value = struct + type t = Commit.t + + let digest t = Commit.hash t + end + + module Outcome = Content + + let run _ job _ src = + Current.Job.start job ~pool ~level:Current.Level.Harmless >>= fun () -> + Current_git.with_checkout ~job src @@ fun src -> Content.of_dir ~job src + + let pp f _ = Fmt.pf f "Extract" + let auto_cancel = true + let latched = true +end + +module Extract_cache = Current_cache.Generic (Extract) + +let extract src = + Current.component "Extract" + |> let> src in + Extract_cache.run No_context src src diff --git a/lib/repo_content.mli b/lib/repo_content.mli new file mode 100644 index 00000000..9bc17b86 --- /dev/null +++ b/lib/repo_content.mli @@ -0,0 +1,20 @@ +(** Extract from a source repository the informations that needed to analyse the + opam packages. *) +module Content : sig + type t [@@deriving yojson] + + val opam_files : t -> string list + val root_pkgs : t -> (string * string) list + val pinned_pkgs : t -> (string * string) list + val ocamlformat_version : t -> string option + val dir_type : t -> [ `Opam_monorepo of Opam_monorepo.info list | `Ocaml_repo ] + val marshal : t -> string + val unmarshal : string -> t + + val of_dir : + job:Current.Job.t -> Fpath.t -> (t, [ `Msg of string ]) result Lwt.t +end + +val extract : Current_git.Commit.t Current.t -> Content.t Current.t +(** [extract src] extract the informations of the source code [src], usefull for + analysis *) diff --git a/service/pipeline.ml b/service/pipeline.ml index c3f6749c..6ff6a889 100644 --- a/service/pipeline.ml +++ b/service/pipeline.ml @@ -117,9 +117,10 @@ let local_test ~solver repo () = Conf.fetch_platforms ~include_macos:false ~include_freebsd:false () in let src = Git.Local.head_commit repo in + let src_content = Repo_content.extract src in let repo = Current.return { Repo_id.owner = "local"; name = "test" } and analysis = - Analyse.examine ~solver ~platforms ~opam_repository_commit src + Analyse.examine ~solver ~platforms ~opam_repository_commit src src_content in Current.component "summarise" |> let> results = build_with_docker ~repo ~analysis ~platforms src in @@ -157,8 +158,10 @@ let v ?ocluster ~app ~solver ~migrations () = |> Current.list_iter ~collapse_key:"ref" (module Github.Api.Commit) @@ fun head -> let src = Git.fetch (Current.map Github.Api.Commit.id head) in + let src_content = Repo_content.extract src in let analysis = Analyse.examine ~solver ~platforms ~opam_repository_commit src + src_content in let* on_cancel = match ocluster with diff --git a/test/service/test_analyse.ml b/test/service/test_analyse.ml index 07b6b51c..f6b76a8f 100644 --- a/test/service/test_analyse.ml +++ b/test/service/test_analyse.ml @@ -1,4 +1,5 @@ open Lwt.Infix +module Content = Ocaml_ci.Repo_content.Content let () = Logs.(set_level (Some Info)); @@ -54,9 +55,9 @@ module Analysis = struct } [@@deriving eq, yojson] - let of_dir ~job ~platforms ~opam_repository_commit d = + let of_content ~job ~platforms ~opam_repository_commit d = let solver = Ocaml_ci.Backend_solver.v None in - of_dir ~solver ~job ~platforms ~opam_repository_commit d + of_content ~solver ~job ~platforms ~opam_repository_commit d |> Lwt_result.map (fun t -> { opam_files = opam_files t; @@ -146,8 +147,10 @@ let expect_test name ~project ~expected = Current_git.Commit_id.v ~repo:"opam-repository" ~hash:(String.trim hash) ~gref:"master" in - Analysis.of_dir ~job ~platforms:Test_platforms.v ~opam_repository_commit - (Fpath.v root) + Content.of_dir ~job (Fpath.v root) >|= unwrap_result ~job + >>= fun content -> + Analysis.of_content ~job ~platforms:Test_platforms.v + ~opam_repository_commit content >|= fun result -> (match (result, expected) with | Error _, Ok _ ->