finish and use lockContent interface
This commit is contained in:
parent
cf79dffa4c
commit
ceb5819538
2 changed files with 17 additions and 8 deletions
|
@ -26,6 +26,7 @@ import Logs.NumCopies
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Annex.CheckAttr
|
import Annex.CheckAttr
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
import qualified Types.Remote as Remote
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
|
||||||
|
@ -122,12 +123,18 @@ verifyEnoughCopiesToDrop nolocmsg key need skip preverified tocheck dropaction n
|
||||||
case p of
|
case p of
|
||||||
Right proof -> dropaction proof
|
Right proof -> dropaction proof
|
||||||
Left stillhave -> helper bad missing stillhave (r:rs)
|
Left stillhave -> helper bad missing stillhave (r:rs)
|
||||||
| otherwise = do
|
| otherwise = case Remote.lockContent r of
|
||||||
haskey <- Remote.hasKey r key
|
Nothing -> fallback
|
||||||
case haskey of
|
Just lockcontent -> lockcontent key $ \v -> case v of
|
||||||
Right True -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy r : have) rs
|
Nothing -> fallback
|
||||||
Left _ -> helper (r:bad) missing have rs
|
Just vc -> helper bad missing (vc : have) rs
|
||||||
Right False -> helper bad (Remote.uuid r:missing) 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 -> NumCopies -> [VerifiedCopy] -> [UUID] -> [Remote] -> String -> Annex ()
|
||||||
notEnoughCopies key need have skip bad nolocmsg = do
|
notEnoughCopies key need have skip bad nolocmsg = do
|
||||||
|
|
|
@ -30,6 +30,7 @@ import Types.GitConfig
|
||||||
import Types.Availability
|
import Types.Availability
|
||||||
import Types.Creds
|
import Types.Creds
|
||||||
import Types.UrlContents
|
import Types.UrlContents
|
||||||
|
import Types.NumCopies
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Git.Types
|
import Git.Types
|
||||||
|
@ -77,9 +78,10 @@ data RemoteA a = Remote {
|
||||||
-- 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,
|
removeKey :: Key -> a Bool,
|
||||||
-- Uses locking to prevent removal of a key's contents,
|
-- 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.
|
-- 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.
|
-- Checks if a key is present in the remote.
|
||||||
-- Throws an exception if the remote cannot be accessed.
|
-- Throws an exception if the remote cannot be accessed.
|
||||||
checkPresent :: Key -> a Bool,
|
checkPresent :: Key -> a Bool,
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue