diff --git a/Annex/Drop.hs b/Annex/Drop.hs index 6f3b95615e..a99a1edff5 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 similarity index 51% rename from Config/NumCopies.hs rename to Annex/NumCopies.hs index 50dcdf6842..62cd938833 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 + - Copyright 2014-2015 Joey Hess - - 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/Assistant/WebApp/Configurators/Preferences.hs b/Assistant/WebApp/Configurators/Preferences.hs index 754b96a056..ddf542c730 100644 --- a/Assistant/WebApp/Configurators/Preferences.hs +++ b/Assistant/WebApp/Configurators/Preferences.hs @@ -17,7 +17,7 @@ import qualified Annex import qualified Git import Config import Config.Files -import Config.NumCopies +import Annex.NumCopies import Utility.DataUnits import Git.Config import Types.Distribution diff --git a/Command/Copy.hs b/Command/Copy.hs index 1b9b2aac89..5cfdabb4ea 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 f6a9cce4c6..a1362ca844 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 [] [] +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 - 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 - 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 36ff49720d..d441a4bd2c 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 eea0ebc11a..46d7c2e776 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 922aee06a5..7e95493eb9 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 b7cb3232f5..1c2dd2fb2f 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 a04efb89bd..14f70d3b67 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 6c69b2166f..1e710f561a 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 030ee6a5fe..c412637bb1 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