initremote now creates buckets

Remote.hs

@@ -31,7 +31,6 @@ module Remote (
 import Control.Monad.State (liftIO)
 import Control.Monad (when, liftM)
 import Data.List
-import Data.String.Utils
 import qualified Data.Map as M
 import Data.Maybe
 
@@ -42,7 +41,6 @@ import qualified Annex
 import Trust
 import LocationLog
 import Locations
-import Messages
 import Utility
 
 import qualified Remote.Git
@@ -54,19 +52,6 @@ remoteTypes =
 	, Remote.S3.remote
 	]
 
-{- 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
-	where
-		collect v [] = return v
-		collect (actions, expensive) (x:xs) = do
-			(a, e) <- x
-			collect (a++actions, e++expensive) xs
-
 {- Builds a list of all available Remotes.
  - Since doing so can be expensive, the list is cached in the Annex. -}
 genList :: Annex [Remote Annex]
@@ -74,9 +59,9 @@ genList = do
 	rs <- Annex.getState Annex.remotes
 	if null rs
 		then do
-			rs' <- runGenerators
-			rs'' <- getConfigs rs'
-			Annex.changeState $ \s -> s { Annex.remotes = rs'' }
+			l <- mapM generator remoteTypes
+			rs' <- getConfigs (concat l)
+			Annex.changeState $ \s -> s { Annex.remotes = rs' }
 			return rs'
 		else return rs
 

Remote/Git.hs

@@ -15,6 +15,8 @@ import Control.Monad.State (liftIO)
 import qualified Data.Map as M
 import System.Cmd.Utils
 import Control.Monad (filterM, liftM)
+import Data.String.Utils
+import Maybe
 
 import RemoteClass
 import Types
@@ -37,7 +39,7 @@ remote = RemoteType {
 	setup = error "not supported"
 }
 
-gen :: Annex (RemoteGenerator Annex)
+gen :: Annex [Remote Annex]
 gen = do
 	g <- Annex.gitRepo
 	allremotes <- filterM remoteNotIgnored $ Git.remotes g
@@ -52,18 +54,20 @@ gen = do
 	let skip = filter (`notElem` expensive_todo) expensive
 	let todo = cheap++expensive_todo
 
-	let actions = map genRemote skip ++ 
-		map (\r -> genRemote =<< tryGitConfigRead r) todo
-	return (actions, map Git.repoDescribe expensive_todo)
+	showNote $ "getting UUID for " ++ (join ", " $
+		map Git.repoDescribe expensive_todo)
+	done <- mapM tryGitConfigRead todo
 
+	generated <- mapM genRemote $ skip ++ done
+	return $ catMaybes generated
 	where
 		cachedUUID r = liftM null $ getUUID r
 	
-genRemote :: Git.Repo -> Annex (Remote Annex)
+genRemote :: Git.Repo -> Annex (Maybe (Remote Annex))
 genRemote r = do
 	u <- getUUID r
 	c <- remoteCost r
-	return Remote {
+	return $ Just $ Remote {
 		uuid = u,
 		cost = c,
 		name = Git.repoDescribe r,

Remote/S3.hs

@@ -13,12 +13,12 @@ import Network.AWS.S3Bucket
 import Network.AWS.AWSResult
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Map as M
+import Data.Maybe
 import Data.String.Utils
 import Control.Monad (filterM, liftM, when)
 import Control.Monad.State (liftIO)
 import System.Environment
 import Data.Char
-import Messages
 
 import RemoteClass
 import Types
@@ -26,6 +26,8 @@ import qualified GitRepo as Git
 import qualified Annex
 import UUID
 import Config
+import Utility
+import Messages
 
 remote :: RemoteType Annex
 remote = RemoteType {
@@ -34,21 +36,14 @@ remote = RemoteType {
 	setup = s3Setup
 }
 
-gen :: Annex (RemoteGenerator Annex)
+gen :: Annex [Remote Annex]
 gen = do
 	g <- Annex.gitRepo
-	remotes <- filterM remoteNotIgnored $ findS3Remotes g
-	todo <- filterM cachedUUID remotes
-	let ok = filter (`notElem` todo) remotes
-	
-	let actions = map (\r -> genRemote r =<< getUUID r) ok ++
-		map (\r -> genRemote r =<< getS3UUID r) todo
-	return (actions, map Git.repoDescribe todo)
+	l <- filterM remoteNotIgnored $ findS3Remotes g
+	generated <- mapM genRemote l
+	return $ catMaybes generated
 
-	where
-		cachedUUID r = liftM null $ getUUID r
-
-{- S3 remotes have a remote.<name>.annex-s3-bucket config setting.
+{- S3 remotes have a remote.<name>.annex-s3 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. -}
@@ -58,56 +53,81 @@ findS3Remotes r = map construct remotepairs
 		remotepairs = M.toList $ filterremotes $ Git.configMap r
 		filterremotes = M.filterWithKey (\k _ -> s3remote k)
 		construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k
-		s3remote k = startswith "remote." k && endswith ".annex-s3-bucket" k
+		s3remote k = startswith "remote." k && endswith ".annex-s3" k
 
-genRemote :: Git.Repo -> UUID -> Annex (Remote Annex)
-genRemote r u = do
-	c <- remoteCost r
-	return Remote {
-		uuid = u,
-		cost = c,
-		name = Git.repoDescribe r,
-		storeKey = error "TODO",
-		retrieveKeyFile = error "TODO",
-		removeKey = error "TODO",
-		hasKey = error "TODO",
-		hasKeyCheap = False,
-		config = Nothing
-	}
+genRemote :: Git.Repo -> Annex (Maybe (Remote Annex))
+genRemote r = do
+	u <- getUUID r
+	if (u == "")
+		then return Nothing
+		else do
+			c <- remoteCost r
+			return $ Just $ Remote {
+				uuid = u,
+				cost = c,
+				name = Git.repoDescribe r,
+				storeKey = error "TODO",
+				retrieveKeyFile = error "TODO",
+				removeKey = error "TODO",
+				hasKey = error "TODO",
+				hasKeyCheap = False,
+				config = Nothing
+			}
 
-s3Connection :: Git.Repo -> Annex (Maybe AWSConnection)
-s3Connection r = do
-	host <- getS3Config r "s3-host" (Just defaultAmazonS3Host)
-	port <- getS3Config r "s3-port" (Just $ show defaultAmazonS3Port)
-	accesskey <- getS3Config r "s3-access-key-id" Nothing
-	secretkey <- getS3Config r "s3-secret-access-key" Nothing
-	case reads port of
-		[(p, _)] -> return $ Just $ AWSConnection host p accesskey secretkey
-		_ -> error $ "bad S3 port value: " ++ port
-
-withS3Connection :: Git.Repo -> Annex a -> ((AWSConnection, String) -> Annex a) -> Annex a
-withS3Connection r def a = do
-	c <- s3Connection r
-	case c of
-		Nothing -> def
-		Just c' -> do
-			b <- getConfig r "s3-bucket" ""
-			a (c', b)
-
-getS3Config :: Git.Repo -> String -> Maybe String-> Annex String
-getS3Config r s def = do
-	e <- liftIO $ catch (liftM Just $ getEnv envvar) (const $ return def)
-	v <- case e of
-		Nothing -> getConfig r s ""
-		Just d -> getConfig r s d
-	when (null v) $ error $ "set " ++ envvar ++ " or " ++ remoteConfig r s
-	return v
+s3Connection :: M.Map String String -> IO AWSConnection
+s3Connection c = do
+	ak <- getEnvKey "AWS_ACCESS_KEY_ID"
+	sk <- getEnvKey "AWS_SECRET_ACCESS_KEY"
+	return $ AWSConnection host port ak sk
 	where
-		envvar = "ANNEX_" ++ map (\c -> if c == '-' then '_' else toUpper c) s
+		host = fromJust $ (M.lookup "host" c)
+		port = let s = fromJust $ (M.lookup "port" c) in
+			case reads s of
+			[(p, _)] -> p
+			_ -> error $ "bad S3 port value: " ++ s
+		getEnvKey s = catch (getEnv s) (error $ "Set " ++ s)
 
 s3Setup :: UUID -> M.Map String String -> Annex (M.Map String String)
 s3Setup u c = do
-	return c
+	-- verify configuration is sane
+	case M.lookup "encryption" c of
+		Nothing -> error "Specify encryption=key or encryption=none"
+		Just "none" -> return ()
+		Just k -> error "encryption keys not yet supported"
+	let fullconfig = M.union c defaults
+
+	-- check bucket location to see if the bucket exists
+	let datacenter = fromJust $ M.lookup "datacenter" fullconfig
+	conn <- liftIO $ s3Connection fullconfig
+	showNote "checking bucket"
+	loc <- liftIO $ getBucketLocation conn bucket 
+	case loc of
+		Right _ -> return ()
+		Left err@(NetworkError _) -> error $ prettyReqError err
+		Left (AWSError _ _) -> do
+			showNote "creating bucket"
+			res <- liftIO $ createBucketIn conn bucket datacenter
+			case res of
+				Right _ -> return ()
+				Left err -> error $ prettyReqError err
+
+	g <- Annex.gitRepo
+	liftIO $ do
+		Git.run g "config" [Param ("remote." ++ name ++ ".annex-s3"), Param "true"]
+		Git.run g "config" [Param ("remote." ++ name ++ ".annex-uuid"), Param u]
+	return fullconfig
+	where
+		name = fromJust (M.lookup "name" c)
+		bucket = name ++ "-" ++ u
+		defaults = M.fromList
+			[ ("datacenter", "US")
+			, ("storageclass", "STANDARD")
+			, ("host", defaultAmazonS3Host)
+			, ("port", show defaultAmazonS3Port)
+			, ("bucket", bucket)
+			]
+
+{-
 
 {- The UUID of a S3 bucket is stored in a file "git-annex-uuid" in the
  - bucket. Gets the UUID, or if there is none, sets a new UUID, possibly
@@ -135,3 +155,16 @@ getS3UUID r = withS3Connection r disable $ \(c, b) -> do
 	where
 		uuidfile = "git-annex-uuid"
 		disable = return "" -- empty uuid will disable this remote
+
+getS3Config :: Git.Repo -> String -> Maybe String-> Annex String
+getS3Config r s def = do
+	e <- liftIO $ catch (liftM Just $ getEnv envvar) (const $ return def)
+	v <- case e of
+		Nothing -> getConfig r s ""
+		Just d -> getConfig r s d
+	when (null v) $ error $ "set " ++ envvar ++ " or " ++ remoteConfig r s
+	return v
+	where
+		envvar = "ANNEX_" ++ map (\c -> if c == '-' then '_' else toUpper c) s
+
+-}

RemoteClass.hs

@@ -14,17 +14,12 @@ import Data.Map as M
 
 import Key
 
-{- A remote generator identifies configured remotes, and returns an action
- - that can be run to set up each remote, and a list of names of remotes
- - 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),
+	generator :: a [Remote a],
 	-- initializes or changes a remote
 	setup :: String -> M.Map String String -> a (M.Map String String)
 }

doc/walkthrough/using_Amazon_S3.mdwn

@@ -13,7 +13,7 @@ First, export your S3 credentials:
 Next, create the S3 remote.
 
 	# git annex initremote mys3 type=S3 encryption=none
-	initremote (creating bucket mys3-291d2fdc-5990-11e0-909a-002170d25c55...) ok
+	initremote mys3 (checking bucket) (creating bucket) ok
 
 The configuration for the S3 remote is stored in git. So to make a different
 repository use the same S3 remote is easy:
@@ -21,7 +21,7 @@ repository use the same S3 remote is easy:
 	# cd /media/usb/annex
         # git pull laptop master
 	# git annex initremote mys3
-	initremote ok
+	initremote mys3 (checking bucket) ok
 
 Now the remote can be used like any other remote.