gcrypt: Remove empty hash directories when dropping content

As was recently done with the directory special remote.

Note that the top directory passed to removeDirGeneric was changed to
avoid deleting .git/annex or .git/annex/objects if they ended up empty.

Sponsored-by: Brett Eisenberg on Patreon

diff --git a/CHANGELOG b/CHANGELOG
index ccc4f510eae1b4c6d043400e34a9d42f78279434..b9792a7de85787e0a9aed62d86df9959bf004ec8 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -22,7 +22,7 @@ git-annex (10.20230627) UNRELEASED; urgency=medium
   * S3: Allow setting publicurl=yes without public=yes, to support
     buckets that are configured with a Bucket Policy that allows public
     access.
-  * directory: Remove empty hash directories when dropping content.
+  * directory, gcrypt: Remove empty hash directories when dropping content.
   * dropunused: Support --jobs
 
  -- Joey Hess <id@joeyh.name>  Mon, 26 Jun 2023 13:10:40 -0400

diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index fec30195c9a44f5c1a9bcd5c3ee076cad1d00174..61e8b7210e2feb4e4022a25a92916fe175eb5610 100644 (file)
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -439,8 +439,8 @@ remove r rsyncopts accessmethod k = do
 remove' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> AccessMethod -> Remover
 remove' repo r rsyncopts accessmethod k
        | not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $
-               liftIO $ Remote.Directory.removeDirGeneric False
-                       (fromRawFilePath (Git.repoPath repo))
+               liftIO $ Remote.Directory.removeDirGeneric True
+                       (gCryptTopDir repo)
                        (fromRawFilePath (parentDir (toRawFilePath (gCryptLocation repo k))))
        | Git.repoIsSsh repo = shellOrRsync r removeshell removersync
        | accessmethod == AccessRsyncOverSsh = removersync
@@ -466,10 +466,13 @@ checkKey' repo r rsyncopts accessmethod k
        checkrsync = Remote.Rsync.checkKey rsyncopts k
        checkshell = Ssh.inAnnex repo k
 
+gCryptTopDir :: Git.Repo -> FilePath
+gCryptTopDir repo = Git.repoLocation repo </> fromRawFilePath objectDir
+
 {- Annexed objects are hashed using lower-case directories for max
  - portability. -}
 gCryptLocation :: Git.Repo -> Key -> FilePath
-gCryptLocation repo key = Git.repoLocation repo </> fromRawFilePath objectDir
+gCryptLocation repo key = gCryptTopDir repo
        </> fromRawFilePath (keyPath key (hashDirLower def))
 
 data AccessMethod = AccessRsyncOverSsh | AccessGitAnnexShell