prevent dropping required content of other file using same content

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.

This will slow down drop (w/o --auto), dropunused, mirror, and move, by one
keys db lookup per file. But I did include an optimisation to avoid a
double db lookup in the drop --auto / sync --content case. I suspect that
dropunused could also use PreferredContentChecked True, but haven't
entirely thought it through and it's rarely used with enough files for the
optimisation to matter.

Sponsored-by: Dartmouth College's Datalad project

Annex/Drop.hs

@@ -27,8 +27,8 @@ import qualified Data.Set as S
 
 type Reason = String
 
-{- Drop a key from local and/or remote when allowed by the preferred content
- - and numcopies settings.
+{- Drop a key from local and/or remote when allowed by the preferred content,
+ - required content, and numcopies settings.
  -
  - Skips trying to drop from remotes that are appendonly, since those drops
  - would presumably fail. Also skips dropping from exporttree/importtree remotes,
@@ -105,8 +105,9 @@ handleDropsFrom locs rs reason fromhere key afile si preverified runner = do
 
 	checkdrop fs n u a =
 		let afs = map (AssociatedFile . Just) fs
+		    pcc = Command.Drop.PreferredContentChecked True
 		in ifM (wantDrop True u (Just key) afile (Just afs))
-			( dodrop n u a
+			( dodrop n u (a pcc)
 			, return n
 			)
 
@@ -126,12 +127,12 @@ handleDropsFrom locs rs reason fromhere key afile si preverified runner = do
 			, return n
 			)
 
-	dropl fs n = checkdrop fs n Nothing $ \numcopies mincopies ->
+	dropl fs n = checkdrop fs n Nothing $ \pcc numcopies mincopies ->
 		stopUnless (inAnnex key) $
-			Command.Drop.startLocal afile ai si numcopies mincopies key preverified
+			Command.Drop.startLocal pcc afile ai si numcopies mincopies key preverified
 
-	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies mincopies ->
-		Command.Drop.startRemote afile ai si numcopies mincopies key r
+	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \pcc numcopies mincopies ->
+		Command.Drop.startRemote pcc afile ai si numcopies mincopies key r
 
 	ai = mkActionItem (key, afile)
 

Annex/Wanted.hs

@@ -13,6 +13,7 @@ import Annex.UUID
 import Annex.CatFile
 import Git.FilePath
 import qualified Database.Keys
+import Types.FileMatcher
 
 import qualified Data.Set as S
 
@@ -20,12 +21,12 @@ import qualified Data.Set as S
 wantGet :: Bool -> Maybe Key -> AssociatedFile -> Annex Bool
 wantGet d key file = isPreferredContent Nothing S.empty key file d
 
-{- Check if a file is preferred content for a remote. -}
+{- Check if a file is preferred content for a repository. -}
 wantSend :: Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool
 wantSend d key file to = isPreferredContent (Just to) S.empty key file d
 
-{- Check if a file can be dropped, maybe from a remote.
- - Don't drop files that are preferred content.
+{- Check if a file is not preferred or required content, and can be
+ - dropped. When a UUID is provided, checks for that repository.
  -
  - The AssociatedFile is the one that the user requested to drop.
  - There may be other files that use the same key, and preferred content
@@ -34,12 +35,21 @@ wantSend d key file to = isPreferredContent (Just to) S.empty key file d
  - they can be provided, otherwise this looks them up.
  -}
 wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex Bool
-wantDrop d from key file others = do
+wantDrop d from key file others =
+	isNothing <$> checkDrop isPreferredContent d from key file others
+
+{- Generalization of wantDrop that can also be used with isRequiredContent.
+ -
+ - When the content should not be dropped, returns Just the file that
+ - the checker matches.
+ -}
+checkDrop :: (Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool) -> Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex (Maybe AssociatedFile)
+checkDrop checker d from key file others = do
 	u <- maybe getUUID (pure . id) from
 	let s = S.singleton u
-	let checkwant f = isPreferredContent (Just u) s key f d
-	ifM (checkwant file)
-		( return False
+	let checker' f = checker (Just u) s key f d
+	ifM (checker' file)
+		( return (Just file)
 		, do
 			others' <- case others of
 				Just afs -> pure (filter (/= file) afs)
@@ -48,18 +58,18 @@ wantDrop d from key file others = do
 						mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f))
 							=<< Database.Keys.getAssociatedFiles k
 					Nothing -> pure []
-			l <- filterM checkwant others'
+			l <- filterM checker' others'
 			if null l
-				then return True
+				then return Nothing
 				else checkassociated l
 		)
   where
 	-- Some associated files that are in the keys database may no
 	-- longer correspond to files in the repository, and should
 	-- not prevent dropping.
-	checkassociated [] = return True
-	checkassociated (AssociatedFile (Just af):fs) =
-		catKeyFile af >>= \case
-			Just k | Just k == key -> return False
+	checkassociated [] = return Nothing
+	checkassociated (af@(AssociatedFile (Just f)):fs) =
+		catKeyFile f >>= \case
+			Just k | Just k == key -> return (Just af)
 			_ -> checkassociated fs
 	checkassociated (AssociatedFile Nothing:fs) = checkassociated fs