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 GitQueue
import qualified BackendClass
import qualified RemoteClass
import Utility
-- git-annex's monad
@ -37,6 +38,7 @@ data AnnexState = AnnexState
{ repo :: Git.Repo
, backends :: [BackendClass.Backend Annex]
, supportedBackends :: [BackendClass.Backend Annex]
, remotes :: [RemoteClass.Remote Annex]
, repoqueue :: GitQueue.Queue
, quiet :: Bool
, force :: Bool
@ -46,13 +48,13 @@ data AnnexState = AnnexState
, toremote :: Maybe String
, fromremote :: Maybe String
, exclude :: [String]
, remotesread :: Bool
} deriving (Show)
newState :: Git.Repo -> [BackendClass.Backend Annex] -> AnnexState
newState gitrepo allbackends = AnnexState
{ repo = gitrepo
, backends = []
, remotes = []
, supportedBackends = allbackends
, repoqueue = GitQueue.empty
, quiet = False
@ -63,7 +65,6 @@ newState gitrepo allbackends = AnnexState
, toremote = Nothing
, fromremote = Nothing
, exclude = []
, remotesread = False
}
{- 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 rs us = message rs [] ++ message [] us
showTriedRemotes :: [RemoteClass.Remote] -> Annex ()
showTriedRemotes :: [RemoteClass.Remote Annex] -> Annex ()
showTriedRemotes [] = return ()
showTriedRemotes remotes =
showLongNote $ "Unable to access these remotes: " ++

View file

@ -24,21 +24,21 @@ import Trust
import LocationLog
{- add generators for new Remotes here -}
generators :: [Annex [Remote]]
generators :: [Annex [Remote Annex]]
generators = [Remote.GitRemote.generate]
{- generates a list of all available Remotes -}
generate :: Annex [Remote]
generate :: Annex [Remote Annex]
generate = do
lists <- sequence generators
return $ concat lists
{- 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
{- 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
{- 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
- (some may not have configured remotes).
-}
keyPossibilities :: Key -> Annex ([Remote], [UUID])
keyPossibilities :: Key -> Annex ([Remote Annex], [UUID])
keyPossibilities key = do
g <- Annex.gitRepo
u <- getUUID g

View file

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

View file

@ -9,38 +9,36 @@ module RemoteClass where
import Control.Exception
import Annex
import UUID
import Key
data Remote = Remote {
data Remote a = Remote {
-- each Remote has a unique uuid
uuid :: UUID,
uuid :: String,
-- each Remote has a human visible name
name :: String,
-- Remotes have a use cost; higher is more expensive
cost :: Int,
-- Transfers a key to the remote.
storeKey :: Key -> Annex Bool,
storeKey :: Key -> a Bool,
-- retrieves a key's contents to a file
retrieveKeyFile :: Key -> FilePath -> Annex Bool,
retrieveKeyFile :: Key -> FilePath -> a Bool,
-- 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
-- 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
-- operation.
hasKeyCheap :: Bool
}
instance Show Remote where
instance Show (Remote a) where
show remote = "Remote { uuid =\"" ++ uuid remote ++ "\" }"
-- two remotes are the same if they have the same uuid
instance Eq Remote where
a == b = uuid a == uuid b
instance Eq (Remote a) where
x == y = uuid x == uuid y
-- order remotes by cost
instance Ord Remote where
compare a b = compare (cost a) (cost b)
instance Ord (Remote a) where
compare x y = compare (cost x) (cost y)

View file

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

View file

@ -36,7 +36,7 @@ import qualified SysConfig
type UUID = String
configkey :: String
configkey="annex.uuid"
configkey = "annex.uuid"
{- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -}
@ -74,7 +74,7 @@ getUUID r = do
cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-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. -}
prepUUID :: Annex ()