This commit is contained in:
Joey Hess 2011-03-28 23:51:07 -04:00
parent b1db436816
commit a3b6586902
4 changed files with 45 additions and 19 deletions

View file

@ -44,17 +44,16 @@ import LocationLog
import Locations import Locations
import Messages import Messages
{- Add generators for new Remotes here. -} remoteTypes :: [RemoteType Annex]
generators :: [Annex (RemoteGenerator Annex)] remoteTypes =
generators = [ Remote.Git.remote
[ Remote.Git.generate , Remote.S3.remote
, Remote.S3.generate
] ]
{- Runs a list of generators. -} {- Runs the generators of each type of Remote -}
runGenerators :: [Annex (RemoteGenerator Annex)] -> Annex [Remote Annex] runGenerators :: Annex [Remote Annex]
runGenerators gs = do runGenerators = do
(actions, expensive) <- collect ([], []) gs (actions, expensive) <- collect ([], []) $ map generator remoteTypes
when (not $ null expensive) $ when (not $ null expensive) $
showNote $ "getting UUID for " ++ join ", " expensive showNote $ "getting UUID for " ++ join ", " expensive
sequence actions sequence actions
@ -71,7 +70,7 @@ genList = do
rs <- Annex.getState Annex.remotes rs <- Annex.getState Annex.remotes
if null rs if null rs
then do then do
rs' <- runGenerators generators rs' <- runGenerators
Annex.changeState $ \s -> s { Annex.remotes = rs' } Annex.changeState $ \s -> s { Annex.remotes = rs' }
return rs' return rs'
else return rs else return rs

View file

@ -6,7 +6,7 @@
-} -}
module Remote.Git ( module Remote.Git (
generate, remote,
onRemote onRemote
) where ) where
@ -30,8 +30,11 @@ import RsyncFile
import Ssh import Ssh
import Config import Config
generate :: Annex (RemoteGenerator Annex) remote :: RemoteType Annex
generate = do remote = RemoteType { typename = "git", generator = gen }
gen :: Annex (RemoteGenerator Annex)
gen = do
g <- Annex.gitRepo g <- Annex.gitRepo
allremotes <- filterM remoteNotIgnored $ Git.remotes g allremotes <- filterM remoteNotIgnored $ Git.remotes g
@ -64,7 +67,10 @@ genRemote r = do
retrieveKeyFile = copyFromRemote r, retrieveKeyFile = copyFromRemote r,
removeKey = dropKey r, removeKey = dropKey r,
hasKey = inAnnex r, hasKey = inAnnex r,
hasKeyCheap = not (Git.repoIsUrl r) hasKeyCheap = not (Git.repoIsUrl r),
hasConfig = False,
config = Nothing,
setup = \_ -> return ()
} }
{- Tries to read the config for a specified remote, updates state, and {- Tries to read the config for a specified remote, updates state, and

View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Remote.S3 (generate) where module Remote.S3 (remote) where
import Network.AWS.AWSConnection import Network.AWS.AWSConnection
import Network.AWS.S3Object import Network.AWS.S3Object
@ -27,8 +27,11 @@ import qualified Annex
import UUID import UUID
import Config import Config
generate :: Annex (RemoteGenerator Annex) remote :: RemoteType Annex
generate = do remote = RemoteType { typename = "S3", generator = gen }
gen :: Annex (RemoteGenerator Annex)
gen = do
g <- Annex.gitRepo g <- Annex.gitRepo
remotes <- filterM remoteNotIgnored $ findS3Remotes g remotes <- filterM remoteNotIgnored $ findS3Remotes g
todo <- filterM cachedUUID remotes todo <- filterM cachedUUID remotes
@ -64,7 +67,10 @@ genRemote r u = do
retrieveKeyFile = error "TODO", retrieveKeyFile = error "TODO",
removeKey = error "TODO", removeKey = error "TODO",
hasKey = error "TODO", hasKey = error "TODO",
hasKeyCheap = False hasKeyCheap = False,
hasConfig = True,
config = Nothing,
setup = \_ -> return ()
} }
s3Connection :: Git.Repo -> Annex (Maybe AWSConnection) s3Connection :: Git.Repo -> Annex (Maybe AWSConnection)

View file

@ -10,6 +10,7 @@
module RemoteClass where module RemoteClass where
import Control.Exception import Control.Exception
import Data.Map as M
import Key import Key
@ -18,6 +19,15 @@ import Key
- that are not cheap to set up. -} - that are not cheap to set up. -}
type RemoteGenerator a = ([a (Remote a)], [String]) type RemoteGenerator a = ([a (Remote a)], [String])
{- There are different types of remotes. -}
data RemoteType a = RemoteType {
-- human visible type name
typename :: String,
-- generates remotes of this type
generator :: a (RemoteGenerator a)
}
{- An individual remote. -}
data Remote a = Remote { data Remote a = Remote {
-- each Remote has a unique uuid -- each Remote has a unique uuid
uuid :: String, uuid :: String,
@ -36,7 +46,12 @@ data Remote a = Remote {
hasKey :: Key -> a (Either IOException Bool), hasKey :: Key -> a (Either IOException Bool),
-- Some remotes can check hasKey without an expensive network -- Some remotes can check hasKey without an expensive network
-- operation. -- operation.
hasKeyCheap :: Bool hasKeyCheap :: Bool,
-- a Remote may have a persistent configuration store
hasConfig :: Bool,
config :: Maybe (M.Map String String),
-- initializes or changes the config of a remote
setup :: M.Map String String -> a ()
} }
instance Show (Remote a) where instance Show (Remote a) where