fix longstanding indeterminite preferred content for duplicated file problem

* drop: When two files have the same content, and a preferred content
  expression matches one but not the other, do not drop the file.
* sync --content, assistant: Fix an edge case where a file that is not
  preferred content did not get dropped.

The sync --content edge case is that handleDropsFrom loaded associated files
and used them without verifying that the information from the database was
not stale.

It seemed best to avoid changing --want-drop's behavior, this way when
debugging a preferred content expression with it, the files matched will
still reflect the expression. So added a note to the --want-drop documentation,
to make clear it may not behave identically to git-annex drop --auto.

While it would be possible to introspect the preferred content
expression to see if it matches on filenames, and only look up the
associated files when it does, it's generally fairly rare for 2 files to
have the same content, and the database lookup is already avoided when
there's only 1 file, so I did not implement that further optimisation.

Note that there are still some situations where the associated files
database does not get locked files recorded in it, which will prevent
this fix from working.

Sponsored-by: Dartmouth College's Datalad project

Annex/Wanted.hs

@@ -1,6 +1,6 @@
 {- git-annex checking whether content is wanted
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,6 +10,9 @@ module Annex.Wanted where
 import Annex.Common
 import Logs.PreferredContent
 import Annex.UUID
+import Annex.CatFile
+import Git.FilePath
+import qualified Database.Keys
 
 import qualified Data.Set as S
 
@@ -22,8 +25,40 @@ 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. -}
-wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> Annex Bool
-wantDrop d from key file = do
-	u <- maybe getUUID (return . id) from
-	not <$> isPreferredContent (Just u) (S.singleton u) key file d
+ - Don't drop files that are preferred content.
+ -
+ - The AssociatedFile is the one that the user requested to drop.
+ - There may be other files that use the same key, and preferred content
+ - may match some of those and not others. If any are preferred content,
+ - that will prevent dropping. When the other associated files are known,
+ - 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
+	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
+		, do
+			others' <- case others of
+				Just afs -> pure (filter (/= file) afs)
+				Nothing -> case key of
+					Just k -> mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f))
+						=<< Database.Keys.getAssociatedFiles k
+					Nothing -> pure []
+			l <- filterM checkwant others'
+			if null l
+				then return True
+				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 fs
+	checkassociated (AssociatedFile Nothing:fs) = checkassociated fs