add remotes slot to Annex

This required parameterizing the type for Remote, to avoid a cycle.
This commit is contained in:
Joey Hess 2011-03-27 16:17:56 -04:00
parent b40f253d6e
commit f30320aa75
7 changed files with 41 additions and 46 deletions

View file

@ -27,6 +27,7 @@ import Data.Maybe
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitQueue import qualified GitQueue
import qualified BackendClass import qualified BackendClass
import qualified RemoteClass
import Utility import Utility
-- git-annex's monad -- git-annex's monad
@ -37,6 +38,7 @@ data AnnexState = AnnexState
{ repo :: Git.Repo { repo :: Git.Repo
, backends :: [BackendClass.Backend Annex] , backends :: [BackendClass.Backend Annex]
, supportedBackends :: [BackendClass.Backend Annex] , supportedBackends :: [BackendClass.Backend Annex]
, remotes :: [RemoteClass.Remote Annex]
, repoqueue :: GitQueue.Queue , repoqueue :: GitQueue.Queue
, quiet :: Bool , quiet :: Bool
, force :: Bool , force :: Bool
@ -46,13 +48,13 @@ data AnnexState = AnnexState
, toremote :: Maybe String , toremote :: Maybe String
, fromremote :: Maybe String , fromremote :: Maybe String
, exclude :: [String] , exclude :: [String]
, remotesread :: Bool
} deriving (Show) } deriving (Show)
newState :: Git.Repo -> [BackendClass.Backend Annex] -> AnnexState newState :: Git.Repo -> [BackendClass.Backend Annex] -> AnnexState
newState gitrepo allbackends = AnnexState newState gitrepo allbackends = AnnexState
{ repo = gitrepo { repo = gitrepo
, backends = [] , backends = []
, remotes = []
, supportedBackends = allbackends , supportedBackends = allbackends
, repoqueue = GitQueue.empty , repoqueue = GitQueue.empty
, quiet = False , quiet = False
@ -63,7 +65,6 @@ newState gitrepo allbackends = AnnexState
, toremote = Nothing , toremote = Nothing
, fromremote = Nothing , fromremote = Nothing
, exclude = [] , exclude = []
, remotesread = False
} }
{- Create and returns an Annex state object for the specified git repo. -} {- Create and returns an Annex state object for the specified git repo. -}

View file

@ -147,7 +147,7 @@ showLocations key exclude = do
message [] us = "Also these untrusted repositories may contain the file:\n" ++ us message [] us = "Also these untrusted repositories may contain the file:\n" ++ us
message rs us = message rs [] ++ message [] us message rs us = message rs [] ++ message [] us
showTriedRemotes :: [RemoteClass.Remote] -> Annex () showTriedRemotes :: [RemoteClass.Remote Annex] -> Annex ()
showTriedRemotes [] = return () showTriedRemotes [] = return ()
showTriedRemotes remotes = showTriedRemotes remotes =
showLongNote $ "Unable to access these remotes: " ++ showLongNote $ "Unable to access these remotes: " ++

View file

@ -24,21 +24,21 @@ import Trust
import LocationLog import LocationLog
{- add generators for new Remotes here -} {- add generators for new Remotes here -}
generators :: [Annex [Remote]] generators :: [Annex [Remote Annex]]
generators = [Remote.GitRemote.generate] generators = [Remote.GitRemote.generate]
{- generates a list of all available Remotes -} {- generates a list of all available Remotes -}
generate :: Annex [Remote] generate :: Annex [Remote Annex]
generate = do generate = do
lists <- sequence generators lists <- sequence generators
return $ concat lists return $ concat lists
{- Filters a list of remotes to ones that have the listed uuids. -} {- Filters a list of remotes to ones that have the listed uuids. -}
remotesWithUUID :: [Remote] -> [UUID] -> [Remote] remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
{- Filters a list of remotes to ones that do not have the listed uuids. -} {- Filters a list of remotes to ones that do not have the listed uuids. -}
remotesWithoutUUID :: [Remote] -> [UUID] -> [Remote] remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
{- Cost ordered lists of remotes that the LocationLog indicate may have a key. {- Cost ordered lists of remotes that the LocationLog indicate may have a key.
@ -46,7 +46,7 @@ remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
- Also returns a list of UUIDs that are trusted to have the key - Also returns a list of UUIDs that are trusted to have the key
- (some may not have configured remotes). - (some may not have configured remotes).
-} -}
keyPossibilities :: Key -> Annex ([Remote], [UUID]) keyPossibilities :: Key -> Annex ([Remote Annex], [UUID])
keyPossibilities key = do keyPossibilities key = do
g <- Annex.gitRepo g <- Annex.gitRepo
u <- getUUID g u <- getUUID g

View file

@ -27,14 +27,14 @@ import CopyFile
import RsyncFile import RsyncFile
import Ssh import Ssh
generate :: Annex [Remote] generate :: Annex [Remote Annex]
generate = do generate = do
readConfigs readConfigs
g <- Annex.gitRepo g <- Annex.gitRepo
rs <- filterM repoNotIgnored (Git.remotes g) rs <- filterM repoNotIgnored (Git.remotes g)
mapM genRemote rs mapM genRemote rs
genRemote :: Git.Repo -> Annex Remote genRemote :: Git.Repo -> Annex (Remote Annex)
genRemote r = do genRemote r = do
u <- getUUID r u <- getUUID r
c <- repoCost r c <- repoCost r
@ -49,31 +49,26 @@ genRemote r = do
hasKeyCheap = not (Git.repoIsUrl r) hasKeyCheap = not (Git.repoIsUrl r)
} }
{- Reads the configs of all remotes. {- Reads the configs of git remotes.
- -
- As reading the config of remotes can be expensive, this - It's assumed to be cheap to read the config of non-URL remotes,
- function will only read configs once per git-annex run. It's
- assumed to be cheap to read the config of non-URL remotes,
- so this is done each time git-annex is run. Conversely, - so this is done each time git-annex is run. Conversely,
- the config of an URL remote is only read when there is no - the config of an URL remote is only read when there is no
- cached UUID value. - cached UUID value.
- -} -}
readConfigs :: Annex () readConfigs :: Annex ()
readConfigs = do readConfigs = do
remotesread <- Annex.getState Annex.remotesread g <- Annex.gitRepo
unless remotesread $ do allremotes <- filterM repoNotIgnored $ Git.remotes g
g <- Annex.gitRepo let cheap = filter (not . Git.repoIsUrl) allremotes
allremotes <- filterM repoNotIgnored $ Git.remotes g let expensive = filter Git.repoIsUrl allremotes
let cheap = filter (not . Git.repoIsUrl) allremotes doexpensive <- filterM cachedUUID expensive
let expensive = filter Git.repoIsUrl allremotes unless (null doexpensive) $
doexpensive <- filterM cachedUUID expensive showNote $ "getting UUID for " ++
unless (null doexpensive) $ list doexpensive ++ "..."
showNote $ "getting UUID for " ++ let todo = cheap ++ doexpensive
list doexpensive ++ "..." unless (null todo) $ do
let todo = cheap ++ doexpensive mapM_ tryGitConfigRead todo
unless (null todo) $ do
mapM_ tryGitConfigRead todo
Annex.changeState $ \s -> s { Annex.remotesread = True }
where where
cachedUUID r = do cachedUUID r = do
u <- getUUID r u <- getUUID r

View file

@ -9,38 +9,36 @@ module RemoteClass where
import Control.Exception import Control.Exception
import Annex
import UUID
import Key import Key
data Remote = Remote { data Remote a = Remote {
-- each Remote has a unique uuid -- each Remote has a unique uuid
uuid :: UUID, uuid :: String,
-- each Remote has a human visible name -- each Remote has a human visible name
name :: String, name :: String,
-- Remotes have a use cost; higher is more expensive -- Remotes have a use cost; higher is more expensive
cost :: Int, cost :: Int,
-- Transfers a key to the remote. -- Transfers a key to the remote.
storeKey :: Key -> Annex Bool, storeKey :: Key -> a Bool,
-- retrieves a key's contents to a file -- retrieves a key's contents to a file
retrieveKeyFile :: Key -> FilePath -> Annex Bool, retrieveKeyFile :: Key -> FilePath -> a Bool,
-- removes a key's contents -- removes a key's contents
removeKey :: Key -> Annex Bool, removeKey :: Key -> a Bool,
-- Checks if a key is present in the remote; if the remote -- Checks if a key is present in the remote; if the remote
-- cannot be accessed returns a Left error. -- cannot be accessed returns a Left error.
hasKey :: Key -> Annex (Either IOException Bool), hasKey :: Key -> a (Either IOException Bool),
-- Some remotes can check hasKey without an expensive network -- Some remotes can check hasKey without an expensive network
-- operation. -- operation.
hasKeyCheap :: Bool hasKeyCheap :: Bool
} }
instance Show Remote where instance Show (Remote a) where
show remote = "Remote { uuid =\"" ++ uuid remote ++ "\" }" show remote = "Remote { uuid =\"" ++ uuid remote ++ "\" }"
-- two remotes are the same if they have the same uuid -- two remotes are the same if they have the same uuid
instance Eq Remote where instance Eq (Remote a) where
a == b = uuid a == uuid b x == y = uuid x == uuid y
-- order remotes by cost -- order remotes by cost
instance Ord Remote where instance Ord (Remote a) where
compare a b = compare (cost a) (cost b) compare x y = compare (cost x) (cost y)

View file

@ -91,7 +91,8 @@ tryGitConfigRead r
- -} - -}
readConfigs :: Annex () readConfigs :: Annex ()
readConfigs = do readConfigs = do
remotesread <- Annex.getState Annex.remotesread -- remotesread <- Annex.getState Annex.remotesread
let remotesread = False
unless remotesread $ do unless remotesread $ do
g <- Annex.gitRepo g <- Annex.gitRepo
allremotes <- filterM repoNotIgnored $ Git.remotes g allremotes <- filterM repoNotIgnored $ Git.remotes g
@ -104,7 +105,7 @@ readConfigs = do
let todo = cheap ++ doexpensive let todo = cheap ++ doexpensive
unless (null todo) $ do unless (null todo) $ do
mapM_ tryGitConfigRead todo mapM_ tryGitConfigRead todo
Annex.changeState $ \s -> s { Annex.remotesread = True } -- Annex.changeState $ \s -> s { Annex.remotesread = True }
where where
cachedUUID r = do cachedUUID r = do
u <- getUUID r u <- getUUID r

View file

@ -36,7 +36,7 @@ import qualified SysConfig
type UUID = String type UUID = String
configkey :: String configkey :: String
configkey="annex.uuid" configkey = "annex.uuid"
{- Generates a UUID. There is a library for this, but it's not packaged, {- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -} - so use the command line tool. -}
@ -74,7 +74,7 @@ getUUID r = do
cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-uuid" cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-uuid"
getUncachedUUID :: Git.Repo -> UUID getUncachedUUID :: Git.Repo -> UUID
getUncachedUUID r = Git.configGet r "annex.uuid" "" getUncachedUUID r = Git.configGet r configkey ""
{- Make sure that the repo has an annex.uuid setting. -} {- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex () prepUUID :: Annex ()