refactor
This commit is contained in:
parent
39d0bcb793
commit
d475aac375
3 changed files with 29 additions and 21 deletions
|
@ -16,7 +16,6 @@ module Backend.File (backend, checkKey) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Data.List (intersect)
|
|
||||||
|
|
||||||
import TypeInternals
|
import TypeInternals
|
||||||
import LocationLog
|
import LocationLog
|
||||||
|
@ -50,7 +49,8 @@ dummyStore _ _ = return True
|
||||||
- and copy it over to this one. -}
|
- and copy it over to this one. -}
|
||||||
copyKeyFile :: Key -> FilePath -> Annex Bool
|
copyKeyFile :: Key -> FilePath -> Annex Bool
|
||||||
copyKeyFile key file = do
|
copyKeyFile key file = do
|
||||||
remotes <- Remotes.keyPossibilities key
|
(trusted, untrusted) <- Remotes.keyPossibilities key
|
||||||
|
let remotes = trusted ++ untrusted
|
||||||
if null remotes
|
if null remotes
|
||||||
then do
|
then do
|
||||||
showNote "not available"
|
showNote "not available"
|
||||||
|
@ -92,16 +92,11 @@ checkRemoveKey key numcopiesM = do
|
||||||
if force || numcopiesM == Just 0
|
if force || numcopiesM == Just 0
|
||||||
then return True
|
then return True
|
||||||
else do
|
else do
|
||||||
g <- Annex.gitRepo
|
(trusted, untrusted) <- Remotes.keyPossibilities key
|
||||||
locations <- liftIO $ keyLocations g key
|
|
||||||
trusted <- getTrusted
|
|
||||||
let trustedcopies = length $ intersect locations trusted
|
|
||||||
remotes <- Remotes.keyPossibilities key
|
|
||||||
untrustedremotes <- reposWithoutUUID remotes trusted
|
|
||||||
numcopies <- getNumCopies numcopiesM
|
numcopies <- getNumCopies numcopiesM
|
||||||
if numcopies > length untrustedremotes
|
if numcopies > length untrusted
|
||||||
then notEnoughCopies numcopies (length untrustedremotes) []
|
then notEnoughCopies numcopies (length untrusted) []
|
||||||
else findcopies numcopies trustedcopies untrustedremotes []
|
else findcopies numcopies (length trusted) untrusted []
|
||||||
where
|
where
|
||||||
findcopies need have [] bad
|
findcopies need have [] bad
|
||||||
| have >= need = return True
|
| have >= need = return True
|
||||||
|
|
|
@ -110,8 +110,8 @@ toCleanup move remote key tmpfile = do
|
||||||
fromStart :: Bool -> SubCmdStartString
|
fromStart :: Bool -> SubCmdStartString
|
||||||
fromStart move file = isAnnexed file $ \(key, _) -> do
|
fromStart move file = isAnnexed file $ \(key, _) -> do
|
||||||
remote <- Remotes.commandLineRemote
|
remote <- Remotes.commandLineRemote
|
||||||
l <- Remotes.keyPossibilities key
|
(trusted, untrusted) <- Remotes.keyPossibilities key
|
||||||
if null $ filter (\r -> Remotes.same r remote) l
|
if null $ filter (\r -> Remotes.same r remote) (trusted ++ untrusted)
|
||||||
then return Nothing
|
then return Nothing
|
||||||
else do
|
else do
|
||||||
showAction move file
|
showAction move file
|
||||||
|
|
29
Remotes.hs
29
Remotes.hs
|
@ -24,7 +24,7 @@ import qualified Data.Map as Map
|
||||||
import Data.String.Utils
|
import Data.String.Utils
|
||||||
import System.Directory hiding (copyFile)
|
import System.Directory hiding (copyFile)
|
||||||
import System.Posix.Directory
|
import System.Posix.Directory
|
||||||
import Data.List
|
import Data.List (intersect, sortBy)
|
||||||
import Control.Monad (when, unless, filterM)
|
import Control.Monad (when, unless, filterM)
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
@ -43,11 +43,11 @@ import qualified SysConfig
|
||||||
list :: [Git.Repo] -> String
|
list :: [Git.Repo] -> String
|
||||||
list remotes = join ", " $ map Git.repoDescribe remotes
|
list remotes = join ", " $ map Git.repoDescribe remotes
|
||||||
|
|
||||||
{- Cost ordered list of remotes that the LocationLog indicate may have a key. -}
|
{- Cost ordered lists of remotes that the LocationLog indicate may have a key.
|
||||||
keyPossibilities :: Key -> Annex [Git.Repo]
|
- The first list is of remotes that are trusted to have the key; the
|
||||||
|
- second is of untrusted remotes that may have the key. -}
|
||||||
|
keyPossibilities :: Key -> Annex ([Git.Repo], [Git.Repo])
|
||||||
keyPossibilities key = do
|
keyPossibilities key = do
|
||||||
g <- Annex.gitRepo
|
|
||||||
uuids <- liftIO $ keyLocations g key
|
|
||||||
allremotes <- remotesByCost
|
allremotes <- remotesByCost
|
||||||
-- To determine if a remote has a key, its UUID needs to be known.
|
-- To determine if a remote has a key, its UUID needs to be known.
|
||||||
-- The locally cached UUIDs of remotes can fall out of date if
|
-- The locally cached UUIDs of remotes can fall out of date if
|
||||||
|
@ -56,7 +56,7 @@ keyPossibilities key = do
|
||||||
-- sure we only do it once per git-annex run.
|
-- sure we only do it once per git-annex run.
|
||||||
remotesread <- Annex.flagIsSet "remotesread"
|
remotesread <- Annex.flagIsSet "remotesread"
|
||||||
if remotesread
|
if remotesread
|
||||||
then reposByUUID allremotes uuids
|
then partition allremotes
|
||||||
else do
|
else do
|
||||||
-- We assume that it's cheap to read the config
|
-- We assume that it's cheap to read the config
|
||||||
-- of non-URL remotes, so that is done each time.
|
-- of non-URL remotes, so that is done each time.
|
||||||
|
@ -74,11 +74,24 @@ keyPossibilities key = do
|
||||||
_ <- mapM tryGitConfigRead todo
|
_ <- mapM tryGitConfigRead todo
|
||||||
Annex.flagChange "remotesread" $ FlagBool True
|
Annex.flagChange "remotesread" $ FlagBool True
|
||||||
keyPossibilities key
|
keyPossibilities key
|
||||||
else reposByUUID allremotes uuids
|
else partition allremotes
|
||||||
where
|
where
|
||||||
cachedUUID r = do
|
cachedUUID r = do
|
||||||
u <- getUUID r
|
u <- getUUID r
|
||||||
return $ null u
|
return $ null u
|
||||||
|
partition allremotes = do
|
||||||
|
g <- Annex.gitRepo
|
||||||
|
validuuids <- liftIO $ keyLocations g key
|
||||||
|
alltrusted <- getTrusted
|
||||||
|
-- get uuids trusted to have the key
|
||||||
|
-- note that validuuids is assumed to not have dups
|
||||||
|
let validtrusted = intersect validuuids alltrusted
|
||||||
|
-- remotes that match uuids that have the key
|
||||||
|
validremotes <- reposByUUID allremotes validuuids
|
||||||
|
-- partition out the trusted and untrusted remotes
|
||||||
|
trustedremotes <- reposByUUID validremotes validtrusted
|
||||||
|
untrustedremotes <- reposWithoutUUID validremotes alltrusted
|
||||||
|
return (trustedremotes, untrustedremotes)
|
||||||
|
|
||||||
{- Checks if a given remote has the content for a key inAnnex.
|
{- Checks if a given remote has the content for a key inAnnex.
|
||||||
- If the remote cannot be accessed, returns a Left error.
|
- If the remote cannot be accessed, returns a Left error.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue