add remotes slot to Annex
This required parameterizing the type for Remote, to avoid a cycle.
This commit is contained in:
parent
b40f253d6e
commit
f30320aa75
7 changed files with 41 additions and 46 deletions
5
Annex.hs
5
Annex.hs
|
@ -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. -}
|
||||
|
|
|
@ -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: " ++
|
||||
|
|
10
Remote.hs
10
Remote.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
4
UUID.hs
4
UUID.hs
|
@ -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 ()
|
||||
|
|
Loading…
Reference in a new issue