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.

1 files changed, 13 insertions, 6 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 90ab7db58..86b78c04e 100644
--- a/Annex/Content.hs
+++ b/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