diff --git a/src/lib/common/merge_commit.ml b/src/lib/common/merge_commit.ml new file mode 100644 index 0000000..496f18c --- /dev/null +++ b/src/lib/common/merge_commit.ml @@ -0,0 +1,32 @@ +module Git = Current_git + +type t = Git.Commit_id.t * Git.Commit_id.t list + +let make ~base merge_commits = (base, merge_commits) +let no_merge base = (base, []) + +let spec (base, merges) = + let open Obuilder_spec in + Spec.minimal "alpine" + |> Spec.add + ([ + shell [ "/bin/sh"; "-c" ]; + run ~network:[ "host" ] "apk add git"; + workdir "/merged"; + run ~network:[ "host" ] + "git config --global user.email \"none@none.none\" && git config \ + --global user.name \"None\""; + run ~network:[ "host" ] + "git clone --recursive %S /merged && git fetch origin %S && git \ + reset --hard %s" + (Git.Commit_id.repo base) (Git.Commit_id.gref base) + (Git.Commit_id.hash base); + ] + @ List.map + (fun merge -> + run ~network:[ "host" ] "git fetch origin %S && git merge %s" + (Git.Commit_id.gref merge) (Git.Commit_id.hash merge)) + merges) + |> Spec.finish + +let to_list (base, merge) = base :: merge diff --git a/src/lib/common/merge_commit.mli b/src/lib/common/merge_commit.mli new file mode 100644 index 0000000..a7bf79b --- /dev/null +++ b/src/lib/common/merge_commit.mli @@ -0,0 +1,8 @@ +type t + +val make : base:Current_git.Commit_id.t -> Current_git.Commit_id.t list -> t +(* Assumption: the commits are all on the same repository. *) + +val no_merge : Current_git.Commit_id.t -> t +val spec : t -> Obuilder_spec.t +val to_list : t -> Current_git.Commit_id.t list diff --git a/src/lib/common/spec.ml b/src/lib/common/spec.ml index 22f28d7..e2508af 100644 --- a/src/lib/common/spec.ml +++ b/src/lib/common/spec.ml @@ -13,6 +13,8 @@ let children ~name spec { base; ops; children } = let finish { base; ops; children } = Obuilder_spec.stage ~child_builds:children ~from:base ops +let minimal base = { base; ops = []; children = [] } + let make base = let open Obuilder_spec in { diff --git a/src/lib/common/spec.mli b/src/lib/common/spec.mli index 9e46b8f..d117175 100644 --- a/src/lib/common/spec.mli +++ b/src/lib/common/spec.mli @@ -1,6 +1,8 @@ type t (** An obuilder spec *) +val minimal : string -> t + val make : string -> t (** [make image] Initialize the spec to build on [image] *) diff --git a/src/mirage_ci.ml b/src/mirage_ci.ml index 45e5109..3021a1c 100644 --- a/src/mirage_ci.ml +++ b/src/mirage_ci.ml @@ -103,11 +103,13 @@ let main current_config github mode auth store config let repo_opam = Current_git.clone ~schedule:daily "https://github.com/ocaml/opam-repository.git" + |> Current.map Current_git.Commit.id + |> Current.map Merge_commit.no_merge in let repos = let open Current.Syntax in let+ repo_opam = repo_opam in - [ ("opam", repo_opam) ] + [ repo_opam ] in let mirage_overlay = Current_git.clone ~schedule:daily @@ -116,8 +118,7 @@ let main current_config github mode auth store config in Some (Mirage_ci_pipelines.PR.make ~config ~options:mirage_pipelines_options - ~repos:(Repository.current_list_unfetch repos) - ~mirage_overlay github) + ~repos ~mirage_overlay github) in let main_ci, main_routes = match prs with diff --git a/src/mirage_ci_local.ml b/src/mirage_ci_local.ml index 414c722..485d0fc 100644 --- a/src/mirage_ci_local.ml +++ b/src/mirage_ci_local.ml @@ -12,11 +12,13 @@ let main current_config mode config let repo_opam = Current_git.clone ~schedule:daily "https://github.com/ocaml/opam-repository.git" + |> Current.map Current_git.Commit.id + |> Current.map Merge_commit.no_merge in let repos = let open Current.Syntax in let+ repo_opam = repo_opam in - [ ("opam", repo_opam) ] + [ repo_opam ] in let mirage_overlay = Current_git.clone ~schedule:daily @@ -24,8 +26,7 @@ let main current_config mode config |> Current.map Current_git.Commit.id in Mirage_ci_pipelines.PR.local ~config ~options:mirage_pipelines_options - ~repos:(Repository.current_list_unfetch repos) - ~mirage_overlay + ~repos ~mirage_overlay in let engine = diff --git a/src/pipelines/PR.ml b/src/pipelines/PR.ml index 528b8a4..54d8bd1 100644 --- a/src/pipelines/PR.ml +++ b/src/pipelines/PR.ml @@ -92,7 +92,7 @@ let perform_test ?mirage_dev ~config ~platform ~mirage_skeleton ~mirage ~repos | None -> repos | Some mirage_dev -> let+ repos = repos and+ mirage_dev = mirage_dev in - repos @ [ ("mirage-dev", mirage_dev) ] + repos @ [ mirage_dev ] in Skeleton.all_in_one_test ~platform ~repos ~mirage ~build_mode ~config mirage_skeleton @@ -156,8 +156,6 @@ type kind = | Mirage_dev of { mirage : gh_repo; mirage_skeleton : gh_repo } | Mirage_skeleton of { mirage : gh_repo; mirage_dev : gh_repo option } -let id_of gh_commit = Current.map Github.Api.Commit.id gh_commit - let resolve_opt friends repo = let open Current.Syntax in let+ friends = friends and+ refs = repo.all in @@ -180,7 +178,14 @@ let resolve_opt friends repo = let resolve friends repo = let open Current.Syntax in let+ result = resolve_opt friends repo and+ branch = repo.branch in - Option.value result ~default:(Github.Api.Commit.id branch) + Merge_commit.make ~base:(Github.Api.Commit.id branch) (Option.to_list result) + +let resolve_or_none friends repo = + let open Current.Syntax in + let+ result = resolve_opt friends repo and+ branch = repo.branch in + Option.map + (fun v -> Merge_commit.make ~base:(Github.Api.Commit.id branch) [ v ]) + result type test = { name : string; @@ -189,7 +194,15 @@ type test = { commit_status : bool; } -let perform_ci ~config ~name ~commit_status ~repos ~build_mode ~kind ci_refs = +let perform_ci ~config ~repos ~build_mode { name; kind; input; commit_status } = + let get_merge_commit commit = + let open Current.Syntax in + let+ commit = commit and+ main_branch = input.branch in + let base = Github.Api.Commit.id commit in + let main_branch = Github.Api.Commit.id main_branch in + Merge_commit.make ~base [ main_branch ] + in + let perform_test ~ref = let friends = Current.map find_friend_prs ref in match kind with @@ -198,29 +211,32 @@ let perform_ci ~config ~name ~commit_status ~repos ~build_mode ~kind ci_refs = let mirage_dev = Option.map (resolve friends) mirage_dev in let mirage_skeleton = resolve friends mirage_skeleton in fun ~platform commit_mirage -> - let mirage = id_of commit_mirage |> Current.map Option.some in + let mirage = + get_merge_commit commit_mirage |> Current.map Option.some + in perform_test_and_report_status ~platform ?mirage_dev ~mirage_skeleton ~mirage ~repos ~build_mode name commit_mirage | Mirage_dev { mirage; mirage_skeleton } -> (* Testing mirage-dev commits and PRs *) - let mirage = resolve_opt friends mirage in + let mirage = resolve_or_none friends mirage in (* we pin mirage only if we want to test with a PR on mirage *) let mirage_skeleton = resolve friends mirage_skeleton in fun ~platform commit_mirage_dev -> - let mirage_dev = id_of commit_mirage_dev in + let mirage_dev = get_merge_commit commit_mirage_dev in perform_test_and_report_status ~platform ~mirage_dev ~mirage_skeleton ~mirage ~repos ~build_mode name commit_mirage_dev | Mirage_skeleton { mirage_dev; mirage } -> (* Testing mirage-skeleton commits and PRs *) let mirage_dev = Option.map (resolve friends) mirage_dev in - let mirage = resolve_opt friends mirage in + let mirage = resolve_or_none friends mirage in (* we pin mirage only if we want to test with a PR on mirage *) fun ~platform commit_mirage_skeleton -> - let mirage_skeleton = id_of commit_mirage_skeleton in + let mirage_skeleton = get_merge_commit commit_mirage_skeleton in perform_test_and_report_status ~platform ?mirage_dev ~mirage_skeleton ~mirage ~repos ~build_mode name commit_mirage_skeleton in - ci_refs + + input.ci |> Current.map (fun commits -> List.map (fun (ref, commit) -> ((commit, ref), url_of_commit commit ref)) @@ -284,7 +300,7 @@ let test_options_cmdliner = type context = { config : Common.Config.t; enable_commit_status : enable_commit_status; - repos : Repository.t list Current.t; + repos : Merge_commit.t list Current.t; build_mode : Skeleton.build_mode; } @@ -319,13 +335,11 @@ let pipeline ~mirage ~mirage_skeleton ~extra_repository in let pipeline = tasks - |> List.map (fun { name; kind; input; commit_status } -> + |> List.map (fun test -> let prs = ref [] in - ( name, + ( test.name, prs, - perform_ci ~config ~name ~commit_status ~repos ~build_mode ~kind - input.ci - |> update prs )) + perform_ci ~config ~repos ~build_mode test |> update prs )) in let specs = List.map (fun (name, content, _) -> { name; content }) pipeline in let pipeline = @@ -413,6 +427,7 @@ let local ~config ~options ~repos ~mirage_overlay = let github_setup { branch; org; name } = Github.Api.Anonymous.head_of { owner = org; name } (`Ref ("refs/heads/" ^ branch)) + |> Current.map Merge_commit.no_merge in let pipelines = tests ~mirage_overlay options diff --git a/src/pipelines/PR.mli b/src/pipelines/PR.mli index de773d3..f0c756c 100644 --- a/src/pipelines/PR.mli +++ b/src/pipelines/PR.mli @@ -1,5 +1,6 @@ module Github = Current_github module Git = Current_git +open Common type t (** The PR tester *) @@ -11,9 +12,9 @@ val test_options_cmdliner : test_options Cmdliner.Term.t val is_enabled : test_options -> bool val make : - config:Common.Config.t -> + config:Config.t -> options:test_options -> - repos:(string * Git.Commit_id.t) list Current.t -> + repos:Merge_commit.t list Current.t -> mirage_overlay:Git.Commit_id.t Current.t -> Github.Api.t -> t @@ -22,8 +23,8 @@ val to_current : t -> unit Current.t val routes : t -> Current_web.Resource.t Routes.route list val local : - config:Common.Config.t -> + config:Config.t -> options:test_options -> - repos:(string * Git.Commit_id.t) list Current.t -> + repos:Merge_commit.t list Current.t -> mirage_overlay:Git.Commit_id.t Current.t -> unit Current.t diff --git a/src/pipelines/skeleton.ml b/src/pipelines/skeleton.ml index e3ea978..627d675 100644 --- a/src/pipelines/skeleton.ml +++ b/src/pipelines/skeleton.ml @@ -51,17 +51,43 @@ let all_in_one_test ~(platform : Platform.t) ~target ~repos ~mirage ~config and+ mirage = mirage in let open Obuilder_spec in - let pin_mirage = + let pin_mirage base = match mirage with - | Some commit -> - [ - run ~network:[ "host" ] "opam pin -ny %s" (Setup.remote_uri commit); - ] - | None -> [] + | Some merged_commit -> + let name = "merge-repo-pin-mirage" in + let target_name = "/merged-repositories/" ^ name in + Spec.children ~name (Merge_commit.spec merged_commit) base + |> Spec.add + [ + copy ~from:(`Build name) [ "/merged" ] ~dst:target_name; + run ~network:[ "host" ] "opam pin -ny %s" target_name; + ] + | None -> base + in + let merge_repos base = + List.fold_left + (fun (base, i) repo -> + let name = "merge-repo-" ^ string_of_int i in + let target_name = "/merged-repositories/" ^ name in + let with_child_build = + Spec.children ~name (Merge_commit.spec repo) base + in + let with_repo = + with_child_build + |> Spec.add + [ + copy ~from:(`Build name) [ "/merged" ] ~dst:target_name; + run ~network:[ "host" ] "opam repo add %s %s" name + target_name; + ] + in + (with_repo, i + 1)) + (base, 0) repos + |> fst in Platform.spec platform.system - |> Spec.add (Setup.add_repositories repos) - |> Spec.add pin_mirage + |> merge_repos + |> pin_mirage |> Spec.add (Setup.install_tools [ "mirage" ]) |> Spec.add [ copy [ "." ] ~dst:"/src/"; env "MODE" target; workdir "/src/" ] @@ -71,10 +97,7 @@ let all_in_one_test ~(platform : Platform.t) ~target ~repos ~mirage ~config let cache_hint = Fmt.str "mirage-ci-skeleton-%a" Platform.pp_system platform.system in - let src = - let+ mirage_skeleton = mirage_skeleton in - [ mirage_skeleton ] - in + let src = Current.map Merge_commit.to_list mirage_skeleton in Config.build ~label ~cache_hint config ~pool:(Platform.ocluster_pool platform) ~src spec diff --git a/src/pipelines/skeleton.mli b/src/pipelines/skeleton.mli index 87dcea5..aef120a 100644 --- a/src/pipelines/skeleton.mli +++ b/src/pipelines/skeleton.mli @@ -6,10 +6,10 @@ type build_mode = val all_in_one_test : platform:Platform.t -> - repos:Repository.t list Current.t -> - mirage:Current_git.Commit_id.t option Current.t -> + repos:Merge_commit.t list Current.t -> + mirage:Merge_commit.t option Current.t -> config:Config.t -> build_mode:build_mode -> - Current_git.Commit_id.t Current.t -> + Merge_commit.t Current.t -> unit Current.t (** Test mirage-skeleton, all unikernels in one job *)