use types to enforce that removeAnnex can only be called inside lockContent

This fixed one bug where it needed to be and wasn't (in Assistant.Unused).
And also found one place where lockContent was used unnecessarily (by
drop --from remote).

A few other places like uninit probably don't really need to lockContent,
but it doesn't hurt to do call it anyway.

This commit was sponsored by David Wagner.

Annex/Content.hs

@@ -152,14 +152,20 @@ contentLockFile key = ifM isDirect
 	, return Nothing
 	)
 
+newtype ContentLock = ContentLock Key
+
 {- Content is exclusively locked while running an action that might remove
- - it. (If the content is not present, no locking is done.) -}
-lockContent :: Key -> Annex a -> Annex a
+ - it. (If the content is not present, no locking is done.)
+ -}
+lockContent :: Key -> (ContentLock -> Annex a) -> Annex a
 lockContent key a = do
 	contentfile <- calcRepo $ gitAnnexLocation key
 	lockfile <- contentLockFile key
 	maybe noop setuplockfile lockfile
-	bracket (lock contentfile lockfile) (unlock lockfile) (const a)
+	bracket
+		(lock contentfile lockfile)
+		(unlock lockfile)
+		(const $ a $ ContentLock key)
   where
 	alreadylocked = error "content is locked"
 	setuplockfile lockfile = modifyContent lockfile $
@@ -426,9 +432,10 @@ cleanObjectLoc key cleaner = do
 {- Removes a key's file from .git/annex/objects/
  -
  - In direct mode, deletes the associated files or files, and replaces
- - them with symlinks. -}
-removeAnnex :: Key -> Annex ()
-removeAnnex key = withObjectLoc key remove removedirect
+ - them with symlinks.
+ -}
+removeAnnex :: ContentLock -> Annex ()
+removeAnnex (ContentLock key) = withObjectLoc key remove removedirect
   where
 	remove file = cleanObjectLoc key $ do
 		secureErase file

Assistant/Unused.hs

@@ -77,7 +77,7 @@ expireUnused duration = do
 	forM_ oldkeys $ \k -> do
 		debug ["removing old unused key", key2file k]
 		liftAnnex $ do
-			removeAnnex k
+			lockContent k removeAnnex
 			logStatus k InfoMissing
   where
 	boundry = durationToPOSIXTime <$> duration

Assistant/Upgrade.hs

@@ -96,7 +96,7 @@ startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO ol
 		, transferKey = k
 		}
 	cleanup = liftAnnex $ do
-		removeAnnex k
+		lockContent k removeAnnex
 		setUrlMissing k u
 		logStatus k InfoMissing
 

Command/Drop.hs

@@ -55,8 +55,12 @@ startRemote afile numcopies key remote = do
 	showStart' ("drop " ++ Remote.name remote) key afile
 	next $ performRemote key afile numcopies remote
 
+-- Note that lockContent is called before checking if the key is present
+-- on enough remotes to allow removal. This avoids a scenario where two
+-- or more remotes are trying to remove a key at the same time, and each
+-- see the key is present on the other.
 performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform
-performLocal key afile numcopies knownpresentremote = lockContent key $ do
+performLocal key afile numcopies knownpresentremote = lockContent key $ \contentlock -> do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
 	let trusteduuids' = case knownpresentremote of
 		Nothing -> trusteduuids
@@ -66,7 +70,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ do
 	u <- getUUID
 	ifM (canDrop u key afile numcopies trusteduuids' tocheck [])
 		( do
-			removeAnnex key
+			removeAnnex contentlock
 			notifyDrop afile True
 			next $ cleanupLocal key
 		, do
@@ -75,7 +79,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ do
 		)
 
 performRemote :: Key -> AssociatedFile -> NumCopies -> Remote -> CommandPerform
-performRemote key afile numcopies remote = lockContent key $ do
+performRemote key afile numcopies remote = do
 	-- Filter the remote it's being dropped from out of the lists of
 	-- places assumed to have the key, and places to check.
 	-- When the local repo has the key, that's one additional copy,

Command/DropKey.hs

@@ -28,8 +28,8 @@ start key = stopUnless (inAnnex key) $ do
 	next $ perform key
 
 perform :: Key -> CommandPerform
-perform key = lockContent key $ do
-	removeAnnex key
+perform key = lockContent key $ \contentlock -> do
+	removeAnnex contentlock
 	next $ cleanup key
 
 cleanup :: Key -> CommandCleanup

Command/Move.hs

@@ -91,7 +91,7 @@ expectedPresent dest key = do
 	return $ dest `elem` remotes
 
 toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
-toPerform dest move key afile fastcheck isthere = moveLock move key $
+toPerform dest move key afile fastcheck isthere = do
 	case isthere of
 		Left err -> do
 			showNote err
@@ -115,8 +115,8 @@ toPerform dest move key afile fastcheck isthere = moveLock move key $
 			finish
   where
 	finish
-		| move = do
-			removeAnnex key
+		| move = lockContent key $ \contentlock -> do
+			removeAnnex contentlock
 			next $ Command.Drop.cleanupLocal key
 		| otherwise = next $ return True
 
@@ -164,10 +164,3 @@ fromPerform src move key afile = ifM (inAnnex key)
 	dispatch True True = do -- finish moving
 		ok <- Remote.removeKey src key
 		next $ Command.Drop.cleanupRemote key src ok
-
-{- Locks a key in order for it to be moved away from the current repository.
- - No lock is needed when a key is being copied, or moved to the current
- - repository. -}
-moveLock :: Bool -> Key -> Annex a -> Annex a
-moveLock True key a = lockContent key a
-moveLock False _ a = a

Command/TestRemote.hs

@@ -114,7 +114,7 @@ test st r k =
 	, check "storeKey when already present" store
 	, present True
 	, check "retrieveKeyFile" $ do
-		removeAnnex k
+		lockContent k removeAnnex
 		get
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from 33%" $ do
@@ -124,20 +124,20 @@ test st r k =
 			sz <- hFileSize h
 			L.hGet h $ fromInteger $ sz `div` 3
 		liftIO $ L.writeFile tmp partial
-		removeAnnex k
+		lockContent k removeAnnex
 		get
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from 0" $ do
 		tmp <- prepTmp k
 		liftIO $ writeFile tmp ""
-		removeAnnex k
+		lockContent k removeAnnex
 		get
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from end" $ do
 		loc <- Annex.calcRepo (gitAnnexLocation k)
 		tmp <- prepTmp k
 		void $ liftIO $ copyFileExternal loc tmp
-		removeAnnex k
+		lockContent k removeAnnex
 		get
 	, check "fsck downloaded object" fsck
 	, check "removeKey when present" remove
@@ -183,7 +183,7 @@ testUnavailable st r k =
 cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup
 cleanup rs ks ok = do
 	forM_ rs $ \r -> forM_ ks (Remote.removeKey r)
-	forM_ ks removeAnnex
+	forM_ ks $ \k -> lockContent k removeAnnex
 	return ok
 
 chunkSizes :: Int -> Bool -> [Int]

Command/Uninit.hs

@@ -103,7 +103,7 @@ removeUnannexed = go []
   	go c [] = return c
 	go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks)
 		( do
-			removeAnnex k
+			lockContent k removeAnnex
 			go c ks
 		, go (k:c) ks
 		)

Remote/Git.hs

@@ -339,8 +339,8 @@ dropKey r key
 			commitOnCleanup r $ onLocal r $ do
 				ensureInitialized
 				whenM (Annex.Content.inAnnex key) $ do
-					Annex.Content.lockContent key $
-						Annex.Content.removeAnnex key
+					Annex.Content.lockContent key
+						Annex.Content.removeAnnex
 					logStatus key InfoMissing
 					Annex.Content.saveState True
 				return True