diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-10-09 12:36:04 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-10-09 12:36:04 -0400 |
commit | 7788d302397096c85fe70c35f2661d76a8d2f511 (patch) | |
tree | be835fdaab4fb0abdb751fb856d7b00d5c4b86fa | |
parent | 00ba3ec15d8e3a51545aed4c6e43771f2630a0f8 (diff) |
finish and use lockContent interface
-rw-r--r-- | Annex/NumCopies.hs | 19 | ||||
-rw-r--r-- | Types/Remote.hs | 6 |
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, |