Do not use shallow clones for short revisions

When the `tag` of a `source-repository-stanza` is not a full hash, we cannot do a shallow clone and fetch it separately. Therefore, in those cases, we fall back to doing a full clone. Fixes haskell#10605 Includes a regression test by @9999years. Co-authored-by: Rebecca Turner <[email protected]>
alt-romes · Dec 16, 2024 · 483c5d1 · 483c5d1
1 parent da3d5ab
commit 483c5d1
Show file tree

Hide file tree

Showing 7 changed files with 65 additions and 2 deletions.
diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs
@@ -549,7 +549,10 @@ vcsGit =
       -- If we want a particular branch or tag, fetch it.
       ref <- case srpBranch `mplus` srpTag of
         Nothing -> pure "HEAD"
-        Just ref -> do
+        -- `doShallow` controls whether we use a shallow clone.
+        -- If the clone is shallow, make sure to fetch specified revisions
+        -- before using them.
+        Just ref | doShallow -> do
           -- /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\
           -- /!\            MULTIPLE HOURS HAVE BEEN LOST HERE!!             /!\
           -- /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\
@@ -582,6 +585,9 @@ vcsGit =
           -- for now. Option 1 is possible but seems to have little benefit.
           git localDir ("fetch" : verboseArg ++ ["origin", ref])
           pure "FETCH_HEAD"
+        Just ref
+          | otherwise ->
+              pure ref
 
       -- Then, reset to the appropriate ref.
       git localDir $
@@ -608,8 +614,30 @@ vcsGit =
               { progInvokeCwd = Just cwd
               }
 
+        -- Beware: if the user supplied revision for the source repository
+        -- package is /not/ a full hash, then we cannot fetch it, which means
+        -- we cannot do a shallow clone (--depth=1).
+        -- See #10605.
+        doShallow
+          | Nothing <- srpTag =
+              -- No tag, OK for shallow
+              True
+          -- full hashes are exactly 40 characters
+          | Just tg <- srpTag
+          , length tg == 40
+          , all (`elem` (['0' .. '9'] ++ ['a' .. 'f'] ++ ['A' .. 'F'])) tg =
+              True
+          | otherwise =
+              False
+
+        depthIs1
+          | doShallow = ["--depth=1"]
+          | otherwise = []
+
         cloneArgs =
-          ["clone", "--depth=1", "--no-checkout", loc, localDir]
+          ["clone"]
+            ++ depthIs1
+            ++ [ "--no-checkout", loc, localDir]
             ++ case peer of
               Nothing -> []
               Just peerLocalDir -> ["--reference", peerLocalDir]

diff --git a/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/cabal.out b/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/cabal.out
@@ -0,0 +1,10 @@
+# cabal v2-build
+Configuration is affected by the following files:
+- cabal.project
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - puppy-1.0 (lib) (first run)
+Configuring library for puppy-1.0...
+Preprocessing library for puppy-1.0...
+Building library for puppy-1.0...
diff --git a/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/cabal.project b/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/cabal.project
@@ -0,0 +1,8 @@
+packages: .
+
+-- Regression for https://github.com/haskell/cabal/issues/10605
+-- This is `my-lib` 0.9.
+source-repository-package
+  type: git
+  location: https://github.com/9999years/cabal-testsuite-my-lib.git
+  tag: 9a0af0aa
diff --git a/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/cabal.test.hs b/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/cabal.test.hs
@@ -0,0 +1,4 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+  cabal "v2-build" []
diff --git a/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/puppy.cabal b/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/puppy.cabal
@@ -0,0 +1,9 @@
+cabal-version:      3.0
+name:               puppy
+version:            1.0
+
+library
+    default-language: Haskell2010
+    hs-source-dirs:   src
+    build-depends:    base
+    exposed-modules:  Puppy
diff --git a/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/src/Puppy.hs b/cabal-testsuite/PackageTests/SourceRepositoryPackageShallow/src/Puppy.hs
@@ -0,0 +1 @@
+module Puppy () where
diff --git a/doc/how-to-source-packages.rst b/doc/how-to-source-packages.rst
@@ -239,6 +239,9 @@ for the ``tag`` field:
    - If the ``tag`` field is a Git branch name then the latest commit on that branch is used.
    - If the ``tag`` field is a Git tag then the current commit that tag points to is used.
 
+Note that if the tag is not a full git hash (40 characters, hexadecimal), then
+the source repository must be fully cloned, which is often much slower than
+doing a shallow clone.
 
 *Source code* when dependency vendoring
 ---------------------------------------