diff --git a/Command/Drop.hs b/Command/Drop.hs index 6bbdb58fd2..8b361ed56f 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 f9027ba61b..8349631de2 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 a253b08897..d9d561b0dd 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 b616093a38..d485d37939 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 ab4137d75f..987c3079fb 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 9f8bd4ccf7..68237b939d 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 3a63642c87..c720e55b29 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 8f7e69cbd3..725b302b84 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 e699036347..8529b63415 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 98eeeb031f..5d3c0af5c5 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 829a2661a9..fd6c25c159 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 c8a34f2e7a..d381e0b72b 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 c04cdae584..2ced67e308 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 ae0281064b..257eba2e1c 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 730093a3b2..7f4173d033 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 24851e17cb..1bf79a81ea 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,