Merge pull request #12673 from punchagan/rev-store-show-git-errors

pkg: Show git error output when Rev_store's fetch fails

Author: Alizter

src/dune_pkg/opamUrl0.ml

@@ -52,12 +52,14 @@ type resolve =
   | Resolved of Rev_store.Object.resolved
   | Unresolved of Rev_store.Object.t
 
-let not_found t =
+let not_found ~loc ~git_output t =
   let url = base_url t in
   let rev = rev t in
+  let git_output = List.map ~f:Pp.verbatim git_output in
   Error
-    (User_message.make
-       [ (match rev with
+    (User_message.make ~loc
+     @@ git_output
+     @ [ (match rev with
           | None -> Pp.textf "default branch not found in %s" url
           | Some rev -> Pp.textf "revision %S not found in %s" rev url)
        ])
@@ -89,7 +91,7 @@ let resolve t ~loc rev_store =
   | `Ref revision ->
     Rev_store.resolve_revision rev_store remote ~revision
     >>| (function
-     | None -> not_found t
+     | None -> not_found ~loc ~git_output:[] t
      | Some o -> Ok (Resolved o))
 ;;
 
@@ -101,8 +103,8 @@ let fetch_revision t ~loc resolve rev_store =
   | Unresolved o ->
     Rev_store.fetch_object rev_store remote o
     >>| (function
-     | None -> not_found t
-     | Some rev -> Ok rev)
+     | Error git_output -> not_found ~loc ~git_output t
+     | Ok rev -> Ok rev)
 ;;
 
 let set_rev (t : t) rev = { t with hash = Some (Rev_store.Object.to_hex rev) }

src/dune_pkg/rev_store.ml

@@ -486,9 +486,7 @@ let run_with_exit_code { dir; _ } ~allow_codes ~display args =
              minimum supported version is Git 2.29."
         ]
         ~hints:[ User_message.command "Please update your git version." ]
-    | _ ->
-      Console.print [ Pp.verbatim stderr ];
-      Error { Git_error.dir; args; exit_code; output = [] })
+    | _ -> Error { Git_error.dir; args; exit_code; output = [ stderr ] })
 ;;
 
 let run t ~display args =
@@ -725,15 +723,16 @@ let fetch_allow_failure repo ~url obj =
     | true -> Fiber.return `Fetched
     | false ->
       run_with_exit_code
-        ~allow_codes:(fun x -> x = 0 || x = 128)
+        ~allow_codes:(Int.equal 0)
         repo
         ~display:!Dune_engine.Clflags.display
         [ "fetch"; "--no-write-fetch-head"; url; Object.to_hex obj ]
       >>| (function
-       | Ok 128 -> `Not_found
        | Ok 0 ->
          Table.set repo.present_objects obj ();
          `Fetched
+       | Error { Git_error.exit_code; output; _ } when exit_code = 128 ->
+         `Not_found output
        | Error git_error -> Git_error.raise_code_error git_error
        | _ -> assert false))
 ;;
@@ -742,8 +741,14 @@ let fetch repo ~url obj =
   fetch_allow_failure repo ~url obj
   >>| function
   | `Fetched -> ()
-  | `Not_found ->
-    User_error.raise [ Pp.textf "unable to fetch %S from %S" (Object.to_hex obj) url ]
+  | `Not_found output ->
+    User_error.raise
+      ([ Pp.textf
+           "Dune was unable to fetch %S from %S due to the following git fetch error:"
+           (Object.to_hex obj)
+           url
+       ]
+       @ List.map ~f:Pp.verbatim output)
 ;;
 
 module Debug = struct
@@ -1156,8 +1161,8 @@ let resolve_revision t (remote : Remote.t) ~revision =
 let fetch_object t (remote : Remote.t) revision =
   fetch_allow_failure t ~url:remote.url revision
   >>= function
-  | `Not_found -> Fiber.return None
-  | `Fetched -> At_rev.of_rev t ~revision >>| Option.some
+  | `Not_found git_output -> Fiber.return (Error git_output)
+  | `Fetched -> At_rev.of_rev t ~revision >>| Result.ok
 ;;
 
 let content_of_files t files =

src/dune_pkg/rev_store.mli

@@ -104,10 +104,10 @@ end
 val resolve_revision : t -> Remote.t -> revision:string -> Object.resolved option Fiber.t
 
 (** [fetch_object t remote object] ensures that an [object] from the [remote]
-    is present in the revision store [t]. If the reviison is already present,
-    no network I/O is performed. Returns [None] if the remote reports "not
-    found". *)
-val fetch_object : t -> Remote.t -> Object.t -> At_rev.t option Fiber.t
+    is present in the revision store [t]. If the revision is already present,
+    no network I/O is performed. Returns [Error git_error_lines] if the remote
+    reports "not found". *)
+val fetch_object : t -> Remote.t -> Object.t -> (At_rev.t, string list) result Fiber.t
 
 (** Fetch the file contents of the repository at the given revision into the
     store and return the repository view. *)

test/blackbox-tests/test-cases/pkg/commit-hash-references.t

@@ -32,5 +32,5 @@ Depend on foo from the repo
 
 Which foo will we get?
 
-  $ dune pkg lock 2>&1 | head -1 | sed "s/$AMBIGUOUS_REF/\$AMBIGUOUS_REF/g"
+  $ dune pkg lock 2>&1 | grep "not found" | sed "s/$AMBIGUOUS_REF/\$AMBIGUOUS_REF/g"
   revision "$AMBIGUOUS_REF" not found in

test/expect-tests/dune_pkg/rev_store_tests.ml

@@ -117,8 +117,9 @@ let%expect_test "fetching an object twice from the store" =
       Rev_store.Object.of_sha1 remote_revision
       |> Option.value_exn
       |> Rev_store.fetch_object rev_store remote
-      >>| Option.value_exn
+      >>| Result.to_option
     in
+    let at_rev = Option.value_exn at_rev in
     Rev_store.At_rev.directory_entries at_rev ~recursive:true Path.Local.root
     |> Rev_store.File.Set.find ~f:(fun f ->
       Path.Local.equal (Rev_store.File.path f) (Path.Local.of_string file))