refactor
This commit is contained in:
parent
9e10b5ca9c
commit
38c458b407
12 changed files with 91 additions and 60 deletions
|
@ -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
|
||||
|
|
|
@ -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')
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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] $
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
|
2
Limit.hs
2
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
|
||||
|
|
Loading…
Reference in a new issue