skeleton of S3 remote

This commit is contained in:
Joey Hess 2011-03-27 22:00:44 -04:00
parent 6b5918c295
commit 65b72604d7
2 changed files with 66 additions and 2 deletions

View file

@ -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
View 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"