From 971ab27e7820a3228f71dd42f3e870c0fc2f4345 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 1 Jun 2011 19:10:38 -0400 Subject: [PATCH] better types allowed breaking module dep loop --- Annex.hs | 27 ++++++++++++++------------- Backend/File.hs | 5 ++--- Command/Move.hs | 5 ++--- GitAnnex.hs | 7 +++++-- Remote.hs | 28 ++++++++++++++++++++++++++++ RemoteUtils.hs | 42 ------------------------------------------ Trust.hs | 6 +----- UUID.hs | 3 +-- UUIDType.hs | 11 +++++++++++ 9 files changed, 64 insertions(+), 70 deletions(-) delete mode 100644 RemoteUtils.hs create mode 100644 UUIDType.hs diff --git a/Annex.hs b/Annex.hs index 13505de468..92a4911ea1 100644 --- a/Annex.hs +++ b/Annex.hs @@ -20,11 +20,12 @@ import Control.Monad.State (liftIO, StateT, runStateT, evalStateT, liftM, get, put) import qualified GitRepo as Git -import qualified GitQueue -import qualified BackendClass -import qualified RemoteClass -import qualified CryptoTypes +import GitQueue +import BackendClass +import RemoteClass +import CryptoTypes import TrustLevel +import UUIDType -- git-annex's monad type Annex = StateT AnnexState IO @@ -32,10 +33,10 @@ type Annex = StateT AnnexState IO -- internal state storage data AnnexState = AnnexState { repo :: Git.Repo - , backends :: [BackendClass.Backend Annex] - , supportedBackends :: [BackendClass.Backend Annex] - , remotes :: [RemoteClass.Remote Annex] - , repoqueue :: GitQueue.Queue + , backends :: [Backend Annex] + , supportedBackends :: [Backend Annex] + , remotes :: [Remote Annex] + , repoqueue :: Queue , quiet :: Bool , force :: Bool , fast :: Bool @@ -45,17 +46,17 @@ data AnnexState = AnnexState , toremote :: Maybe String , fromremote :: Maybe String , exclude :: [String] - , forcetrust :: [(String, TrustLevel)] - , cipher :: Maybe CryptoTypes.Cipher + , forcetrust :: [(UUID, TrustLevel)] + , cipher :: Maybe Cipher } -newState :: Git.Repo -> [BackendClass.Backend Annex] -> AnnexState +newState :: Git.Repo -> [Backend Annex] -> AnnexState newState gitrepo allbackends = AnnexState { repo = gitrepo , backends = [] , remotes = [] , supportedBackends = allbackends - , repoqueue = GitQueue.empty + , repoqueue = empty , quiet = False , force = False , fast = False @@ -70,7 +71,7 @@ newState gitrepo allbackends = AnnexState } {- Create and returns an Annex state object for the specified git repo. -} -new :: Git.Repo -> [BackendClass.Backend Annex] -> IO AnnexState +new :: Git.Repo -> [Backend Annex] -> IO AnnexState new gitrepo allbackends = do gitrepo' <- liftIO $ Git.configRead gitrepo return $ newState gitrepo' allbackends diff --git a/Backend/File.hs b/Backend/File.hs index 58506c861b..543f02af76 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -21,7 +21,6 @@ import Data.String.Utils import BackendClass import LocationLog import qualified Remote -import qualified RemoteUtils import qualified GitRepo as Git import Content import qualified Annex @@ -54,7 +53,7 @@ dummyStore _ _ = return True - and copy it to here. -} copyKeyFile :: Key -> FilePath -> Annex Bool copyKeyFile key file = do - (remotes, _) <- RemoteUtils.keyPossibilities key + (remotes, _) <- Remote.keyPossibilities key if null remotes then do showNote "not available" @@ -97,7 +96,7 @@ checkRemoveKey key numcopiesM = do if force || numcopiesM == Just 0 then return True else do - (remotes, trusteduuids) <- RemoteUtils.keyPossibilities key + (remotes, trusteduuids) <- Remote.keyPossibilities key untrusteduuids <- trustGet UnTrusted let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids) numcopies <- getNumCopies numcopiesM diff --git a/Command/Move.hs b/Command/Move.hs index 6a23aee92a..f49fe20e00 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -16,7 +16,6 @@ import LocationLog import Types import Content import qualified Remote -import qualified RemoteUtils import UUID import Messages @@ -90,7 +89,7 @@ toPerform dest move key = do let fastcheck = fast && not move && not (Remote.hasKeyCheap dest) isthere <- if fastcheck then do - (remotes, _) <- RemoteUtils.keyPossibilities key + (remotes, _) <- Remote.keyPossibilities key return $ Right $ dest `elem` remotes else Remote.hasKey dest key case isthere of @@ -124,7 +123,7 @@ fromStart :: Remote.Remote Annex -> Bool -> CommandStartString fromStart src move file = isAnnexed file $ \(key, _) -> do g <- Annex.gitRepo u <- getUUID g - (remotes, _) <- RemoteUtils.keyPossibilities key + (remotes, _) <- Remote.keyPossibilities key if (u == Remote.uuid src) || (null $ filter (== src) remotes) then stop else do diff --git a/GitAnnex.hs b/GitAnnex.hs index 64b0888b05..2a9fcbe3e7 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -16,6 +16,7 @@ import Options import Utility import TrustLevel import qualified Annex +import qualified Remote import qualified Command.Add import qualified Command.Unannex @@ -104,10 +105,12 @@ options = commonOptions ++ where setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v } setfrom v = Annex.changeState $ \s -> s { Annex.fromremote = Just v } - addexclude v = Annex.changeState $ \s -> s { Annex.exclude = v:(Annex.exclude s) } + addexclude v = Annex.changeState $ \s -> s { Annex.exclude = v:Annex.exclude s } setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v } setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v } - settrust t v = Annex.changeState $ \s -> s { Annex.forcetrust = (v, t):(Annex.forcetrust s) } + settrust t v = do + r <- Remote.nameToUUID v + Annex.changeState $ \s -> s { Annex.forcetrust = (r, t):Annex.forcetrust s } header :: String header = "Usage: git-annex command [option ..]" diff --git a/Remote.hs b/Remote.hs index 51da5e4715..9685b4612f 100644 --- a/Remote.hs +++ b/Remote.hs @@ -14,6 +14,7 @@ module Remote ( removeKey, hasKey, hasKeyCheap, + keyPossibilities, remoteTypes, genList, @@ -45,6 +46,8 @@ import qualified Annex import Locations import Utility import Config +import Trust +import LocationLog import qualified Remote.Git import qualified Remote.S3 @@ -110,6 +113,31 @@ remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs 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. + - + - Also returns a list of UUIDs that are trusted to have the key + - (some may not have configured remotes). + -} +keyPossibilities :: Key -> Annex ([Remote Annex], [UUID]) +keyPossibilities key = do + g <- Annex.gitRepo + u <- getUUID g + trusted <- trustGet Trusted + + -- get uuids of all remotes that are recorded to have the key + uuids <- liftIO $ keyLocations g key + let validuuids = filter (/= u) uuids + + -- note that validuuids is assumed to not have dups + let validtrusteduuids = intersect validuuids trusted + + -- remotes that match uuids that have the key + allremotes <- genList + let validremotes = remotesWithUUID allremotes validuuids + + return (sort validremotes, validtrusteduuids) + + {- Filename of remote.log. -} remoteLog :: Annex FilePath remoteLog = do diff --git a/RemoteUtils.hs b/RemoteUtils.hs deleted file mode 100644 index d042780e46..0000000000 --- a/RemoteUtils.hs +++ /dev/null @@ -1,42 +0,0 @@ -{- git-annex remotes overflow (can't go in there due to dependency cycles) - - - - Copyright 2011 Joey Hess - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module RemoteUtils where - -import Control.Monad.State (liftIO) -import Data.List - -import Annex -import Trust -import Remote -import UUID -import LocationLog -import Key - -{- Cost ordered lists of remotes that the LocationLog indicate may have a key. - - - - Also returns a list of UUIDs that are trusted to have the key - - (some may not have configured remotes). - -} -keyPossibilities :: Key -> Annex ([Remote Annex], [UUID]) -keyPossibilities key = do - g <- Annex.gitRepo - u <- getUUID g - trusted <- trustGet Trusted - - -- get uuids of all remotes that are recorded to have the key - uuids <- liftIO $ keyLocations g key - let validuuids = filter (/= u) uuids - - -- note that validuuids is assumed to not have dups - let validtrusteduuids = intersect validuuids trusted - - -- remotes that match uuids that have the key - allremotes <- genList - let validremotes = remotesWithUUID allremotes validuuids - - return (sort validremotes, validtrusteduuids) diff --git a/Trust.hs b/Trust.hs index d6d0516abb..aaca3b3706 100644 --- a/Trust.hs +++ b/Trust.hs @@ -23,7 +23,6 @@ import Types import UUID import Locations import qualified Annex -import qualified Remote import Utility {- Filename of trust.log. -} @@ -43,14 +42,11 @@ trustGet level = do trustMap :: Annex (M.Map UUID TrustLevel) trustMap = do logfile <- trustLog - overrides <- Annex.getState Annex.forcetrust >>= mapM findoverride + overrides <- Annex.getState Annex.forcetrust s <- liftIO $ catch (readFile logfile) ignoreerror return $ M.fromList $ trustMapParse s ++ overrides where ignoreerror _ = return "" - findoverride (name, t) = do - uuid <- Remote.nameToUUID name - return (uuid, t) {- Trust map parser. -} trustMapParse :: String -> [(UUID, TrustLevel)] diff --git a/UUID.hs b/UUID.hs index 0d7aee1414..33835e261b 100644 --- a/UUID.hs +++ b/UUID.hs @@ -36,8 +36,7 @@ import qualified Annex import Utility import qualified SysConfig import Config - -type UUID = String +import UUIDType configkey :: String configkey = "annex.uuid" diff --git a/UUIDType.hs b/UUIDType.hs new file mode 100644 index 0000000000..8e207b444e --- /dev/null +++ b/UUIDType.hs @@ -0,0 +1,11 @@ +{- git-annex UUID type + - + - Copyright 2011 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module UUIDType where + +-- might be nice to have a newtype, but lots of stuff treats uuids as strings +type UUID = String