allow enabling existing S3 repos

Assistant/MakeRemote.hs

@@ -58,7 +58,7 @@ addRemote a = do
 {- Inits a rsync special remote, and returns its name. -}
 makeRsyncRemote :: String -> String -> Annex String
 makeRsyncRemote name location = makeRemote name location $
-	const $ void $ makeSpecialRemote name Rsync.remote config
+	const $ makeSpecialRemote name Rsync.remote config
 	where
 		config = M.fromList
 			[ ("encryption", "shared")
@@ -66,14 +66,13 @@ makeRsyncRemote name location = makeRemote name location $
 			, ("type", "rsync")
 			]
 
-{- Inits a special remote, and returns its name. -}
+{- Inits a special remote. -}
-makeSpecialRemote :: String -> RemoteType -> R.RemoteConfig -> Annex String
+makeSpecialRemote :: String -> RemoteType -> R.RemoteConfig -> Annex ()
 makeSpecialRemote name remotetype config = do
 	(u, c) <- Command.InitRemote.findByName name
 	c' <- R.setup remotetype u $ M.union config c
 	describeUUID u name
 	configSet u c'
-	return name
 
 {- Returns the name of the git remote it created. If there's already a
  - remote at the location, returns its name. -}

Assistant/WebApp/Configurators.hs

@@ -65,6 +65,7 @@ repoList onlyconfigured
 			Just c -> case M.lookup "type" c of
 				Just "rsync" -> u `enableswith` EnableRsyncR
 				Just "directory" -> u `enableswith` EnableDirectoryR
+				Just "S3" -> u `enableswith` EnableS3R
 				_ -> Nothing
 		u `enableswith` r = Just (u, Just $ r u)
 		list l = runAnnex [] $ do

Assistant/WebApp/Configurators/S3.hs

@@ -18,12 +18,28 @@ import Assistant.WebApp.SideBar
 import Assistant.ThreadedMonad
 import Utility.Yesod
 import qualified Remote.S3 as S3
+import Logs.Remote
+import Remote (prettyListUUIDs)
+import Types.Remote (RemoteConfig)
 
 import Yesod
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Map as M
 
+s3Configurator :: Widget -> Handler RepHtml
+s3Configurator a = bootstrap (Just Config) $ do
+	sideBarDisplay
+	setTitle "Add an Amazon S3 repository"
+	a
+
+data StorageClass = StandardRedundancy | ReducedRedundancy
+	deriving (Eq, Enum, Bounded)
+
+instance Show StorageClass where
+	show StandardRedundancy = "STANDARD" 
+	show ReducedRedundancy = "REDUCED_REDUNDANCY"
+
 data S3Input = S3Input
 	{ accessKeyID :: Text
 	, secretAccessKey :: Text
@@ -32,17 +48,14 @@ data S3Input = S3Input
 	, storageClass :: StorageClass
 	, repoName :: Text
 	}
-	deriving (Show)
 
-data StorageClass = StandardRedundancy | ReducedRedundancy
+data S3Creds = S3Creds Text Text
-	deriving (Eq, Enum, Bounded)
 
-instance Show StorageClass where
+extractCreds :: S3Input -> S3Creds
-	show StandardRedundancy = "STANDARD" 
+extractCreds i = S3Creds (accessKeyID i) (secretAccessKey i)
-	show ReducedRedundancy = "REDUCED_REDUNDANCY"
 
-s3AForm :: AForm WebApp WebApp S3Input
+s3InputAForm :: AForm WebApp WebApp S3Input
-s3AForm = S3Input
+s3InputAForm = S3Input
 	<$> areq textField "Access Key ID" Nothing
 	<*> areq passwordField "Secret Access Key" Nothing
 	<*> areq textField "Datacenter" (Just "US")
@@ -55,41 +68,57 @@ s3AForm = S3Input
 			, ("Reduced redundancy (costs less)", ReducedRedundancy)
 			]
 
+s3CredsAForm :: AForm WebApp WebApp S3Creds
+s3CredsAForm = S3Creds
+	<$> areq textField "Access Key ID" Nothing
+	<*> areq passwordField "Secret Access Key" Nothing
+
 getAddS3R :: Handler RepHtml
-getAddS3R = bootstrap (Just Config) $ do
+getAddS3R = s3Configurator $ do
-	sideBarDisplay
-	setTitle "Add an Amazon S3 repository"
 	((result, form), enctype) <- lift $
-		runFormGet $ renderBootstrap s3AForm
+		runFormGet $ renderBootstrap s3InputAForm
 	case result of
 		FormSuccess s3input -> lift $ do
 			let name = T.unpack $ repoName s3input
-			name' <- runAnnex name $
+			makeS3Remote (extractCreds s3input) name $ M.fromList
-				fromRepo $ uniqueRemoteName name 0
+				[ ("encryption", "shared")
-			makeS3Remote s3input name'
+				, ("type", "S3")
+				, ("datacenter", T.unpack $ datacenter s3input)
+				, ("storageclass", show $ storageClass s3input)
+				]
 		_ -> showform form enctype
 	where
 		showform form enctype = do
 			let authtoken = webAppFormAuthToken
 			$(widgetFile "configurators/adds3")
 
-makeS3Remote :: S3Input -> String -> Handler ()
+getEnableS3R :: UUID -> Handler RepHtml
-makeS3Remote s3input name = do
+getEnableS3R uuid = s3Configurator $ do
+	((result, form), enctype) <- lift $
+		runFormGet $ renderBootstrap s3CredsAForm
+	case result of
+		FormSuccess s3creds -> lift $ do
+			m <- runAnnex M.empty readRemoteLog
+			let name = fromJust $ M.lookup "name" $
+				fromJust $ M.lookup uuid m
+			makeS3Remote s3creds name M.empty
+		_ -> showform form enctype
+	where
+		showform form enctype = do
+			let authtoken = webAppFormAuthToken
+			description <- lift $ runAnnex "" $
+				T.pack . concat <$> prettyListUUIDs [uuid]
+			$(widgetFile "configurators/enables3")
+
+makeS3Remote :: S3Creds -> String -> RemoteConfig -> Handler ()
+makeS3Remote (S3Creds ak sk) name config = do
 	webapp <- getYesod
 	let st = fromJust $ threadState webapp
+	remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
 	liftIO $ do
-		S3.s3SetCredsEnv
+		S3.s3SetCredsEnv ( T.unpack ak, T.unpack sk)
-			( T.unpack $ accessKeyID s3input
+		r <- runThreadState st $ addRemote $ do
-			, T.unpack $ secretAccessKey s3input
-			)
-		r <- runThreadState st $ addRemote $
 			makeSpecialRemote name S3.remote config
+			return remotename
 		syncNewRemote st (daemonStatus webapp) (scanRemotes webapp) r
 	redirect RepositoriesR
-	where
-		config = M.fromList
-			[ ("encryption", "shared")
-			, ("type", "S3")
-			, ("datacenter", T.unpack $ datacenter s3input)
-			, ("storageclass", show $ storageClass s3input)
-			]

Assistant/WebApp/routes

@@ -24,6 +24,7 @@
 
 /config/repository/enable/rsync/#UUID EnableRsyncR GET
 /config/repository/enable/directory/#UUID EnableDirectoryR GET
+/config/repository/enable/S3/#UUID EnableS3R GET
 
 /transfers/#NotificationId TransfersR GET
 /sidebar/#NotificationId SideBarR GET

templates/configurators/enables3.hamlet

@@ -0,0 +1,30 @@
+<div .span9 .hero-unit>
+  <h2>
+    Enabling #{description}
+  <p>
+    To use this Amazon S3 repository, you need an Access Key ID, and a #
+    Secret Access Key. These access keys will be stored in a file that #
+    only you can access.
+  <p>
+    If this repository uses your Amazon S3 account, you can #
+    <a href="https://portal.aws.amazon.com/gp/aws/securityCredentials#id_block">
+      look up your access keys. #
+    If this repository uses someone else's Amazon S3 account, they #
+    can generate access keys for you, using their #
+    <a href="https://console.aws.amazon.com/iam/home">
+      IAM Management Console.
+  <p>
+    <form .form-horizontal enctype=#{enctype}>
+      <fieldset>
+        ^{form}
+        ^{authtoken}
+        <div .form-actions>
+          <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
+            Enable S3 repository
+<div .modal .fade #workingmodal>
+  <div .modal-header>
+    <h3>
+      Enabling repository ...
+  <div .modal-body>
+    <p>
+      Enabling this Amazon S3 repository. This could take a minute.