skeleton of S3 remote
This commit is contained in:
parent
6b5918c295
commit
65b72604d7
2 changed files with 66 additions and 2 deletions
|
@ -29,7 +29,7 @@ import Data.String.Utils
|
|||
|
||||
import RemoteClass
|
||||
import qualified Remote.Git
|
||||
--import qualified Remote.S3
|
||||
import qualified Remote.S3
|
||||
import Types
|
||||
import UUID
|
||||
import qualified Annex
|
||||
|
@ -39,7 +39,10 @@ import Messages
|
|||
|
||||
{- Add generators for new Remotes here. -}
|
||||
generators :: [Annex (RemoteGenerator Annex)]
|
||||
generators = [Remote.Git.generate]
|
||||
generators =
|
||||
[ Remote.Git.generate
|
||||
, Remote.S3.generate
|
||||
]
|
||||
|
||||
{- Runs a list of generators. -}
|
||||
runGenerators :: [Annex (RemoteGenerator Annex)] -> Annex [Remote Annex]
|
||||
|
|
61
Remote/S3.hs
Normal file
61
Remote/S3.hs
Normal file
|
@ -0,0 +1,61 @@
|
|||
{- Amazon S3 remotes.
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Remote.S3 (generate) where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import Data.String.Utils
|
||||
import Control.Monad (filterM, liftM)
|
||||
|
||||
import RemoteClass
|
||||
import Types
|
||||
import qualified GitRepo as Git
|
||||
import qualified Annex
|
||||
import UUID
|
||||
import Config
|
||||
|
||||
generate :: Annex (RemoteGenerator Annex)
|
||||
generate = do
|
||||
g <- Annex.gitRepo
|
||||
remotes <- filterM remoteNotIgnored $ findS3Remotes g
|
||||
todo <- filterM cachedUUID remotes
|
||||
let ok = filter (`notElem` todo) remotes
|
||||
|
||||
let actions = map genRemote ok ++
|
||||
map (\r -> genRemote =<< tryS3ConfigRead r) todo
|
||||
return (actions, map Git.repoDescribe todo)
|
||||
|
||||
where
|
||||
cachedUUID r = liftM null $ getUUID r
|
||||
|
||||
genRemote :: Git.Repo -> Annex (Remote Annex)
|
||||
genRemote r = do
|
||||
return Remote {
|
||||
uuid = error "TODO",
|
||||
cost = error "TODO",
|
||||
name = Git.repoDescribe r,
|
||||
storeKey = error "TODO",
|
||||
retrieveKeyFile = error "TODO",
|
||||
removeKey = error "TODO",
|
||||
hasKey = error "TODO",
|
||||
hasKeyCheap = False
|
||||
}
|
||||
|
||||
{- S3 remotes have a remote.<name>.annex-s3bucket config setting.
|
||||
- Git.Repo does not normally generate remotes for things that
|
||||
- have no configured url, so the Git.Repo objects have to be
|
||||
- constructed as coming from an unknown location. -}
|
||||
findS3Remotes :: Git.Repo -> [Git.Repo]
|
||||
findS3Remotes r = map construct remotepairs
|
||||
where
|
||||
remotepairs = Map.toList $ filterremotes $ Git.configMap r
|
||||
filterremotes = Map.filterWithKey (\k _ -> s3remote k)
|
||||
construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k
|
||||
s3remote k = startswith "remote." k && endswith ".annex-s3bucket" k
|
||||
|
||||
tryS3ConfigRead :: Git.Repo -> Annex Git.Repo
|
||||
tryS3ConfigRead r = error "TODO"
|
Loading…
Reference in a new issue