better types allowed breaking module dep loop

This commit is contained in:
Joey Hess 2011-06-01 19:10:38 -04:00
parent 80efafe496
commit 971ab27e78
9 changed files with 64 additions and 70 deletions

View file

@ -20,11 +20,12 @@ import Control.Monad.State
(liftIO, StateT, runStateT, evalStateT, liftM, get, put) (liftIO, StateT, runStateT, evalStateT, liftM, get, put)
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitQueue import GitQueue
import qualified BackendClass import BackendClass
import qualified RemoteClass import RemoteClass
import qualified CryptoTypes import CryptoTypes
import TrustLevel import TrustLevel
import UUIDType
-- git-annex's monad -- git-annex's monad
type Annex = StateT AnnexState IO type Annex = StateT AnnexState IO
@ -32,10 +33,10 @@ type Annex = StateT AnnexState IO
-- internal state storage -- internal state storage
data AnnexState = AnnexState data AnnexState = AnnexState
{ repo :: Git.Repo { repo :: Git.Repo
, backends :: [BackendClass.Backend Annex] , backends :: [Backend Annex]
, supportedBackends :: [BackendClass.Backend Annex] , supportedBackends :: [Backend Annex]
, remotes :: [RemoteClass.Remote Annex] , remotes :: [Remote Annex]
, repoqueue :: GitQueue.Queue , repoqueue :: Queue
, quiet :: Bool , quiet :: Bool
, force :: Bool , force :: Bool
, fast :: Bool , fast :: Bool
@ -45,17 +46,17 @@ data AnnexState = AnnexState
, toremote :: Maybe String , toremote :: Maybe String
, fromremote :: Maybe String , fromremote :: Maybe String
, exclude :: [String] , exclude :: [String]
, forcetrust :: [(String, TrustLevel)] , forcetrust :: [(UUID, TrustLevel)]
, cipher :: Maybe CryptoTypes.Cipher , cipher :: Maybe Cipher
} }
newState :: Git.Repo -> [BackendClass.Backend Annex] -> AnnexState newState :: Git.Repo -> [Backend Annex] -> AnnexState
newState gitrepo allbackends = AnnexState newState gitrepo allbackends = AnnexState
{ repo = gitrepo { repo = gitrepo
, backends = [] , backends = []
, remotes = [] , remotes = []
, supportedBackends = allbackends , supportedBackends = allbackends
, repoqueue = GitQueue.empty , repoqueue = empty
, quiet = False , quiet = False
, force = False , force = False
, fast = False , fast = False
@ -70,7 +71,7 @@ newState gitrepo allbackends = AnnexState
} }
{- Create and returns an Annex state object for the specified git repo. -} {- 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 new gitrepo allbackends = do
gitrepo' <- liftIO $ Git.configRead gitrepo gitrepo' <- liftIO $ Git.configRead gitrepo
return $ newState gitrepo' allbackends return $ newState gitrepo' allbackends

View file

@ -21,7 +21,6 @@ import Data.String.Utils
import BackendClass import BackendClass
import LocationLog import LocationLog
import qualified Remote import qualified Remote
import qualified RemoteUtils
import qualified GitRepo as Git import qualified GitRepo as Git
import Content import Content
import qualified Annex import qualified Annex
@ -54,7 +53,7 @@ dummyStore _ _ = return True
- and copy it to here. -} - and copy it to here. -}
copyKeyFile :: Key -> FilePath -> Annex Bool copyKeyFile :: Key -> FilePath -> Annex Bool
copyKeyFile key file = do copyKeyFile key file = do
(remotes, _) <- RemoteUtils.keyPossibilities key (remotes, _) <- Remote.keyPossibilities key
if null remotes if null remotes
then do then do
showNote "not available" showNote "not available"
@ -97,7 +96,7 @@ checkRemoveKey key numcopiesM = do
if force || numcopiesM == Just 0 if force || numcopiesM == Just 0
then return True then return True
else do else do
(remotes, trusteduuids) <- RemoteUtils.keyPossibilities key (remotes, trusteduuids) <- Remote.keyPossibilities key
untrusteduuids <- trustGet UnTrusted untrusteduuids <- trustGet UnTrusted
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids) let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
numcopies <- getNumCopies numcopiesM numcopies <- getNumCopies numcopiesM

View file

@ -16,7 +16,6 @@ import LocationLog
import Types import Types
import Content import Content
import qualified Remote import qualified Remote
import qualified RemoteUtils
import UUID import UUID
import Messages import Messages
@ -90,7 +89,7 @@ toPerform dest move key = do
let fastcheck = fast && not move && not (Remote.hasKeyCheap dest) let fastcheck = fast && not move && not (Remote.hasKeyCheap dest)
isthere <- if fastcheck isthere <- if fastcheck
then do then do
(remotes, _) <- RemoteUtils.keyPossibilities key (remotes, _) <- Remote.keyPossibilities key
return $ Right $ dest `elem` remotes return $ Right $ dest `elem` remotes
else Remote.hasKey dest key else Remote.hasKey dest key
case isthere of case isthere of
@ -124,7 +123,7 @@ fromStart :: Remote.Remote Annex -> Bool -> CommandStartString
fromStart src move file = isAnnexed file $ \(key, _) -> do fromStart src move file = isAnnexed file $ \(key, _) -> do
g <- Annex.gitRepo g <- Annex.gitRepo
u <- getUUID g u <- getUUID g
(remotes, _) <- RemoteUtils.keyPossibilities key (remotes, _) <- Remote.keyPossibilities key
if (u == Remote.uuid src) || (null $ filter (== src) remotes) if (u == Remote.uuid src) || (null $ filter (== src) remotes)
then stop then stop
else do else do

View file

@ -16,6 +16,7 @@ import Options
import Utility import Utility
import TrustLevel import TrustLevel
import qualified Annex import qualified Annex
import qualified Remote
import qualified Command.Add import qualified Command.Add
import qualified Command.Unannex import qualified Command.Unannex
@ -104,10 +105,12 @@ options = commonOptions ++
where where
setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v } setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v }
setfrom v = Annex.changeState $ \s -> s { Annex.fromremote = 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 } setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just 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 :: String
header = "Usage: git-annex command [option ..]" header = "Usage: git-annex command [option ..]"

View file

@ -14,6 +14,7 @@ module Remote (
removeKey, removeKey,
hasKey, hasKey,
hasKeyCheap, hasKeyCheap,
keyPossibilities,
remoteTypes, remoteTypes,
genList, genList,
@ -45,6 +46,8 @@ import qualified Annex
import Locations import Locations
import Utility import Utility
import Config import Config
import Trust
import LocationLog
import qualified Remote.Git import qualified Remote.Git
import qualified Remote.S3 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 :: [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.
-
- 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. -} {- Filename of remote.log. -}
remoteLog :: Annex FilePath remoteLog :: Annex FilePath
remoteLog = do remoteLog = do

View file

@ -1,42 +0,0 @@
{- git-annex remotes overflow (can't go in there due to dependency cycles)
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- 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)

View file

@ -23,7 +23,6 @@ import Types
import UUID import UUID
import Locations import Locations
import qualified Annex import qualified Annex
import qualified Remote
import Utility import Utility
{- Filename of trust.log. -} {- Filename of trust.log. -}
@ -43,14 +42,11 @@ trustGet level = do
trustMap :: Annex (M.Map UUID TrustLevel) trustMap :: Annex (M.Map UUID TrustLevel)
trustMap = do trustMap = do
logfile <- trustLog logfile <- trustLog
overrides <- Annex.getState Annex.forcetrust >>= mapM findoverride overrides <- Annex.getState Annex.forcetrust
s <- liftIO $ catch (readFile logfile) ignoreerror s <- liftIO $ catch (readFile logfile) ignoreerror
return $ M.fromList $ trustMapParse s ++ overrides return $ M.fromList $ trustMapParse s ++ overrides
where where
ignoreerror _ = return "" ignoreerror _ = return ""
findoverride (name, t) = do
uuid <- Remote.nameToUUID name
return (uuid, t)
{- Trust map parser. -} {- Trust map parser. -}
trustMapParse :: String -> [(UUID, TrustLevel)] trustMapParse :: String -> [(UUID, TrustLevel)]

View file

@ -36,8 +36,7 @@ import qualified Annex
import Utility import Utility
import qualified SysConfig import qualified SysConfig
import Config import Config
import UUIDType
type UUID = String
configkey :: String configkey :: String
configkey = "annex.uuid" configkey = "annex.uuid"

11
UUIDType.hs Normal file
View file

@ -0,0 +1,11 @@
{- git-annex UUID type
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- 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