drop, move, mirror: when two files have the same content, honor the max numcopies and requiredcopies

Eg, before with a .gitattributes like:

*.2 annex.numcopies=2
*.1 annex.numcopies=1

And foo.1 and foo.2 having the same content and key, git-annex drop foo.1 foo.2
would succeed, leaving just 1 copy, despite foo.2 needing 2 copies.
It dropped foo.1 first and then skipped foo.2 since its content was gone.

Now that the keys database includes locked files, this longstanding wart
can be fixed.

Sponsored-by: Noam Kremen on Patreon

Annex/Drop.hs

@@ -60,7 +60,7 @@ handleDropsFrom locs rs reason fromhere key afile si preverified runner = do
   where
 	getcopies fs = do
 		(untrusted, have) <- trustPartition UnTrusted locs
-		(numcopies, mincopies) <- getSafestNumMinCopies' key fs
+		(numcopies, mincopies) <- getSafestNumMinCopies' afile key fs
 		return (length have, numcopies, mincopies, S.fromList untrusted)
 
 	{- Check that we have enough copies still to drop the content.

Annex/NumCopies.hs

@@ -11,7 +11,6 @@ module Annex.NumCopies (
 	module Types.NumCopies,
 	module Logs.NumCopies,
 	getFileNumMinCopies,
-	getAssociatedFileNumMinCopies,
 	getSafestNumMinCopies,
 	getSafestNumMinCopies',
 	getGlobalFileNumCopies,
@@ -123,33 +122,21 @@ getFileNumMinCopies f = do
 					<$> fallbacknum
 					<*> fallbackmin
 
-{- NumCopies and MinCopies value for an associated file, or the default
- - when there is no associated file.
- -
- - This does not include other associated files using the same key.
- -}
-getAssociatedFileNumMinCopies :: AssociatedFile -> Annex (NumCopies, MinCopies)
-getAssociatedFileNumMinCopies (AssociatedFile (Just file)) =
-	getFileNumMinCopies file
-getAssociatedFileNumMinCopies (AssociatedFile Nothing) = (,)
-	<$> getNumCopies
-	<*> getMinCopies
-
 {- Gets the highest NumCopies and MinCopies value for all files
  - associated with a key. Provide any known associated file;
  - the rest are looked up from the database.
  -
- - Using this when dropping avoids dropping one file that
- - has a smaller value violating the value set for another file
- - that uses the same content.
+ - Using this when dropping, rather than getFileNumMinCopies
+ - avoids dropping one file that has a smaller value violating
+ - the value set for another file that uses the same content.
  -}
 getSafestNumMinCopies :: AssociatedFile -> Key -> Annex (NumCopies, MinCopies)
 getSafestNumMinCopies afile k =
 	Database.Keys.getAssociatedFilesIncluding afile k
-		>>= getSafestNumMinCopies' k
+		>>= getSafestNumMinCopies' afile k
 
-getSafestNumMinCopies' :: Key -> [RawFilePath] -> Annex (NumCopies, MinCopies)
-getSafestNumMinCopies' k fs = do
+getSafestNumMinCopies' :: AssociatedFile -> Key -> [RawFilePath] -> Annex (NumCopies, MinCopies)
+getSafestNumMinCopies' afile k fs = do
 	l <- mapM getFileNumMinCopies fs
 	let l' = zip l fs
 	(,)
@@ -158,7 +145,12 @@ getSafestNumMinCopies' k fs = do
   where
 	-- Some associated files in the keys database may no longer
 	-- correspond to files in the repository.
-	stillassociated f = catKeyFile f >>= \case
+	-- (But the AssociatedFile passed to this is known to be
+	-- an associated file, which may not be in the keys database
+	-- yet, so checking it is skipped.)
+	stillassociated f
+		| AssociatedFile (Just f) == afile = return True
+		| otherwise = catKeyFile f >>= \case
 			Just k' | k' == k -> return True
 			_ -> return False
 	

CHANGELOG

@@ -4,7 +4,7 @@ git-annex (8.20210429) UNRELEASED; urgency=medium
   * When two files have the same content, and a required content expression
     matches one but not the other, dropping the latter file will fail as it
     would also remove the content of the required file.
-  * drop, move, import: When two files have the same content, and
+  * drop, move, mirror: When two files have the same content, and
     different numcopies or requiredcopies values, use the higher value.
   * drop --auto: When two files have the same content, and a preferred content
     expression matches one but not the other, do not drop the content.

Command/Drop.hs

@@ -227,7 +227,7 @@ checkRequiredContent (PreferredContentChecked False) u k afile =
  - copies on other semitrusted repositories. -}
 checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> MinCopies -> CommandStart) -> CommandStart
 checkDropAuto automode mremote afile key a =
-	go =<< getAssociatedFileNumMinCopies afile
+	go =<< getSafestNumMinCopies afile key
   where
 	go (numcopies, mincopies)
 		| automode = do

Command/Mirror.hs

@@ -68,7 +68,7 @@ startKey o afile (si, key, ai) = case fromToOptions o of
 	ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
 		( Command.Move.toStart Command.Move.RemoveNever afile key ai si =<< getParsed r
 		, do
-			(numcopies, mincopies) <- getAssociatedFileNumMinCopies afile
+			(numcopies, mincopies) <- getSafestNumMinCopies afile key
 			Command.Drop.startRemote pcc afile ai si numcopies mincopies key =<< getParsed r
 		)
 	FromRemote r -> checkFailedTransferDirection ai Download $ do
@@ -81,7 +81,7 @@ startKey o afile (si, key, ai) = case fromToOptions o of
 				)
 			Right False -> ifM (inAnnex key)
 				( do
-					(numcopies, mincopies) <- getAssociatedFileNumMinCopies afile
+					(numcopies, mincopies) <- getSafestNumMinCopies afile key
 					Command.Drop.startLocal pcc afile ai si numcopies mincopies key []
 				, stop
 				)

Command/Move.hs

@@ -166,7 +166,7 @@ toPerform dest removewhen key afile fastcheck isthere = do
 			willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
 				DropAllowed -> drophere setpresentremote contentlock "moved"
 				DropCheckNumCopies -> do
-					(numcopies, mincopies) <- getAssociatedFileNumMinCopies afile
+					(numcopies, mincopies) <- getSafestNumMinCopies afile key
 					(tocheck, verified) <- verifiableCopies key [srcuuid]
 					verifyEnoughCopiesToDrop "" key (Just contentlock)
 						 numcopies mincopies [srcuuid] verified
@@ -245,7 +245,7 @@ fromPerform src removewhen key afile = do
 		willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
 			DropAllowed -> dropremote "moved"
 			DropCheckNumCopies -> do
-				(numcopies, mincopies) <- getAssociatedFileNumMinCopies afile
+				(numcopies, mincopies) <- getSafestNumMinCopies afile key
 				(tocheck, verified) <- verifiableCopies key [Remote.uuid src]
 				verifyEnoughCopiesToDrop "" key Nothing numcopies mincopies [Remote.uuid src] verified
 					tocheck (dropremote . showproof) faileddropremote

doc/todo/numcopies_check_other_files_using_same_key.mdwn

@@ -21,4 +21,6 @@ do say that it bypasses checking .gitattributes numcopies.
 > files. With the recent change to also track
 > associated files for locked files, they also handle it for those.
 > 
-> But, git-annex drop/move/import don't yet.
+> But, git-annex drop/move/mirror don't yet.
+> 
+> > [[fixed|done]] (did not change --all behavior) --[[Joey]]