fix local dropping to not require extra locking of copies, but only that the local copy be locked for removal

Types/NumCopies.hs

@@ -19,9 +19,11 @@ module Types.NumCopies (
 	isSafeDrop,
 	SafeDropProof,
 	mkSafeDropProof,
+	ContentRemovalLock(..),
 ) where
 
 import Types.UUID
+import Types.Key
 import Utility.Exception (bracketIO)
 
 import qualified Data.Map as M
@@ -36,6 +38,11 @@ newtype NumCopies = NumCopies Int
 fromNumCopies :: NumCopies -> Int
 fromNumCopies (NumCopies n) = n
 
+-- Indicates that a key's content is exclusively
+-- locked locally, pending removal.
+newtype ContentRemovalLock = ContentRemovalLock Key
+	deriving (Show)
+
 -- A verification that a copy of a key exists in a repository.
 data VerifiedCopy
 	{- Represents a recent verification that a copy of an
@@ -48,7 +55,7 @@ data VerifiedCopy
  	{- The strongest proof of the existence of a copy.
 	 - Until its associated action is called to unlock it,
 	 - the copy is locked in the repository and is guaranteed
-	 - not to be dropped by any git-annex process. -}
+	 - not to be removed by any git-annex process. -}
 	| LockedCopy V
 	deriving (Show)
 
@@ -116,20 +123,39 @@ withVerifiedCopy mk u = bracketIO setup cleanup
 {- Check whether enough verification has been done of copies to allow
  - dropping content safely.
  -
- - Unless numcopies is 0, at least one LockedCopy or TrustedCopy
- - is required. A LockedCopy prevents races between concurrent
- - drops from dropping the last copy, no matter what.
+ - This is carefully balanced to prevent data loss when there are races
+ - between concurrent drops of the same content in different repos,
+ - without requiring impractical amounts of locking.
+ -
+ - In particular, concurrent drop races may cause the number of copies
+ - to fall below NumCopies, but it will never fall below 1.
+ -}
+isSafeDrop :: NumCopies -> [VerifiedCopy] -> Maybe ContentRemovalLock -> Bool
+{- When a ContentRemovalLock is provided, the content is being
+ - dropped from the local repo. That lock will prevent other git repos
+ - that are concurrently dropping from using the local copy as a VerifiedCopy.
+ - So, no additional locking is needed; all we need is verifications
+ - of any kind of N other copies of the content. -}
+isSafeDrop (NumCopies n) l (Just (ContentRemovalLock _)) = 
+	length (deDupVerifiedCopies l) >= n
+{- Dropping from a remote repo.
+ -
+ - Unless numcopies is 0, at least one LockedCopy or TrustedCopy is required.
+ - A LockedCopy prevents races between concurrent drops from
+ - dropping the last copy, no matter what.
  -
  - The other N-1 copies can be less strong verifications, like
  - RecentlyVerifiedCopy. While those are subject to concurrent drop races,
  - and so could be dropped all at once, causing numcopies to be violated,
- - this is the best that can be done without requiring all special remotes
- - to support locking.
+ - this is the best that can be done without requiring that 
+ - all special remotes support locking.
  -}
-isSafeDrop :: NumCopies -> [VerifiedCopy] -> Bool
-isSafeDrop (NumCopies n) l
+isSafeDrop (NumCopies n) l Nothing
 	| n == 0 = True
-	| otherwise = length (deDupVerifiedCopies l) >= n && any fullVerification l
+	| otherwise = and
+		[ length (deDupVerifiedCopies l) >= n
+		, any fullVerification l
+		]
 
 fullVerification :: VerifiedCopy -> Bool
 fullVerification (LockedCopy _) = True
@@ -137,14 +163,14 @@ fullVerification (TrustedCopy _) = True
 fullVerification (RecentlyVerifiedCopy _) = False
 
 -- A proof that it's currently safe to drop an object.
-data SafeDropProof = SafeDropProof NumCopies [VerifiedCopy]
+data SafeDropProof = SafeDropProof NumCopies [VerifiedCopy] (Maybe ContentRemovalLock)
 	deriving (Show)
 
 -- Make sure that none of the VerifiedCopies have become invalidated
 -- before constructing proof.
-mkSafeDropProof :: NumCopies -> [VerifiedCopy] -> IO (Either [VerifiedCopy] SafeDropProof)
-mkSafeDropProof need have = do
+mkSafeDropProof :: NumCopies -> [VerifiedCopy] -> Maybe ContentRemovalLock -> IO (Either [VerifiedCopy] SafeDropProof)
+mkSafeDropProof need have removallock = do
 	stillhave <- filterM checkVerifiedCopy have
-	return $ if isSafeDrop need stillhave
-		then Right (SafeDropProof need stillhave)
+	return $ if isSafeDrop need stillhave removallock
+		then Right (SafeDropProof need stillhave removallock)
 		else Left stillhave