From d5f672ddd59b43cb9b1bac8f836864165c8931f2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 23 May 2016 17:03:20 -0400
Subject: Pass the various gnupg-options configs to gpg in several cases where
 they were not before.

Removed the instance LensGpgEncParams RemoteConfig because it encouraged
code that does not take the RemoteGitConfig into account.

RemoteType's setup was changed to take a RemoteGitConfig,
although the only place that is able to provide a non-empty one is
enableremote, when it's changing an existing remote. This led to several
folow-on changes, and got RemoteGitConfig plumbed through.
---
 Remote/Bup.hs            |  4 ++--
 Remote/Ddar.hs           |  4 ++--
 Remote/Directory.hs      |  4 ++--
 Remote/External.hs       | 11 ++++++-----
 Remote/External/Types.hs |  7 +++++--
 Remote/GCrypt.hs         |  4 ++--
 Remote/Git.hs            |  6 +++---
 Remote/Glacier.hs        | 38 ++++++++++++++++++++------------------
 Remote/Helper/Special.hs | 17 ++++++++---------
 Remote/Hook.hs           |  4 ++--
 Remote/Rsync.hs          |  4 ++--
 Remote/S3.hs             | 36 +++++++++++++++++++-----------------
 Remote/Tahoe.hs          |  4 ++--
 Remote/WebDAV.hs         | 12 ++++++------
 14 files changed, 81 insertions(+), 74 deletions(-)

(limited to 'Remote')

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index a481504a0..eda1950d3 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -90,8 +90,8 @@ gen r u c gc = do
 		{ chunkConfig = NoChunks
 		}
 
-bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-bupSetup mu _ c = do
+bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+bupSetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 8758949c9..3d0ad53b2 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -82,8 +82,8 @@ gen r u c gc = do
 		{ chunkConfig = NoChunks
 		}
 
-ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-ddarSetup mu _ c = do
+ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+ddarSetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 190008078..d7c5696a9 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -77,8 +77,8 @@ gen r u c gc = do
   where
 	dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
 
-directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-directorySetup mu _ c = do
+directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+directorySetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let dir = fromMaybe (error "Specify directory=") $
diff --git a/Remote/External.hs b/Remote/External.hs
index 54db82d1f..04834c78f 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -59,7 +59,7 @@ gen r u c gc
 			Nothing
 			Nothing
 	| otherwise = do
-		external <- newExternal externaltype u c
+		external <- newExternal externaltype u c gc
 		Annex.addCleanup (RemoteCleanup u) $ stopExternal external
 		cst <- getCost external r gc
 		avail <- getAvailability external r gc
@@ -108,8 +108,8 @@ gen r u c gc
 			rmt
 	externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
 
-externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-externalSetup mu _ c = do
+externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+externalSetup mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	let externaltype = fromMaybe (error "Specify externaltype=") $
 		M.lookup "externaltype" c
@@ -120,7 +120,7 @@ externalSetup mu _ c = do
 			setConfig (remoteConfig (fromJust (M.lookup "name" c)) "readonly") (boolConfig True)
 			return c'
 		_ -> do
-			external <- newExternal externaltype u c'
+			external <- newExternal externaltype u c' gc
 			handleRequest external INITREMOTE Nothing $ \resp -> case resp of
 				INITREMOTE_SUCCESS -> Just noop
 				INITREMOTE_FAILURE errmsg -> Just $ error errmsg
@@ -246,8 +246,9 @@ handleRequest' lck external req mp responsehandler
 		void $ liftIO $ atomically $ swapTMVar (externalConfig external) c'
 	handleRemoteRequest (GETCREDS setting) = do
 		c <- liftIO $ atomically $ readTMVar $ externalConfig external
+		gc <- liftIO $ atomically $ readTMVar $ externalGitConfig external
 		creds <- fromMaybe ("", "") <$> 
-			getRemoteCredPair c (credstorage setting)
+			getRemoteCredPair c gc (credstorage setting)
 		send $ CREDS (fst creds) (snd creds)
 	handleRemoteRequest GETUUID = send $
 		VALUE $ fromUUID $ externalUUID external
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index 2ce498341..66a285535 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -54,15 +54,18 @@ data External = External
 	, externalLock :: TMVar ExternalLock
 	-- Never left empty.
 	, externalConfig :: TMVar RemoteConfig
+	-- Never left empty.
+	, externalGitConfig :: TMVar RemoteGitConfig
 	}
 
-newExternal :: ExternalType -> UUID -> RemoteConfig -> Annex External
-newExternal externaltype u c = liftIO $ External
+newExternal :: ExternalType -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex External
+newExternal externaltype u c gc = liftIO $ External
 	<$> pure externaltype
 	<*> pure u
 	<*> atomically newEmptyTMVar
 	<*> atomically (newTMVar ExternalLock)
 	<*> atomically (newTMVar c)
+	<*> atomically (newTMVar gc)
 
 type ExternalType = String
 
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 38b85d91b..c35f17920 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -169,8 +169,8 @@ noCrypto = error "cannot use gcrypt remote without encryption enabled"
 unsupportedUrl :: a
 unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported"
 
-gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-gCryptSetup mu _ c = go $ M.lookup "gitrepo" c
+gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+gCryptSetup mu _ c _ = go $ M.lookup "gitrepo" c
   where
 	remotename = fromJust (M.lookup "name" c)
 	go Nothing = error "Specify gitrepo="
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 627a6066b..0528f9f88 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -93,8 +93,8 @@ list autoinit = do
  - No attempt is made to make the remote be accessible via ssh key setup,
  - etc.
  -}
-gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-gitSetup Nothing _ c = do
+gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+gitSetup Nothing _ c _ = do
 	let location = fromMaybe (error "Specify location=url") $
 		Url.parseURIRelaxed =<< M.lookup "location" c
 	g <- Annex.gitRepo
@@ -103,7 +103,7 @@ gitSetup Nothing _ c = do
 		[] -> error "could not find existing git remote with specified location"
 		_ -> error "found multiple git remotes with specified location"
 	return (c, u)
-gitSetup (Just u) _ c = do
+gitSetup (Just u) _ c _ = do
 	inRepo $ Git.Command.run
 		[ Param "remote"
 		, Param "add"
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 6ba36ccd2..800b16875 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -78,17 +78,17 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 		{ chunkConfig = NoChunks
 		}
 
-glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-glacierSetup mu mcreds c = do
+glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+glacierSetup mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	glacierSetup' (isJust mu) u mcreds c
-glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-glacierSetup' enabling u mcreds c = do
+	glacierSetup' (isJust mu) u mcreds c gc
+glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+glacierSetup' enabling u mcreds c gc = do
 	(c', encsetup) <- encryptionSetup c
 	c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
 	let fullconfig = c'' `M.union` defaults
 	unless enabling $
-		genVault fullconfig u
+		genVault fullconfig gc u
 	gitConfigSpecialRemote u fullconfig "glacier" "true"
 	return (fullconfig, u)
   where
@@ -110,9 +110,10 @@ nonEmpty k
 	| otherwise = return True
 
 store :: Remote -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
-store r k b p = go =<< glacierEnv c u
+store r k b p = go =<< glacierEnv c gc u
   where
 	c = config r
+	gc = gitconfig r
 	u = uuid r
 	params = glacierParams c
 		[ Param "archive"
@@ -133,9 +134,10 @@ prepareRetrieve :: Remote -> Preparer Retriever
 prepareRetrieve = simplyPrepare . byteRetriever . retrieve
 
 retrieve :: Remote -> Key -> (L.ByteString -> Annex Bool) -> Annex Bool
-retrieve r k sink = go =<< glacierEnv c u
+retrieve r k sink = go =<< glacierEnv c gc u
   where
 	c = config r
+	gc = gitconfig r
 	u = uuid r
 	params = glacierParams c
 		[ Param "archive"
@@ -178,7 +180,7 @@ remove r k = glacierAction r
 checkKey :: Remote -> CheckPresent
 checkKey r k = do
 	showChecking r
-	go =<< glacierEnv (config r) (uuid r)
+	go =<< glacierEnv (config r) (gitconfig r) (uuid r)
   where
 	go Nothing = error "cannot check glacier"
 	go (Just e) = do
@@ -207,10 +209,10 @@ checkKey r k = do
 			]
 
 glacierAction :: Remote -> [CommandParam] -> Annex Bool
-glacierAction r = runGlacier (config r) (uuid r)
+glacierAction r = runGlacier (config r) (gitconfig r) (uuid r)
 
-runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool
-runGlacier c u params = go =<< glacierEnv c u
+runGlacier :: RemoteConfig -> RemoteGitConfig -> UUID -> [CommandParam] -> Annex Bool
+runGlacier c gc u params = go =<< glacierEnv c gc u
   where
 	go Nothing = return False
 	go (Just e) = liftIO $
@@ -223,10 +225,10 @@ glacierParams c params = datacenter:params
 		fromMaybe (error "Missing datacenter configuration")
 			(M.lookup "datacenter" c)
 
-glacierEnv :: RemoteConfig -> UUID -> Annex (Maybe [(String, String)])
-glacierEnv c u = do
+glacierEnv :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe [(String, String)])
+glacierEnv c gc u = do
 	liftIO checkSaneGlacierCommand
-	go =<< getRemoteCredPairFor "glacier" c creds
+	go =<< getRemoteCredPairFor "glacier" c gc creds
   where
 	go Nothing = return Nothing
 	go (Just (user, pass)) = do
@@ -245,8 +247,8 @@ archive r k = fileprefix ++ key2file k
   where
 	fileprefix = M.findWithDefault "" "fileprefix" $ config r
 
-genVault :: RemoteConfig -> UUID -> Annex ()
-genVault c u = unlessM (runGlacier c u params) $
+genVault :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
+genVault c gc u = unlessM (runGlacier c gc u params) $
 	error "Failed creating glacier vault."
   where
 	params = 
@@ -266,7 +268,7 @@ genVault c u = unlessM (runGlacier c u params) $
  - not supported.
  -}
 jobList :: Remote -> [Key] -> Annex ([Key], [Key])
-jobList r keys = go =<< glacierEnv (config r) (uuid r)
+jobList r keys = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
   where
 	params = [ Param "job", Param "list" ]
 	nada = ([], [])
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index cf0524dc4..48cf09867 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -178,8 +178,6 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 		}
 	cip = cipherKey c
 	isencrypted = isJust (extractCipher c)
-	gpgencopts = getGpgEncParams encr
-	gpgdecopts = getGpgDecParams encr
 
 	safely a = catchNonAsync a (\e -> warning (show e) >> return False)
 
@@ -201,7 +199,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 	storechunk (Just (cipher, enck)) storer k content p = do
 		cmd <- gpgCmd <$> Annex.getGitConfig
 		withBytes content $ \b ->
-			encrypt cmd gpgencopts cipher (feedBytes b) $
+			encrypt cmd encr cipher (feedBytes b) $
 				readBytes $ \encb ->
 					storer (enck k) (ByteContent encb) p
 
@@ -211,7 +209,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 	  where
 		go (Just retriever) = displayprogress p k $ \p' ->
 			retrieveChunks retriever (uuid baser) chunkconfig
-				enck k dest p' (sink dest enc gpgdecopts)
+				enck k dest p' (sink dest enc encr)
 		go Nothing = return False
 		enck = maybe id snd enc
 
@@ -244,26 +242,27 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
  - into place. (And it may even already be in the right place..)
  -}
 sink
-	:: FilePath
+	:: LensGpgEncParams c
+	=> FilePath
 	-> Maybe (Cipher, EncKey)
-	-> [CommandParam]
+	-> c
 	-> Maybe Handle
 	-> Maybe MeterUpdate
 	-> ContentSource
 	-> Annex Bool
-sink dest enc gpgdecopts mh mp content = do
+sink dest enc c mh mp content = do
 	case (enc, mh, content) of
 		(Nothing, Nothing, FileContent f)
 			| f == dest -> noop
 			| otherwise -> liftIO $ moveFile f dest
 		(Just (cipher, _), _, ByteContent b) -> do
 			cmd <- gpgCmd <$> Annex.getGitConfig
-			decrypt cmd gpgdecopts cipher (feedBytes b) $
+			decrypt cmd c cipher (feedBytes b) $
 				readBytes write
 		(Just (cipher, _), _, FileContent f) -> do
 			cmd <- gpgCmd <$> Annex.getGitConfig
 			withBytes content $ \b ->
-				decrypt cmd gpgdecopts cipher (feedBytes b) $
+				decrypt cmd c cipher (feedBytes b) $
 					readBytes write
 			liftIO $ nukeFile f
 		(Nothing, _, FileContent f) -> do
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index fb5afcadb..20f5e5164 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -70,8 +70,8 @@ gen r u c gc = do
   where
 	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
 
-hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-hookSetup mu _ c = do
+hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+hookSetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 	let hooktype = fromMaybe (error "Specify hooktype=") $
 		M.lookup "hooktype" c
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index a0e30c7f7..28709bdab 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -137,8 +137,8 @@ rsyncTransport gc url
 	loginopt = maybe [] (\l -> ["-l",l]) login
 	fromNull as xs = if null xs then as else xs
 
-rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-rsyncSetup mu _ c = do
+rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+rsyncSetup mu _ c _ = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let url = fromMaybe (error "Specify rsyncurl=") $
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 1635d22bb..cf662c3d1 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -99,12 +99,14 @@ gen r u c gc = do
 			, checkUrl = Nothing
 			}
 
-s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-s3Setup mu mcreds c = do
+s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+s3Setup mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	s3Setup' (isNothing mu) u mcreds c
-s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
+	s3Setup' (isNothing mu) u mcreds c gc
+s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+s3Setup' new u mcreds c gc
+	| configIA c = archiveorg
+	| otherwise = defaulthost
   where
 	remotename = fromJust (M.lookup "name" c)
 	defbucket = remotename ++ "-" ++ fromUUID u
@@ -125,7 +127,7 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
 		c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
 		let fullconfig = c'' `M.union` defaults
 		when new $
-			genBucket fullconfig u
+			genBucket fullconfig gc u
 		use fullconfig
 
 	archiveorg = do
@@ -146,7 +148,7 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
 			-- special constraints on key names
 			M.insert "mungekeys" "ia" defaults
 		info <- extractS3Info archiveconfig
-		withS3Handle archiveconfig u $
+		withS3Handle archiveconfig gc u $
 			writeUUIDFile archiveconfig u info
 		use archiveconfig
 
@@ -154,12 +156,12 @@ s3Setup' new u mcreds c = if configIA c then archiveorg else defaulthost
 -- http connections to be reused across calls to the helper.
 prepareS3Handle :: Remote -> (S3Handle -> helper) -> Preparer helper
 prepareS3Handle r = resourcePrepare $ const $
-	withS3Handle (config r) (uuid r)
+	withS3Handle (config r) (gitconfig r) (uuid r)
 
 -- Allows for read-only actions, which can be run without a S3Handle.
 prepareS3HandleMaybe :: Remote -> (Maybe S3Handle -> helper) -> Preparer helper
 prepareS3HandleMaybe r = resourcePrepare $ const $
-	withS3HandleMaybe (config r) (uuid r)
+	withS3HandleMaybe (config r) (gitconfig r) (uuid r)
 
 store :: Remote -> S3Info -> S3Handle -> Storer
 store _r info h = fileStorer $ \k f p -> do
@@ -311,11 +313,11 @@ checkKey r info Nothing k = case getpublicurl info of
  - so first check if the UUID file already exists and we can skip doing
  - anything.
  -}
-genBucket :: RemoteConfig -> UUID -> Annex ()
-genBucket c u = do
+genBucket :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
+genBucket c gc u = do
 	showAction "checking bucket"
 	info <- extractS3Info c
-	withS3Handle c u $ \h ->
+	withS3Handle c gc u $ \h ->
 		go info h =<< checkUUIDFile c u info h
   where
 	go _ _ (Right True) = noop
@@ -408,16 +410,16 @@ sendS3Handle'
 	-> ResourceT IO a
 sendS3Handle' h r = AWS.pureAws (hawscfg h) (hs3cfg h) (hmanager h) r
 
-withS3Handle :: RemoteConfig -> UUID -> (S3Handle -> Annex a) -> Annex a
-withS3Handle c u a = withS3HandleMaybe c u $ \mh -> case mh of
+withS3Handle :: RemoteConfig -> RemoteGitConfig -> UUID -> (S3Handle -> Annex a) -> Annex a
+withS3Handle c gc u a = withS3HandleMaybe c gc u $ \mh -> case mh of
 	Just h -> a h
 	Nothing -> do
 		warnMissingCredPairFor "S3" (AWS.creds u)
 		error "No S3 credentials configured"
 
-withS3HandleMaybe :: RemoteConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
-withS3HandleMaybe c u a = do
-	mcreds <- getRemoteCredPair c (AWS.creds u)
+withS3HandleMaybe :: RemoteConfig -> RemoteGitConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
+withS3HandleMaybe c gc u a = do
+	mcreds <- getRemoteCredPair c gc (AWS.creds u)
 	case mcreds of
 		Just creds -> do
 			awscreds <- liftIO $ genCredentials creds
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index aff1aaee0..05b120d46 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -91,8 +91,8 @@ gen r u c gc = do
 		, checkUrl = Nothing
 		}
 
-tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-tahoeSetup mu _ c = do
+tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+tahoeSetup mu _ c _ = do
 	furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c)
 		<$> liftIO (getEnv "TAHOE_FURL")
 	u <- maybe (liftIO genUUID) return mu
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index a135be466..08b1a5496 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -81,14 +81,14 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			}
 		chunkconfig = getChunkConfig c
 
-webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
-webdavSetup mu mcreds c = do
+webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+webdavSetup mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	url <- case M.lookup "url" c of
 		Nothing -> error "Specify url="
 		Just url -> return url
 	(c', encsetup) <- encryptionSetup c
-	creds <- maybe (getCreds c' u) (return . Just) mcreds
+	creds <- maybe (getCreds c' gc u) (return . Just) mcreds
 	testDav url creds
 	gitConfigSpecialRemote u c' "webdav" "true"
 	c'' <- setRemoteCredPair encsetup c' (davCreds u) creds
@@ -234,8 +234,8 @@ mkColRecursive d = go =<< existsDAV d
 			inLocation d mkCol
 		)
 
-getCreds :: RemoteConfig -> UUID -> Annex (Maybe CredPair)
-getCreds c u = getRemoteCredPairFor "webdav" c (davCreds u)
+getCreds :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe CredPair)
+getCreds c gc u = getRemoteCredPairFor "webdav" c gc (davCreds u)
 
 davCreds :: UUID -> CredPairStorage
 davCreds u = CredPairStorage
@@ -291,7 +291,7 @@ data DavHandle = DavHandle DAVContext DavUser DavPass URLString
 
 withDAVHandle :: Remote -> (Maybe DavHandle -> Annex a) -> Annex a
 withDAVHandle r a = do
-	mcreds <- getCreds (config r) (uuid r)
+	mcreds <- getCreds (config r) (gitconfig r) (uuid r)
 	case (mcreds, configUrl r) of
 		(Just (user, pass), Just baseurl) ->
 			withDAVContext baseurl $ \ctx ->
-- 
cgit v1.2.3