fixup! Do not use shallow clones for short revisions

haskell · Dec 16, 2024 · e93d885 · e93d885
1 parent 3e0a447
commit e93d885
Showing 1 changed file with 54 additions and 51 deletions.
diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs
@@ -546,55 +546,57 @@ vcsGit =
               (\e -> if isPermissionError e then removePathForcibly dotGitModulesPath else throw e)
           else removeDirectoryRecursive dotGitModulesPath
 
-      -- `doShallow` controls whether we use a shallow clone.
-      -- If the clone is shallow, make sure to fetch specified revisions before
-      -- using them.
-      when doShallow $ do
-        -- If we want a particular branch or tag, fetch it.
-        ref <- case srpBranch `mplus` srpTag of
-          Nothing -> pure "HEAD"
-          Just ref -> do
-            -- /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\
-            -- /!\            MULTIPLE HOURS HAVE BEEN LOST HERE!!             /!\
-            -- /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\
-            --
-            -- If you run `git fetch origin MY_TAG`, then the tag _will_ be
-            -- fetched, but no local ref (e.g. `refs/tags/MY_TAG`) will be
-            -- created.
-            --
-            -- This means that doing `git fetch origin MY_TAG && git reset --hard
-            -- MY_TAG` will fail with a message like `unknown revision MY_TAG`.
-            --
-            -- There are two ways around this:
-            --
-            -- 1. Provide a refmap explicitly:
-            --
-            --        git fetch --refmap="+refs/tags/*:refs/tags/*" origin MYTAG
-            --
-            --    This tells Git to create local tags matching remote tags. It's
-            --    not in the default refmap so you need to set it explicitly.
-            --    (You can also set it with `git config set --local
-            --    remote.origin.fetch ...`.)
-            --
-            -- 2. Use `FETCH_HEAD` directly: Git writes a `FETCH_HEAD` ref
-            --    containing the commit that was just fetched. This feels a bit
-            --    nasty but seems to work reliably, even if nothing was fetched.
-            --    (That is, deleting `FETCH_HEAD` and re-running a `git fetch`
-            --    command will succesfully recreate the `FETCH_HEAD` ref.)
-            --
-            -- Option 2 is what Cabal has done historically, and we're keeping it
-            -- for now. Option 1 is possible but seems to have little benefit.
-            git localDir ("fetch" : verboseArg ++ ["origin", ref])
-            pure "FETCH_HEAD"
-
-        -- Then, reset to the appropriate ref.
-        git localDir $
-          "reset"
-            : verboseArg
-            ++ [ "--hard"
-               , ref
-               , "--"
-               ]
+      -- If we want a particular branch or tag, fetch it.
+      ref <- case srpBranch `mplus` srpTag of
+        Nothing -> pure "HEAD"
+        -- `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!!             /!\
+          -- /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\
+          --
+          -- If you run `git fetch origin MY_TAG`, then the tag _will_ be
+          -- fetched, but no local ref (e.g. `refs/tags/MY_TAG`) will be
+          -- created.
+          --
+          -- This means that doing `git fetch origin MY_TAG && git reset --hard
+          -- MY_TAG` will fail with a message like `unknown revision MY_TAG`.
+          --
+          -- There are two ways around this:
+          --
+          -- 1. Provide a refmap explicitly:
+          --
+          --        git fetch --refmap="+refs/tags/*:refs/tags/*" origin MYTAG
+          --
+          --    This tells Git to create local tags matching remote tags. It's
+          --    not in the default refmap so you need to set it explicitly.
+          --    (You can also set it with `git config set --local
+          --    remote.origin.fetch ...`.)
+          --
+          -- 2. Use `FETCH_HEAD` directly: Git writes a `FETCH_HEAD` ref
+          --    containing the commit that was just fetched. This feels a bit
+          --    nasty but seems to work reliably, even if nothing was fetched.
+          --    (That is, deleting `FETCH_HEAD` and re-running a `git fetch`
+          --    command will succesfully recreate the `FETCH_HEAD` ref.)
+          --
+          -- Option 2 is what Cabal has done historically, and we're keeping it
+          -- 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 $
+        "reset"
+          : verboseArg
+          ++ [ "--hard"
+             , ref
+             , "--"
+             ]
 
       -- We need to check if `.gitmodules` exists _after_ the `git reset` call.
       gitModulesExists <- doesFileExist gitModulesPath
@@ -620,9 +622,10 @@ vcsGit =
           | Nothing <- srpTag =
               -- No tag, OK for shallow
               True
-          -- full hashes are 40 characters
+          -- full hashes are exactly 40 characters
           | Just tg <- srpTag
-          , length tg >= 40 =
+          , length tg == 40
+          , all (`elem` (['0' .. '9'] ++ ['a' .. 'f'] ++ ['A' .. 'F'])) tg =
               True
           | otherwise =
               False