diff options
| -rw-r--r-- | Annex.hs | 5 | ||||
| -rw-r--r-- | Backend/File.hs | 2 | ||||
| -rw-r--r-- | Remote.hs | 10 | ||||
| -rw-r--r-- | Remote/GitRemote.hs | 37 | ||||
| -rw-r--r-- | RemoteClass.hs | 24 | ||||
| -rw-r--r-- | Remotes.hs | 5 | ||||
| -rw-r--r-- | UUID.hs | 4 |
7 files changed, 41 insertions, 46 deletions
@@ -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. -} diff --git a/Backend/File.hs b/Backend/File.hs index 743d8d627..9c102cf50 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -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: " ++ @@ -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 diff --git a/Remote/GitRemote.hs b/Remote/GitRemote.hs index ccc5f7b42..0ec0c70e8 100644 --- a/Remote/GitRemote.hs +++ b/Remote/GitRemote.hs @@ -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 diff --git a/RemoteClass.hs b/RemoteClass.hs index df2aefb71..9fef0e44a 100644 --- a/RemoteClass.hs +++ b/RemoteClass.hs @@ -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) diff --git a/Remotes.hs b/Remotes.hs index 5fc594ee2..7f6a6718b 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -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 @@ -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 () |