plumb creds from webapp to initremote

Avoids abusing setting environment variables, which was always a hack
and won't work on windows.

Assistant/MakeRemote.hs

@@ -48,9 +48,10 @@ makeRsyncRemote :: RemoteName -> String -> Annex String
 makeRsyncRemote name location = makeRemote name location $ const $ void $
 	go =<< Command.InitRemote.findExisting name
   where
-  	go Nothing = setupSpecialRemote name Rsync.remote config
+  	go Nothing = setupSpecialRemote name Rsync.remote config Nothing
 		(Nothing, Command.InitRemote.newConfig name)
-	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config (Just u, c)
+	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing
+		(Just u, c)
 	config = M.fromList
 		[ ("encryption", "shared")
 		, ("rsyncurl", location)
@@ -60,44 +61,44 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
 {- Inits a gcrypt special remote, and returns its name. -}
 makeGCryptRemote :: RemoteName -> String -> KeyId -> Annex RemoteName
 makeGCryptRemote remotename location keyid = 
-	initSpecialRemote remotename GCrypt.remote $ M.fromList
+	initSpecialRemote remotename GCrypt.remote Nothing $ M.fromList
 		[ ("type", "gcrypt")
 		, ("gitrepo", location)
 		, configureEncryption HybridEncryption
 		, ("keyid", keyid)
 		]
 
-type SpecialRemoteMaker = RemoteName -> RemoteType -> R.RemoteConfig -> Annex RemoteName
+type SpecialRemoteMaker = RemoteName -> RemoteType -> Maybe CredPair -> R.RemoteConfig -> Annex RemoteName
 
 {- Inits a new special remote. The name is used as a suggestion, but
  - will be changed if there is already a special remote with that name. -}
 initSpecialRemote :: SpecialRemoteMaker
-initSpecialRemote name remotetype config = go 0
+initSpecialRemote name remotetype mcreds config = go 0
   where
 	go :: Int -> Annex RemoteName
 	go n = do
 		let fullname = if n == 0  then name else name ++ show n
 		r <- Command.InitRemote.findExisting fullname
 		case r of
-			Nothing -> setupSpecialRemote fullname remotetype config
+			Nothing -> setupSpecialRemote fullname remotetype config mcreds
 				(Nothing, Command.InitRemote.newConfig fullname)
 			Just _ -> go (n + 1)
 
 {- Enables an existing special remote. -}
 enableSpecialRemote :: SpecialRemoteMaker
-enableSpecialRemote name remotetype config = do
+enableSpecialRemote name remotetype mcreds config = do
 	r <- Command.InitRemote.findExisting name
 	case r of
 		Nothing -> error $ "Cannot find a special remote named " ++ name
-		Just (u, c) -> setupSpecialRemote name remotetype config (Just u, c)
+		Just (u, c) -> setupSpecialRemote name remotetype config mcreds (Just u, c)
 
-setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName
-setupSpecialRemote name remotetype config (mu, c) = do
+setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName
+setupSpecialRemote name remotetype config mcreds (mu, c) = do
 	{- Currently, only 'weak' ciphers can be generated from the
 	 - assistant, because otherwise GnuPG may block once the entropy
 	 - pool is drained, and as of now there's no way to tell the user
 	 - to perform IO actions to refill the pool. -}
-	(c', u) <- R.setup remotetype mu $
+	(c', u) <- R.setup remotetype mu mcreds $
 		M.insert "highRandomQuality" "false" $ M.union config c
 	describeUUID u name
 	configSet u c'

Assistant/WebApp/Configurators/AWS.hs

@@ -202,11 +202,11 @@ enableAWSRemote _ _ = error "S3 not supported by this build"
 #endif
 
 makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> StandardGroup -> AWSCreds -> RemoteName -> RemoteConfig -> Handler ()
-makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config = do
-	liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk)
+makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config = 
 	setupCloudRemote defaultgroup Nothing $
-		maker hostname remotetype config
+		maker hostname remotetype (Just creds) config
   where
+  	creds = (T.unpack ak, T.unpack sk)
 	{- AWS services use the remote name as the basis for a host
 	 - name, so filter it to contain valid characters. -}
 	hostname = case filter isAlphaNum name of

Assistant/WebApp/Configurators/Local.hs

@@ -314,7 +314,7 @@ getFinishAddDriveR drive = go
 		remotename' <- liftAnnex $ getGCryptRemoteName u dir
 		makewith $ const $ do
 			r <- liftAnnex $ addRemote $
-				enableSpecialRemote remotename' GCrypt.remote $ M.fromList
+				enableSpecialRemote remotename' GCrypt.remote Nothing $ M.fromList
 					[("gitrepo", dir)]
 			return (u, r)
 	{- Making a new unencrypted repo, or combining with an existing one. -}

Assistant/WebApp/Configurators/Ssh.hs

@@ -354,7 +354,7 @@ checkExistingGCrypt sshdata nope = checkGCryptRepoEncryption repourl nope nope $
 enableGCrypt :: SshData -> RemoteName -> Handler Html
 enableGCrypt sshdata reponame = 
 	setupCloudRemote TransferGroup Nothing $ 
-		enableSpecialRemote reponame GCrypt.remote $ M.fromList
+		enableSpecialRemote reponame GCrypt.remote Nothing $ M.fromList
 			[("gitrepo", genSshUrl sshdata)]
 
 {- Combining with a gcrypt repository that may not be

Assistant/WebApp/Configurators/WebDAV.hs

@@ -123,10 +123,9 @@ postEnableWebDAVR _ = error "WebDAV not supported by this build"
 
 #ifdef WITH_WEBDAV
 makeWebDavRemote :: SpecialRemoteMaker -> RemoteName -> CredPair -> RemoteConfig -> Handler ()
-makeWebDavRemote maker name creds config = do
-	liftIO $ WebDAV.setCredsEnv creds
+makeWebDavRemote maker name creds config = 
 	setupCloudRemote TransferGroup Nothing $
-		maker name WebDAV.remote config
+		maker name WebDAV.remote (Just creds) config
 
 {- Only returns creds previously used for the same hostname. -}
 previouslyUsedWebDAVCreds :: String -> Annex (Maybe CredPair)

Assistant/WebApp/MakeRemote.hs

@@ -28,8 +28,8 @@ import Utility.Yesod
  - and finishes setting it up, then starts syncing with it,
  - and finishes by displaying the page to edit it. -}
 setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a
-setupCloudRemote defaultgroup mcost maker = do
-	r <- liftAnnex $ addRemote maker
+setupCloudRemote defaultgroup mcost name = do
+	r <- liftAnnex $ addRemote name
 	liftAnnex $ do
 		setStandardGroup (Remote.uuid r) defaultgroup
 		maybe noop (Config.setRemoteCost (Remote.repo r)) mcost