From 1de31211124b162014c2a37e34d06567b3c1d90c Mon Sep 17 00:00:00 2001
From: Rebecca Turner <rbt@sent.as>
Date: Thu, 21 Nov 2024 16:13:09 -0800
Subject: [PATCH] VCS: Fix weird tag creation

Creating a tag with an arbitrary user-supplied name can cause problems.
If we fetch, we can just use `FETCH_HEAD` as the ref name directly!

```
Running: git fetch origin d1dc91fd977bb4b28f0e01966fa08640a1283318
From /private/var/folders/z5/fclwwdms3r1gq4k4p3pkvvc00000gn/T/vcstest-90401/src
 * branch            d1dc91fd977bb4b28f0e01966fa08640a1283318 -> FETCH_HEAD

Running: git tag -f d1dc91fd977bb4b28f0e01966fa08640a1283318 FETCH_HEAD

Running: git reset --hard d1dc91fd977bb4b28f0e01966fa08640a1283318 --
warning: refname 'd1dc91fd977bb4b28f0e01966fa08640a1283318' is ambiguous.
Git normally never creates a ref that ends with 40 hex characters
because it will be ignored when you just specify 40-hex. These refs
may be created by mistake. For example,

  git switch -c $br $(git rev-parse ...)

where "$br" is somehow empty and a 40-hex ref is created. Please
examine these refs and maybe delete them. Turn this message off by
running "git config advice.objectNameWarning false"
```
---
 cabal-install/src/Distribution/Client/VCS.hs | 33 +++++++++++++++++-----------
 1 file changed, 20 insertions(+), 13 deletions(-)

diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs
index 33b7078bd..b0c5b140b 100644
--- a/cabal-install/src/Distribution/Client/VCS.hs
+++ b/cabal-install/src/Distribution/Client/VCS.hs
@@ -506,6 +506,8 @@ vcsGit =
           | dir <- (primaryLocalDir : map snd secondaryRepos)
           ]
 
+    -- NOTE: Repositories are cloned once, but can be synchronized multiple times.
+    -- Therefore, this code has to work with both `git clone` and `git fetch`.
     vcsSyncRepo verbosity gitProg SourceRepositoryPackage{..} localDir peer = do
       exists <- doesDirectoryExist localDir
       if exists
@@ -532,10 +534,23 @@ vcsGit =
               (removePathForcibly gitModulesDir)
               (\e -> if isPermissionError e then removePathForcibly gitModulesDir else throw e)
           else removeDirectoryRecursive gitModulesDir
-      when (resetTarget /= "HEAD") $ do
-        git localDir fetchArgs -- first fetch the tag if needed
-        git localDir setTagArgs
-      git localDir resetArgs -- only then reset to the commit
+
+      -- If we want a particular branch or tag, fetch it.
+      ref <- case srpBranch `mplus` srpTag of
+        Nothing -> pure "HEAD"
+        Just ref -> do
+          git localDir ("fetch" : verboseArg ++ ["origin", ref])
+          pure ref
+
+      -- Then, reset to the appropriate ref.
+      git localDir $
+        "reset"
+          : verboseArg
+          ++ [ "--hard"
+             , ref
+             , "--"
+             ]
+
       git localDir $ ["submodule", "sync", "--recursive"] ++ verboseArg
       git localDir $ ["submodule", "update", "--force", "--init", "--recursive"] ++ verboseArg
       git localDir $ ["submodule", "foreach", "--recursive"] ++ verboseArg ++ ["git clean -ffxdq"]
@@ -556,15 +571,7 @@ vcsGit =
             ++ verboseArg
           where
             loc = srpLocation
-        -- To checkout/reset to a particular commit, we must first fetch it
-        -- (since the base clone is shallow).
-        fetchArgs = "fetch" : verboseArg ++ ["origin", resetTarget]
-        -- And then create the Tag from the FETCH_HEAD (which we should have just fetched)
-        setTagArgs = ["tag", "-f", resetTarget, "FETCH_HEAD"]
-        -- Then resetting to that tag will work (if we don't create the tag
-        -- locally from FETCH_HEAD, it won't exist).
-        resetArgs = "reset" : verboseArg ++ ["--hard", resetTarget, "--"]
-        resetTarget = fromMaybe "HEAD" (srpBranch `mplus` srpTag)
+
         verboseArg = ["--quiet" | verbosity < Verbosity.normal]
 
 gitProgram :: Program
-- 
2.11.4.GIT