feat(pkg): Implement downloading sources via git (ocaml#9506)

This adds an option to retrieve git sources via the rev store by adding
the commits to the rev store and then materializing a repo in the target
directory.

Signed-off-by: Marek Kubica <[email protected]>

src/dune_pkg/fetch.ml

@@ -288,6 +288,29 @@ let fetch_others ~unpack ~checksum ~target (url : OpamUrl.t) =
     Error (Checksum_mismatch (Checksum.of_opam_hash expected))
 ;;
 
+let fetch_git rev_store ~target (source : Opam_repo.Source.t) =
+  let branch =
+    match source.commit with
+    | Some (Branch b) -> Some b
+    | _ -> None
+  in
+  let* remote = Rev_store.add_repo rev_store ~source:source.url ~branch in
+  let* remote = Rev_store.Remote.update remote in
+  let* at_rev =
+    match source.commit with
+    | Some (Commit ref) -> Rev_store.Remote.rev_of_ref remote ~ref
+    | Some (Branch name) | Some (Tag name) -> Rev_store.Remote.rev_of_name remote ~name
+    | None ->
+      let name = Rev_store.Remote.default_branch remote in
+      Rev_store.Remote.rev_of_name remote ~name
+  in
+  match at_rev with
+  | None -> Fiber.return @@ Error (Unavailable None)
+  | Some at_rev ->
+    let+ res = Rev_store.At_rev.check_out at_rev ~target in
+    Ok res
+;;
+
 let fetch ~unpack ~checksum ~target (url : OpamUrl.t) =
   let event =
     Dune_stats.(

src/dune_pkg/fetch.mli

@@ -18,3 +18,9 @@ val fetch
   -> target:Path.t
   -> OpamUrl.t
   -> (unit, failure) result Fiber.t
+
+val fetch_git
+  :  Rev_store.t
+  -> target:Path.t
+  -> Opam_repo.Source.t
+  -> (unit, failure) result Fiber.t

src/dune_pkg/rev_store.ml

@@ -16,6 +16,13 @@ let lock_path { dir } =
 
 type rev = Rev of string
 
+let tar =
+  lazy
+    (match Bin.which ~path:(Env_path.path Env.initial) "tar" with
+     | Some x -> x
+     | None -> Dune_engine.Utils.program_not_found "tar" ~loc:None)
+;;
+
 let rec attempt_to_lock flock lock ~max_retries =
   let sleep_duration = 0.1 in
   match Flock.lock_non_block flock lock with
@@ -312,6 +319,36 @@ module At_rev = struct
   let repository_id { revision = Rev rev; repo = _; files_at_rev = _ } =
     Repository_id.of_git_hash rev
   ;;
+
+  let check_out { repo = { dir }; revision = Rev rev; files_at_rev = _ } ~target =
+    let git = Lazy.force Vcs.git in
+    let tar = Lazy.force tar in
+    let temp_dir = Temp.create Dir ~prefix:"rev-store" ~suffix:rev in
+    let archive_file = Path.relative temp_dir "archive.tar" in
+    let stdout_to = Process.Io.file archive_file Process.Io.Out in
+    let stderr_to = make_stderr () in
+    let* () =
+      Process.run
+        ~dir
+        ~display
+        ~stdout_to
+        ~stderr_to
+        ~env
+        failure_mode
+        git
+        [ "archive"; "--format=tar"; rev ]
+    in
+    let stdout_to = make_stdout () in
+    let stderr_to = make_stderr () in
+    Process.run
+      ~dir:target
+      ~display
+      ~stdout_to
+      ~stderr_to
+      failure_mode
+      tar
+      [ "xf"; Path.to_string archive_file ]
+  ;;
 end
 
 module Remote = struct

src/dune_pkg/rev_store.mli

@@ -18,6 +18,7 @@ module At_rev : sig
   val directory_entries : t -> Path.Local.t -> File.Set.t
   val equal : t -> t -> bool
   val repository_id : t -> Repository_id.t
+  val check_out : t -> target:Path.t -> unit Fiber.t
 end
 
 module Remote : sig

test/expect-tests/dune_pkg/fetch_tests.ml

@@ -16,7 +16,7 @@ let wrong_checksum =
   OpamHash.compute_from_string "random content" |> Checksum.of_opam_hash
 ;;
 
-let target destination =
+let subdir destination =
   let ext = Path.External.of_filename_relative_to_initial_cwd destination in
   Path.external_ ext
 ;;
@@ -102,7 +102,7 @@ let%expect_test "downloading simple file" =
        ~unpack:false
        ~port
        ~filename
-       ~target:(target destination)
+       ~target:(subdir destination)
        ~checksum:(calculate_checksum ~filename));
   Thread.join server;
   let served_content = Io.String_path.read_file filename in
@@ -141,7 +141,7 @@ let%expect_test "downloading but the checksums don't match" =
        ~unpack:false
        ~port
        ~filename
-       ~target:(target destination)
+       ~target:(subdir destination)
        ~checksum:wrong_checksum);
   Thread.join server;
   print_endline "Finished successfully?";
@@ -161,7 +161,7 @@ let%expect_test "downloading, without any checksum" =
   let filename = "plaintext.md" in
   let port, server = serve_once ~filename in
   let destination = "destination.md" in
-  run (download ~unpack:false ~port ~filename ~target:(target destination));
+  run (download ~unpack:false ~port ~filename ~target:(subdir destination));
   Thread.join server;
   print_endline "Finished successfully, no checksum verification";
   [%expect {|
@@ -182,7 +182,7 @@ let%expect_test "downloading, tarball" =
        ~checksum:wrong_checksum
        ~port
        ~filename
-       ~target:(target destination));
+       ~target:(subdir destination));
   Thread.join server;
   print_endline "Finished successfully, no checksum verification";
   [%expect.unreachable]
@@ -202,7 +202,7 @@ let%expect_test "downloading, tarball with no checksum match" =
      correct location. *)
   let filename = "tarball.tar.gz" in
   let port, server = serve_once ~filename in
-  let target = target "tarball" in
+  let target = subdir "tarball" in
   run (download ~reproducible:false ~unpack:true ~port ~filename ~target);
   Thread.join server;
   print_endline "Finished successfully, no checksum verification";
@@ -221,3 +221,31 @@ let%expect_test "downloading, tarball with no checksum match" =
     files in target dir:
     plaintext.md |}]
 ;;
+
+let download_git rev_store url ~target =
+  let open Fiber.O in
+  let+ res = Fetch.fetch_git rev_store ~target url in
+  match res with
+  | Error _ ->
+    let errs = [ Pp.text "Failure while downloading" ] in
+    User_error.raise ~loc:Loc.none errs
+  | Ok () -> ()
+;;
+
+let%expect_test "downloading via git" =
+  let source = subdir "source-repository" in
+  let url = OpamUrl.parse (sprintf "git+file://%s" (Path.to_string source)) in
+  let rev_store_dir = subdir "rev-store" in
+  let target = subdir "checkout-into-here" in
+  (* The file at [entry] is created by [create_repo_at] *)
+  let entry = Path.relative target "entry" in
+  Path.mkdir_p target;
+  run (fun () ->
+    let open Fiber.O in
+    let* rev_store = Dune_pkg.Rev_store.load_or_create ~dir:rev_store_dir in
+    let* (_commit : string) = Rev_store_tests.create_repo_at source in
+    let* source = Dune_pkg.Opam_repo.Source.Private.of_opam_url rev_store url in
+    let+ () = download_git rev_store source ~target in
+    print_endline (Io.read_file entry));
+  [%expect {| just some content |}]
+;;