skeleton of S3 remote

1 files changed, 61 insertions, 0 deletions

diff --git a/Remote/S3.hs b/Remote/S3.hs
new file mode 100644
index 000000000..818cde203
--- /dev/null
+++ b/Remote/S3.hs
@@ -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"