summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/NumCopies.hs19
-rw-r--r--Types/Remote.hs6
2 files changed, 17 insertions, 8 deletions
diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs
index 6c069c763..7874fb0e9 100644
--- a/Annex/NumCopies.hs
+++ b/Annex/NumCopies.hs
@@ -26,6 +26,7 @@ import Logs.NumCopies
import Logs.Trust
import Annex.CheckAttr
import qualified Remote
+import qualified Types.Remote as Remote
import Annex.UUID
import Annex.Content
@@ -122,12 +123,18 @@ verifyEnoughCopiesToDrop nolocmsg key need skip preverified tocheck dropaction n
case p of
Right proof -> dropaction proof
Left stillhave -> helper bad missing stillhave (r:rs)
- | otherwise = do
- haskey <- Remote.hasKey r key
- case haskey of
- Right True -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy r : have) rs
- Left _ -> helper (r:bad) missing have rs
- Right False -> helper bad (Remote.uuid r:missing) have rs
+ | otherwise = case Remote.lockContent r of
+ Nothing -> fallback
+ Just lockcontent -> lockcontent key $ \v -> case v of
+ Nothing -> fallback
+ Just vc -> helper bad missing (vc : have) rs
+ where
+ fallback = do
+ haskey <- Remote.hasKey r key
+ case haskey of
+ Right True -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy r : have) rs
+ Left _ -> helper (r:bad) missing have rs
+ Right False -> helper bad (Remote.uuid r:missing) have rs
notEnoughCopies :: Key -> NumCopies -> [VerifiedCopy] -> [UUID] -> [Remote] -> String -> Annex ()
notEnoughCopies key need have skip bad nolocmsg = do
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 9e5f9f735..511a85afa 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -30,6 +30,7 @@ import Types.GitConfig
import Types.Availability
import Types.Creds
import Types.UrlContents
+import Types.NumCopies
import Config.Cost
import Utility.Metered
import Git.Types
@@ -77,9 +78,10 @@ data RemoteA a = Remote {
-- 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.
+ -- thus producing a VerifiedCopy.
+ -- The action must be run whether or not the locking succeeds.
-- This is optional; remotes do not have to support locking.
- lockContent :: forall r. Maybe (Key -> a r -> a r),
+ lockContent :: forall r. Maybe (Key -> (Maybe VerifiedCopy -> 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,