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

View file

@ -6,7 +6,7 @@
-}
module Remote.Git (
generate,
remote,
onRemote
) where
@ -30,8 +30,11 @@ import RsyncFile
import Ssh
import Config
generate :: Annex (RemoteGenerator Annex)
generate = do
remote :: RemoteType Annex
remote = RemoteType { typename = "git", generator = gen }
gen :: Annex (RemoteGenerator Annex)
gen = do
g <- Annex.gitRepo
allremotes <- filterM remoteNotIgnored $ Git.remotes g
@ -64,7 +67,10 @@ genRemote r = do
retrieveKeyFile = copyFromRemote r,
removeKey = dropKey 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

View file

@ -5,7 +5,7 @@
- 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.S3Object
@ -27,8 +27,11 @@ import qualified Annex
import UUID
import Config
generate :: Annex (RemoteGenerator Annex)
generate = do
remote :: RemoteType Annex
remote = RemoteType { typename = "S3", generator = gen }
gen :: Annex (RemoteGenerator Annex)
gen = do
g <- Annex.gitRepo
remotes <- filterM remoteNotIgnored $ findS3Remotes g
todo <- filterM cachedUUID remotes
@ -64,7 +67,10 @@ genRemote r u = do
retrieveKeyFile = error "TODO",
removeKey = error "TODO",
hasKey = error "TODO",
hasKeyCheap = False
hasKeyCheap = False,
hasConfig = True,
config = Nothing,
setup = \_ -> return ()
}
s3Connection :: Git.Repo -> Annex (Maybe AWSConnection)

View file

@ -10,6 +10,7 @@
module RemoteClass where
import Control.Exception
import Data.Map as M
import Key
@ -18,6 +19,15 @@ import Key
- that are not cheap to set up. -}
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 {
-- each Remote has a unique uuid
uuid :: String,
@ -36,7 +46,12 @@ data Remote a = Remote {
hasKey :: Key -> a (Either IOException Bool),
-- Some remotes can check hasKey without an expensive network
-- 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