break module dependancy loop

A PITA but worth it to clean up the trust configuration code.
This commit is contained in:
Joey Hess 2012-01-10 13:11:16 -04:00
parent 0d5c402210
commit 07cacbeee9
10 changed files with 109 additions and 107 deletions

View file

@ -24,6 +24,7 @@ module Remote (
prettyPrintUUIDs,
remotesWithUUID,
remotesWithoutUUID,
keyLocations,
keyPossibilities,
keyPossibilitiesTrusted,
nameToUUID,
@ -40,55 +41,11 @@ import Text.JSON.Generic
import Common.Annex
import Types.Remote
import qualified Annex
import qualified Git
import Config
import Annex.UUID
import Logs.UUID
import Logs.Trust
import Logs.Location
import Logs.Remote
import qualified Remote.Git
import qualified Remote.S3
import qualified Remote.Bup
import qualified Remote.Directory
import qualified Remote.Rsync
import qualified Remote.Web
import qualified Remote.Hook
remoteTypes :: [RemoteType]
remoteTypes =
[ Remote.Git.remote
, Remote.S3.remote
, Remote.Bup.remote
, Remote.Directory.remote
, Remote.Rsync.remote
, Remote.Web.remote
, Remote.Hook.remote
]
{- Builds a list of all available Remotes.
- Since doing so can be expensive, the list is cached. -}
remoteList :: Annex [Remote]
remoteList = do
rs <- Annex.getState Annex.remotes
if null rs
then do
m <- readRemoteLog
rs' <- concat <$> mapM (process m) remoteTypes
Annex.changeState $ \s -> s { Annex.remotes = rs' }
return rs'
else return rs
where
process m t = enumerate t >>= mapM (gen m t)
gen m t r = do
u <- getRepoUUID r
checkTrust r u
generate t r u (M.lookup u m)
{- All remotes that are not ignored. -}
enabledRemoteList :: Annex [Remote]
enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
import Remote.List
{- Map of UUIDs of Remotes and their names. -}
remoteMap :: Annex (M.Map UUID String)
@ -185,27 +142,32 @@ remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
remotesWithoutUUID :: [Remote] -> [UUID] -> [Remote]
remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
{- Cost ordered lists of remotes that the Logs.Location indicate may have a key.
{- List of repository UUIDs that the location log indicates may have a key.
- Dead repositories are excluded. -}
keyLocations :: Key -> Annex [UUID]
keyLocations key = snd <$> (trustPartition DeadTrusted =<< loggedLocations key)
{- Cost ordered lists of remotes that the location log indicates
- may have a key.
-}
keyPossibilities :: Key -> Annex [Remote]
keyPossibilities key = fst <$> keyPossibilities' False key
keyPossibilities key = fst <$> keyPossibilities' key []
{- Cost ordered lists of remotes that the Logs.Location indicate may have a key.
{- Cost ordered lists of remotes that the location log indicates
- may have a key.
-
- Also returns a list of UUIDs that are trusted to have the key
- (some may not have configured remotes).
-}
keyPossibilitiesTrusted :: Key -> Annex ([Remote], [UUID])
keyPossibilitiesTrusted = keyPossibilities' True
keyPossibilitiesTrusted key = keyPossibilities' key =<< trustGet Trusted
keyPossibilities' :: Bool -> Key -> Annex ([Remote], [UUID])
keyPossibilities' withtrusted key = do
keyPossibilities' :: Key -> [UUID] -> Annex ([Remote], [UUID])
keyPossibilities' key trusted = do
u <- getUUID
trusted <- if withtrusted then trustGet Trusted else return []
-- get uuids of all remotes that are recorded to have the key
uuids <- keyLocations key
let validuuids = filter (/= u) uuids
-- uuids of all remotes that are recorded to have the key
validuuids <- filter (/= u) <$> keyLocations key
-- note that validuuids is assumed to not have dups
let validtrusteduuids = validuuids `intersect` trusted
@ -241,24 +203,10 @@ showTriedRemotes remotes =
(join ", " $ map name remotes)
forceTrust :: TrustLevel -> String -> Annex ()
forceTrust level remotename = forceTrust' True level =<< nameToUUID remotename
forceTrust' :: Bool -> TrustLevel -> UUID -> Annex ()
forceTrust' overwrite level u = do
forceTrust level remotename = do
u <- nameToUUID remotename
Annex.changeState $ \s ->
s { Annex.forcetrust = change u level (Annex.forcetrust s) }
-- This change invalidated any cached trustmap.
Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
where
change
| overwrite = M.insert
| otherwise = M.insertWith (\_new old -> old)
checkTrust :: Git.Repo -> UUID -> Annex ()
checkTrust r u = set =<< getTrustLevel r
where
set (Just level) = forceTrust' False level u
set Nothing = return ()
s { Annex.forcetrust = M.insert u level (Annex.forcetrust s) }
{- Used to log a change in a remote's having a key. The change is logged
- in the local repo, not on the remote. The process of transferring the