aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-04-30 14:02:56 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-04-30 14:02:56 -0400
commit42ae5fec8ebbb5921f91d2052bc18d595ead2cfa (patch)
treee767f9b92bf7cc3199259188d7725e7228de5ae2
parentc4038364f3f2bc496fb45025c6bc18e9e52fd566 (diff)
refactor
-rw-r--r--Annex/Drop.hs2
-rw-r--r--Annex/NumCopies.hs (renamed from Config/NumCopies.hs)67
-rw-r--r--Command/Copy.hs2
-rw-r--r--Command/Drop.hs64
-rw-r--r--Command/DropUnused.hs2
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Command/Get.hs2
-rw-r--r--Command/Info.hs2
-rw-r--r--Command/Mirror.hs2
-rw-r--r--Command/NumCopies.hs2
-rw-r--r--Limit.hs2
11 files changed, 90 insertions, 59 deletions
diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index 6f3b95615..a99a1edff 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -9,7 +9,7 @@ module Annex.Drop where
import Common.Annex
import Logs.Trust
-import Config.NumCopies
+import Annex.NumCopies
import Types.Remote (uuid)
import Types.Key (key2file)
import qualified Remote
diff --git a/Config/NumCopies.hs b/Annex/NumCopies.hs
index 50dcdf684..62cd93883 100644
--- a/Config/NumCopies.hs
+++ b/Annex/NumCopies.hs
@@ -1,11 +1,11 @@
-{- git-annex numcopies configuration
+{- git-annex numcopies configuration and checking
-
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
-module Config.NumCopies (
+module Annex.NumCopies (
module Types.NumCopies,
module Logs.NumCopies,
getFileNumCopies,
@@ -15,6 +15,8 @@ module Config.NumCopies (
defaultNumCopies,
numCopiesCheck,
numCopiesCheck',
+ verifyEnoughCopies,
+ knownCopies,
) where
import Common.Annex
@@ -24,6 +26,8 @@ import Logs.NumCopies
import Logs.Trust
import Annex.CheckAttr
import qualified Remote
+import Annex.UUID
+import Annex.Content
defaultNumCopies :: NumCopies
defaultNumCopies = NumCopies 1
@@ -83,3 +87,60 @@ numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v
numCopiesCheck' file vs have = do
NumCopies needed <- getFileNumCopies file
return $ length have `vs` needed
+
+{- Verifies that enough copies of a key exist amoung the listed remotes,
+ - priting an informative message if not.
+ -}
+verifyEnoughCopies
+ :: String -- message to print when there are no known locations
+ -> Key
+ -> NumCopies
+ -> [UUID] -- repos to skip (generally untrusted remotes)
+ -> [UUID] -- repos that are trusted or already verified to have it
+ -> [Remote] -- remotes to check to see if they have it
+ -> Annex Bool
+verifyEnoughCopies nolocmsg key need skip = helper [] []
+ where
+ helper bad missing have []
+ | NumCopies (length have) >= need = return True
+ | otherwise = do
+ notEnoughCopies key need have (skip++missing) bad nolocmsg
+ return False
+ helper bad missing have (r:rs)
+ | NumCopies (length have) >= need = return True
+ | 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
+
+notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> String -> Annex ()
+notEnoughCopies key need have skip bad nolocmsg = do
+ showNote "unsafe"
+ showLongNote $
+ "Could only verify the existence of " ++
+ show (length have) ++ " out of " ++ show (fromNumCopies need) ++
+ " necessary copies"
+ Remote.showTriedRemotes bad
+ Remote.showLocations True key (have++skip) nolocmsg
+
+{- Cost ordered lists of remotes that the location log indicates
+ - may have a key.
+ -
+ - Also returns a list of UUIDs that are trusted to have the key
+ - (some may not have configured remotes). If the current repository
+ - currently has the key, and is not untrusted, it is included in this list.
+ -}
+knownCopies :: Key -> Annex ([Remote], [UUID])
+knownCopies key = do
+ (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
+ u <- getUUID
+ trusteduuids' <- ifM (inAnnex key <&&> (<= SemiTrusted) <$> lookupTrust u)
+ ( pure (nub (u:trusteduuids))
+ , pure trusteduuids
+ )
+ return (remotes, trusteduuids')
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 1b9b2aac8..5cfdabb4e 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -12,7 +12,7 @@ import Command
import qualified Command.Move
import qualified Remote
import Annex.Wanted
-import Config.NumCopies
+import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions copyOptions $ command "copy" paramPaths seek
diff --git a/Command/Drop.hs b/Command/Drop.hs
index f6a9cce4c..a1362ca84 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -15,7 +15,7 @@ import Annex.UUID
import Logs.Location
import Logs.Trust
import Logs.PreferredContent
-import Config.NumCopies
+import Annex.NumCopies
import Annex.Content
import Annex.Wanted
import Annex.Notification
@@ -91,14 +91,9 @@ performRemote key afile numcopies remote = do
-- Filter the remote it's being dropped from out of the lists of
-- places assumed to have the key, and places to check.
-- When the local repo has the key, that's one additional copy,
- -- as long asthe local repo is not untrusted.
- (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
- u <- getUUID
- trusteduuids' <- ifM (inAnnex key <&&> (<= SemiTrusted) <$> lookupTrust u)
- ( pure (nub (u:trusteduuids))
- , pure trusteduuids
- )
- let have = filter (/= uuid) trusteduuids'
+ -- as long as the local repo is not untrusted.
+ (remotes, trusteduuids) <- knownCopies key
+ let have = filter (/= uuid) trusteduuids
untrusteduuids <- trustGet UnTrusted
let tocheck = filter (/= remote) $
Remote.remotesWithoutUUID remotes (have++untrusteduuids)
@@ -128,45 +123,20 @@ cleanupRemote key remote ok = do
- --force overrides and always allows dropping.
-}
canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
-canDrop dropfrom key afile numcopies have check skip = ifM (Annex.getState Annex.force)
- ( return True
- , checkRequiredContent dropfrom key afile
- <&&>
- findCopies key numcopies skip have check
- )
-
-findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
-findCopies key need skip = helper [] []
- where
- helper bad missing have []
- | NumCopies (length have) >= need = return True
- | otherwise = notEnoughCopies key need have (skip++missing) bad
- helper bad missing have (r:rs)
- | NumCopies (length have) >= need = return True
- | 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
-
-notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
-notEnoughCopies key need have skip bad = do
- unsafe
- showLongNote $
- "Could only verify the existence of " ++
- show (length have) ++ " out of " ++ show (fromNumCopies need) ++
- " necessary copies"
- Remote.showTriedRemotes bad
- Remote.showLocations True key (have++skip)
- "Rather than dropping this file, try using: git annex move"
- hint
- return False
+canDrop dropfrom key afile numcopies have check skip =
+ ifM (Annex.getState Annex.force)
+ ( return True
+ , ifM (checkRequiredContent dropfrom key afile
+ <&&> verifyEnoughCopies nolocmsg key numcopies skip have check
+ )
+ ( return True
+ , do
+ hint
+ return False
+ )
+ )
where
- unsafe = showNote "unsafe"
+ nolocmsg = "Rather than dropping this file, try using: git annex move"
hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"
checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 36ff49720..d441a4bd2 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -14,7 +14,7 @@ import qualified Command.Drop
import qualified Remote
import qualified Git
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
-import Config.NumCopies
+import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions [Command.Drop.dropFromOption] $
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index eea0ebc11..46d7c2e77 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -24,7 +24,7 @@ import Annex.Link
import Logs.Location
import Logs.Trust
import Logs.Activity
-import Config.NumCopies
+import Annex.NumCopies
import Annex.UUID
import Utility.DataUnits
import Config
diff --git a/Command/Get.hs b/Command/Get.hs
index 922aee06a..7e95493eb 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -12,7 +12,7 @@ import Command
import qualified Remote
import Annex.Content
import Annex.Transfer
-import Config.NumCopies
+import Annex.NumCopies
import Annex.Wanted
import qualified Command.Move
diff --git a/Command/Info.hs b/Command/Info.hs
index b7cb3232f..1c2dd2fb2 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -30,7 +30,7 @@ import Types.Key
import Logs.UUID
import Logs.Trust
import Logs.Location
-import Config.NumCopies
+import Annex.NumCopies
import Remote
import Config
import Utility.Percentage
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index a04efb89b..14f70d3b6 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -14,7 +14,7 @@ import qualified Command.Drop
import qualified Command.Get
import qualified Remote
import Annex.Content
-import Config.NumCopies
+import Annex.NumCopies
cmd :: [Command]
cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek
diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs
index 6c69b2166..1e710f561 100644
--- a/Command/NumCopies.hs
+++ b/Command/NumCopies.hs
@@ -10,7 +10,7 @@ module Command.NumCopies where
import Common.Annex
import qualified Annex
import Command
-import Config.NumCopies
+import Annex.NumCopies
import Types.Messages
cmd :: [Command]
diff --git a/Limit.hs b/Limit.hs
index 030ee6a5f..c412637bb 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -15,7 +15,7 @@ import qualified Backend
import Annex.Content
import Annex.UUID
import Logs.Trust
-import Config.NumCopies
+import Annex.NumCopies
import Types.TrustLevel
import Types.Key
import Types.Group