summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-10-08 16:55:11 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-10-08 16:55:11 -0400
commitd5494842274030d21356c7492e6de5969173c34d (patch)
treea1c25eacba4e6b98b0b1bf275a89ecc7ea0e20d2 /Annex
parent55fb90edfc8732b08bea9239a6f4a471ac7867c3 (diff)
add VerifiedCopy data type
There should be no behavior changes in this commit, it just adds a more expressive data type and adjusts code that had been passing around a [UUID] or sometimes a Maybe Remote to instead use [VerifiedCopy]. Although, since some functions were taking two different [UUID] lists, there's some potential for me to have gotten it horribly wrong.
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Content.hs12
-rw-r--r--Annex/Drop.hs11
-rw-r--r--Annex/NumCopies.hs24
3 files changed, 25 insertions, 22 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 8fbb49ce6..e45d9ea05 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -67,6 +67,8 @@ import Messages.Progress
import qualified Types.Remote
import qualified Types.Backend
import qualified Backend
+import Types.NumCopies
+import Annex.UUID
{- Checks if a given key's content is currently present. -}
inAnnex :: Key -> Annex Bool
@@ -178,8 +180,10 @@ contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)
- Note that, in direct mode, nothing prevents the user from directly
- editing or removing the content, even while it's locked by this.
-}
-lockContentShared :: Key -> Annex a -> Annex a
-lockContentShared = lockContentUsing lock
+lockContentShared :: Key -> (VerifiedCopy -> Annex a) -> Annex a
+lockContentShared key a = lockContentUsing lock key $ do
+ u <- getUUID
+ a (VerifiedCopyLock u (return ()))
where
#ifndef mingw32_HOST_OS
lock contentfile Nothing = liftIO $ tryLockShared Nothing contentfile
@@ -195,7 +199,7 @@ newtype ContentLockExclusive = ContentLockExclusive Key
-}
lockContentExclusive :: Key -> (ContentLockExclusive -> Annex a) -> Annex a
lockContentExclusive key a = lockContentUsing lock key $
- a $ ContentLockExclusive key
+ a (ContentLockExclusive key)
where
#ifndef mingw32_HOST_OS
{- Since content files are stored with the write bit disabled, have
@@ -238,7 +242,7 @@ lockContentUsing locker key a = do
bracket
(lock contentfile lockfile)
(unlock lockfile)
- (const $ a)
+ (const a)
where
alreadylocked = error "content is locked"
failedtolock e = error $ "failed to lock content: " ++ show e
diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index 973e51348..791273d8e 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -32,9 +32,8 @@ type Reason = String
- only ones that match the UUIDs will be dropped from.
- If allowed to drop fromhere, that drop will be tried first.
-
- - A remote can be specified that is known to have the key. This can be
- - used an an optimisation when eg, a key has just been uploaded to a
- - remote.
+ - A VerifiedCopy can be provided as an optimisation when eg, a key
+ - has just been uploaded to a remote.
-
- In direct mode, all associated files are checked, and only if all
- of them are unwanted are they dropped.
@@ -42,8 +41,8 @@ type Reason = String
- The runner is used to run commands, and so can be either callCommand
- or commandAction.
-}
-handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> (CommandStart -> CommandCleanup) -> Annex ()
-handleDropsFrom locs rs reason fromhere key afile knownpresentremote runner = do
+handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> [VerifiedCopy] -> (CommandStart -> CommandCleanup) -> Annex ()
+handleDropsFrom locs rs reason fromhere key afile preverified runner = do
fs <- ifM isDirect
( do
l <- associatedFilesRelative key
@@ -112,7 +111,7 @@ handleDropsFrom locs rs reason fromhere key afile knownpresentremote runner = do
)
dropl fs n = checkdrop fs n Nothing $ \numcopies ->
- Command.Drop.startLocal afile numcopies key knownpresentremote
+ Command.Drop.startLocal afile numcopies key preverified
dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
Command.Drop.startRemote afile numcopies key r
diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs
index 3f078b8f0..549c72207 100644
--- a/Annex/NumCopies.hs
+++ b/Annex/NumCopies.hs
@@ -96,11 +96,11 @@ verifyEnoughCopies
-> Key
-> NumCopies
-> [UUID] -- repos to skip considering (generally untrusted remotes)
- -> [UUID] -- repos that are trusted or already verified to have it
+ -> [VerifiedCopy] -- already known verifications
-> [Remote] -- remotes to check to see if they have it
-> Annex Bool
-verifyEnoughCopies nolocmsg key need skip trusted tocheck =
- helper [] [] (nub trusted) (nub tocheck)
+verifyEnoughCopies nolocmsg key need skip preverified tocheck =
+ helper [] [] (deDupVerifiedCopies preverified) (nub tocheck)
where
helper bad missing have []
| NumCopies (length have) >= need = return True
@@ -109,17 +109,17 @@ verifyEnoughCopies nolocmsg key need skip trusted tocheck =
return False
helper bad missing have (r:rs)
| NumCopies (length have) >= need = return True
+ | any (== u) (map toUUID have) = helper bad missing have rs
| otherwise = do
- let u = Remote.uuid r
- let duplicate = u `elem` have
haskey <- Remote.hasKey r key
- case (duplicate, haskey) of
- (False, Right True) -> helper bad missing (u:have) rs
- (False, Left _) -> helper (r:bad) missing have rs
- (False, Right False) -> helper bad (u:missing) have rs
- _ -> helper bad missing have rs
+ case haskey of
+ Right True -> helper bad missing (VerifiedCopy u:have) rs
+ Left _ -> helper (r:bad) missing have rs
+ Right False -> helper bad (u:missing) have rs
+ where
+ u = Remote.uuid r
-notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> String -> Annex ()
+notEnoughCopies :: Key -> NumCopies -> [VerifiedCopy] -> [UUID] -> [Remote] -> String -> Annex ()
notEnoughCopies key need have skip bad nolocmsg = do
showNote "unsafe"
showLongNote $
@@ -127,7 +127,7 @@ notEnoughCopies key need have skip bad nolocmsg = do
show (length have) ++ " out of " ++ show (fromNumCopies need) ++
" necessary copies"
Remote.showTriedRemotes bad
- Remote.showLocations True key (have++skip) nolocmsg
+ Remote.showLocations True key (map toUUID have++skip) nolocmsg
{- Cost ordered lists of remotes that the location log indicates
- may have a key.