add removeKey action to Remote

Not implemented for any remotes yet; probably the git remote is the only
one that will ever implement it.

16 files changed, 22 insertions, 2 deletions

diff --git a/Command/Drop.hs b/Command/Drop.hs
index 6bbdb58fd..8b361ed56 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -91,7 +91,7 @@ startRemote afile numcopies key remote = do
 -- Note that lockContentExclusive 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.
+-- sees the key is present on the other.
 performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform
 performLocal key afile numcopies knownpresentremote = lockContentExclusive key $ \contentlock -> do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index f9027ba61..8349631de 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -58,6 +58,7 @@ gen r _ c gc =
 		, retrieveKeyFile = downloadKey
 		, retrieveKeyFileCheap = downloadKeyCheap
 		, removeKey = dropKey
+		, lockContent = Nothing
 		, checkPresent = checkKey
 		, checkPresentCheap = False
 		, whereisKey = Nothing
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index a253b0889..d9d561b0d 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -58,6 +58,7 @@ gen r u c gc = do
 		, retrieveKeyFile = retreiveKeyFileDummy
 		, retrieveKeyFileCheap = retrieveCheap buprepo
 		, removeKey = removeKeyDummy
+		, lockContent = Nothing
 		, checkPresent = checkPresentDummy
 		, checkPresentCheap = bupLocal buprepo
 		, whereisKey = Nothing
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index b616093a3..d485d3793 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -57,6 +57,7 @@ gen r u c gc = do
 		, retrieveKeyFile = retreiveKeyFileDummy
 		, retrieveKeyFileCheap = retrieveCheap
 		, removeKey = removeKeyDummy
+		, lockContent = Nothing
 		, checkPresent = checkPresentDummy
 		, checkPresentCheap = ddarLocal ddarrepo
 		, whereisKey = Nothing
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index ab4137d75..987c3079f 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -55,6 +55,7 @@ gen r u c gc = do
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap dir chunkconfig
 			, removeKey = removeKeyDummy
+			, lockContent = Nothing
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = True
 			, whereisKey = Nothing
diff --git a/Remote/External.hs b/Remote/External.hs
index 9f8bd4ccf..68237b939 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -81,6 +81,7 @@ gen r u c gc
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = \_ _ _ -> return False
 			, removeKey = removeKeyDummy
+			, lockContent = Nothing
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = False
 			, whereisKey = towhereis
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 3a63642c8..c720e55b2 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -111,6 +111,7 @@ gen' r u c gc = do
 		, retrieveKeyFile = retreiveKeyFileDummy
 		, retrieveKeyFileCheap = \_ _ _ -> return False
 		, removeKey = removeKeyDummy
+		, lockContent = Nothing
 		, checkPresent = checkPresentDummy
 		, checkPresentCheap = repoCheap r
 		, whereisKey = Nothing
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 8f7e69cbd..725b302b8 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -142,6 +142,7 @@ gen r u c gc
 			, retrieveKeyFile = copyFromRemote new
 			, retrieveKeyFileCheap = copyFromRemoteCheap new
 			, removeKey = dropKey new
+			, lockContent = Nothing
 			, checkPresent = inAnnex new
 			, checkPresentCheap = repoCheap r
 			, whereisKey = Nothing
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index e69903634..8529b6341 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -55,6 +55,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap this
 			, removeKey = removeKeyDummy
+			, lockContent = Nothing
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = False
 			, whereisKey = Nothing
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 98eeeb031..5d3c0af5c 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -49,6 +49,7 @@ gen r u c gc = do
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap hooktype
 			, removeKey = removeKeyDummy
+			, lockContent = Nothing
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = False
 			, whereisKey = Nothing
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 829a2661a..fd6c25c15 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -70,6 +70,7 @@ gen r u c gc = do
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap o
 			, removeKey = removeKeyDummy
+			, lockContent = Nothing
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = False
 			, whereisKey = Nothing
diff --git a/Remote/S3.hs b/Remote/S3.hs
index c8a34f2e7..d381e0b72 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -81,6 +81,7 @@ gen r u c gc = do
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap
 			, removeKey = removeKeyDummy
+			, lockContent = Nothing
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = False
 			, whereisKey = Just (getWebUrls info)
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index c04cdae58..2ced67e30 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -72,6 +72,7 @@ gen r u c gc = do
 		, retrieveKeyFile = retrieve u hdl
 		, retrieveKeyFileCheap = \_ _ _ -> return False
 		, removeKey = remove
+		, lockContent = Nothing
 		, checkPresent = checkKey u hdl
 		, checkPresentCheap = False
 		, whereisKey = Nothing
diff --git a/Remote/Web.hs b/Remote/Web.hs
index ae0281064..257eba2e1 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -52,6 +52,7 @@ gen r _ c gc =
 		, retrieveKeyFile = downloadKey
 		, retrieveKeyFileCheap = downloadKeyCheap
 		, removeKey = dropKey
+		, lockContent = Nothing
 		, checkPresent = checkKey
 		, checkPresentCheap = False
 		, whereisKey = Nothing
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 730093a3b..7f4173d03 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -60,6 +60,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			, retrieveKeyFile = retreiveKeyFileDummy
 			, retrieveKeyFileCheap = retrieveCheap
 			, removeKey = removeKeyDummy
+			, lockContent = Nothing
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = False
 			, whereisKey = Nothing
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 24851e17c..1bf79a81e 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -7,6 +7,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE RankNTypes #-}
+
 module Types.Remote
 	( RemoteConfigKey
 	, RemoteConfig
@@ -72,8 +74,12 @@ data RemoteA a = Remote {
 	-- Retrieves a key's contents to a tmp file, if it can be done cheaply.
 	-- It's ok to create a symlink or hardlink.
 	retrieveKeyFileCheap :: Key -> AssociatedFile -> FilePath -> a Bool,
-	-- removes a key's contents (succeeds if the contents are not present)
+	-- Removes a key's contents (succeeds if the contents are not present)
 	removeKey :: Key -> a Bool,
+	-- Uses locking to prevent removal of a key's contents,
+	-- and runs the passed action while it's locked.
+	-- This is optional; remotes do not have to support locking.
+	lockContent :: forall r. Maybe (Key -> a r -> a r),
 	-- Checks if a key is present in the remote.
 	-- Throws an exception if the remote cannot be accessed.
 	checkPresent :: Key -> a Bool,