update
This commit is contained in:
parent
b1db436816
commit
a3b6586902
4 changed files with 45 additions and 19 deletions
19
Remote.hs
19
Remote.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
14
Remote/S3.hs
14
Remote/S3.hs
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue