From 97b309b56e30a0cbc9e503cbf5fd3bc56c173e94 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 13 May 2024 09:03:43 -0400
Subject: [PATCH] extend manifest with keys to be deleted

This will eventually be used to recover from an interrupted fullPush
and drop the old bundle keys it was unable to delete.

Sponsored-by: Luke T. Shumaker on Patreon
---
 CmdLine/GitRemoteAnnex.hs           | 31 ++++++++++++++++++++++-------
 doc/internals/git-remote-annex.mdwn |  4 ++++
 doc/todo/git-remote-annex.mdwn      |  3 +++
 3 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/CmdLine/GitRemoteAnnex.hs b/CmdLine/GitRemoteAnnex.hs
index b597b7ae1c..47800d29a6 100644
--- a/CmdLine/GitRemoteAnnex.hs
+++ b/CmdLine/GitRemoteAnnex.hs
@@ -40,6 +40,7 @@ import Utility.Env
 import Utility.Metered
 
 import Network.URI
+import Data.Either
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.Map.Strict as M
@@ -265,7 +266,7 @@ fullPush st rmt refs = guardPush st $ do
 	oldmanifest <- maybe (downloadManifest rmt) pure (manifestCache st)
 	let bs = map Git.Bundle.fullBundleSpec refs
 	bundlekey <- generateAndUploadGitBundle rmt bs oldmanifest
-	uploadManifest rmt (Manifest [bundlekey])
+	uploadManifest rmt (Manifest [bundlekey] [])
 	ok <- allM (dropKey rmt) $
 		filter (/= bundlekey) (inManifest oldmanifest)
 	return (ok, st { manifestCache = Nothing })
@@ -285,7 +286,7 @@ incrementalPush st rmt oldtrackingrefs newtrackingrefs = guardPush st $ do
 	bs <- calc [] (M.toList newtrackingrefs)
 	oldmanifest <- maybe (downloadManifest rmt) pure (manifestCache st)
 	bundlekey <- generateAndUploadGitBundle rmt bs oldmanifest
-	uploadManifest rmt (Manifest [bundlekey])
+	uploadManifest rmt (Manifest [bundlekey] [])
 	return (True, st { manifestCache = Nothing })
   where
 	calc c [] = return (reverse c)
@@ -355,7 +356,7 @@ incrementalPush st rmt oldtrackingrefs newtrackingrefs = guardPush st $ do
 pushEmpty :: State -> Remote -> Annex (Bool, State)
 pushEmpty st rmt = do
 	manifest <- maybe (downloadManifest rmt) pure (manifestCache st)
-	uploadManifest rmt (Manifest [])
+	uploadManifest rmt (Manifest [] [])
 	ok <- allM (dropKey rmt) 
 		(genManifestKey (Remote.uuid rmt) : inManifest manifest)
 	return (ok, st { manifestCache = Nothing })
@@ -533,7 +534,14 @@ checkSpecialRemoteProblems rmt
 	| otherwise = Nothing
 
 -- The manifest contains an ordered list of git bundle keys.
-newtype Manifest = Manifest { inManifest :: [Key] }
+--
+-- There is a second list of git bundle keys that are no longer
+-- used and should be deleted.
+data Manifest =
+	Manifest 
+		{ inManifest :: [Key]
+		, outManifest :: [Key]
+		}
 
 -- Downloads the Manifest, or if it does not exist, returns an empty
 -- Manifest.
@@ -551,9 +559,12 @@ downloadManifest rmt = ifM (Remote.checkPresent rmt mk)
 		_ <- Remote.retrieveKeyFile rmt mk
 			(AssociatedFile Nothing) tmp
 			nullMeterUpdate Remote.NoVerify
-		ks <- map deserializeKey' . B8.lines <$> liftIO (B.readFile tmp)
-		Manifest <$> checkvalid [] ks
-	, return (Manifest [])
+		(outks, inks) <- partitionEithers . map parseline . B8.lines
+			<$> liftIO (B.readFile tmp)
+		Manifest
+			<$> checkvalid [] inks
+			<*> checkvalid [] (filter (`notElem` inks) outks)
+	, return (Manifest [] [])
 	)
   where
 	mk = genManifestKey (Remote.uuid rmt)
@@ -565,6 +576,12 @@ downloadManifest rmt = ifM (Remote.checkPresent rmt mk)
 	checkvalid _ (Nothing:_) =
 		giveup $ "Error parsing manifest " ++ serializeKey mk
 
+	parseline l
+		| "-" `B.isPrefixOf` l = 
+			Left $ deserializeKey' $ B.drop 1 l
+		| otherwise =
+			Right $ deserializeKey' l
+
 -- Uploads the Manifest to the remote.
 --
 -- Throws errors if the remote cannot be accessed or the upload fails.
diff --git a/doc/internals/git-remote-annex.mdwn b/doc/internals/git-remote-annex.mdwn
index f85965810b..efaae84ab4 100644
--- a/doc/internals/git-remote-annex.mdwn
+++ b/doc/internals/git-remote-annex.mdwn
@@ -12,6 +12,10 @@ GITBUNDLE--$UUID-sha256 is a git bundle.
 
 An ordered list of bundle keys, one per line. 
 
+Additionally, there may be bundle keys that are prefixed with "-".
+These keys are not part of the current content of the git remote
+and are in the process of being deleted.
+
 (Lines end with unix `"\n"`, not `"\r\n"`.)
 
 # multiple GITMANIFEST files
diff --git a/doc/todo/git-remote-annex.mdwn b/doc/todo/git-remote-annex.mdwn
index da5c5dbab6..53c71c3746 100644
--- a/doc/todo/git-remote-annex.mdwn
+++ b/doc/todo/git-remote-annex.mdwn
@@ -33,6 +33,9 @@ This is implememented and working. Remaining todo list for it:
   to clone from a wrong url, since it fails to download
   a manifest and so appears as if the remote is empty.
 
+* Improve recovery from interrupted push by using outManifest to clean up
+  after it. (Requires populating outManifest.)
+
 * See XXX in uploadManifest about recovering from a situation
   where the remote is left with a deleted manifest when a push
   is interrupted part way through. This should be recoverable