ported almost all remotes, until my brain melted

external is not started yet, and S3 is part way through and not compiling yet
2020-01-14 15:41:34 -04:00 · 2020-01-14 15:41:34 -04:00 · c4ea3ca40a
commit c4ea3ca40a
parent c498269a88
13 changed files with 265 additions and 150 deletions
--- a/Annex/SpecialRemote/Config.hs
+++ b/Annex/SpecialRemote/Config.hs
@ -166,23 +166,35 @@ getRemoteConfigValue f m = case M.lookup f m of
 			]
 	Nothing -> Nothing

+{- Gets all fields that remoteConfigRestPassthrough matched. -}
+getRemoteConfigPassedThrough :: ParsedRemoteConfig -> M.Map RemoteConfigField String
+getRemoteConfigPassedThrough = M.mapMaybe $ \v ->
+	case cast v of
+		Just (PassedThrough s) -> Just s
+		Nothing -> Nothing
+
+newtype PassedThrough = PassedThrough String
+
 parseRemoteConfig :: RemoteConfig -> RemoteConfigParser -> Either String ParsedRemoteConfig
 parseRemoteConfig c rpc =
 	go [] (M.filterWithKey notaccepted c) (remoteConfigFieldParsers rpc ++ commonFieldParsers)
  where
-	go l c' []
-		| remoteConfigRestPassthrough rpc = Right $ M.fromList $
-			l ++ map (uncurry passthrough) (M.toList c')
-		| M.null c' = Right (M.fromList l)
-		| otherwise = Left $ "Unexpected fields: " ++
-			unwords (map fromProposedAccepted (M.keys c'))
+	go l c' [] =
+		let (passover, leftovers) = partition
+			(remoteConfigRestPassthrough rpc . fst)
+			(M.toList c')
+		in if not (null leftovers)
+			then Left $ "Unexpected fields: " ++
+				unwords (map (fromProposedAccepted . fst) leftovers)
+			else Right $ M.fromList $
+				l ++ map (uncurry passthrough) passover
 	go l c' ((f, p):rest) = do
 		v <- p (M.lookup f c) c
 		case v of
 			Just v' -> go ((f,v'):l) (M.delete f c') rest
 			Nothing -> go l (M.delete f c') rest
 	
-	passthrough f v = (f, RemoteConfigValue (fromProposedAccepted v))
+	passthrough f v = (f, RemoteConfigValue (PassedThrough (fromProposedAccepted v)))

 	notaccepted (Proposed _) _ = True
 	notaccepted (Accepted _) _ = False
--- a/Remote/Adb.hs
+++ b/Remote/Adb.hs
@ -1,6 +1,6 @@
 {- Remote on Android device accessed using adb.
 -
- - Copyright 2018-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2018-2020 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}
@ -20,6 +20,7 @@ import Remote.Helper.ExportImport
 import Annex.UUID
 import Utility.Metered
 import Types.ProposedAccepted
+import Annex.SpecialRemote.Config

 import qualified Data.Map as M
 import qualified System.FilePath.Posix as Posix
@ -32,16 +33,26 @@ newtype AndroidSerial = AndroidSerial { fromAndroidSerial :: String }
 newtype AndroidPath = AndroidPath { fromAndroidPath :: FilePath }

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "adb"
 	, enumerate = const (findSpecialRemotes "adb")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[ optionalStringParser androiddirectoryField
+		, optionalStringParser androidserialField
+		]
 	, setup = adbSetup
 	, exportSupported = exportIsSupported
 	, importSupported = importIsSupported
 	}

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+androiddirectoryField :: RemoteConfigField
+androiddirectoryField = Accepted "androiddirectory"
+
+androidserialField :: RemoteConfigField
+androidserialField = Accepted "androidserial"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = do
 	let this = Remote
 		{ uuid = u
@ -113,9 +124,9 @@ adbSetup _ mu _ c gc = do
 	adir <- maybe
 		(giveup "Specify androiddirectory=")
 		(pure . AndroidPath . fromProposedAccepted)
-		(M.lookup (Accepted "androiddirectory") c)
+		(M.lookup androiddirectoryField c)
 	serial <- getserial =<< liftIO enumerateAdbConnected
-	let c' = M.insert (Proposed "androidserial") (Proposed (fromAndroidSerial serial)) c
+	let c' = M.insert androidserialField (Proposed (fromAndroidSerial serial)) c

 	(c'', _encsetup) <- encryptionSetup c' gc

@ -133,7 +144,7 @@ adbSetup _ mu _ c gc = do
 	return (c'', u)
  where
 	getserial [] = giveup "adb does not list any connected android devices. Plug in an Android device, or configure adb, and try again.."
-	getserial l = case fromProposedAccepted <$> M.lookup (Accepted "androidserial") c of
+	getserial l = case fromProposedAccepted <$> M.lookup androidserialField c of
 		Nothing -> case l of
 			(s:[]) -> return s
 			_ -> giveup $ unlines $
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@ -41,6 +41,7 @@ remote = RemoteType
 	{ typename = "bittorrent"
 	, enumerate = list
 	, generate = gen
+	, configParser = mkRemoteConfigParser []
 	, setup = error "not supported"
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
@ -52,7 +53,7 @@ list _autoinit = do
 	r <- liftIO $ Git.Construct.remoteNamed "bittorrent" (pure Git.Construct.fromUnknown)
 	return [r]

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r _ c gc rs = do
 	cst <- remoteCost gc expensiveRemoteCost
 	return $ Just Remote
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@ -1,6 +1,6 @@
 {- Using bup as a remote.
 -
- - Copyright 2011-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}
@ -25,6 +25,7 @@ import qualified Git.Ref
 import Config
 import Config.Cost
 import qualified Remote.Helper.Ssh as Ssh
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.Messages
 import Remote.Helper.ExportImport
@ -38,16 +39,21 @@ import Types.ProposedAccepted
 type BupRepo = String

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "bup"
 	, enumerate = const (findSpecialRemotes "buprepo")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[optionalStringParser buprepoField]
 	, setup = bupSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+buprepoField :: RemoteConfigField
+buprepoField = Accepted "buprepo"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = do
 	bupr <- liftIO $ bup2GitRemote buprepo
 	cst <- remoteCost gc $
@ -110,7 +116,7 @@ bupSetup _ mu _ c gc = do

 	-- verify configuration is sane
 	let buprepo = maybe (giveup "Specify buprepo=") fromProposedAccepted $
-		M.lookup (Accepted "buprepo") c
+		M.lookup buprepoField c
 	(c', _encsetup) <- encryptionSetup c gc

 	-- bup init will create the repository.
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@ -18,6 +18,7 @@ import Types.Creds
 import qualified Git
 import Config
 import Config.Cost
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.ExportImport
 import Annex.Ssh
@ -31,16 +32,21 @@ data DdarRepo = DdarRepo
 	}

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "ddar"
 	, enumerate = const (findSpecialRemotes "ddarrepo")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[optionalStringParser ddarrepoField]
 	, setup = ddarSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+ddarrepoField :: RemoteConfigField
+ddarrepoField = Accepted "ddarrepo"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = do
 	cst <- remoteCost gc $
 		if ddarLocal ddarrepo
@ -100,7 +106,7 @@ ddarSetup _ mu _ c gc = do

 	-- verify configuration is sane
 	let ddarrepo = maybe (giveup "Specify ddarrepo=") fromProposedAccepted $
-		M.lookup (Accepted "ddarrepo") c
+		M.lookup ddarrepoField c
 	(c', _encsetup) <- encryptionSetup c gc

 	-- The ddarrepo is stored in git config, as well as this repo's
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@ -1,6 +1,6 @@
 {- Amazon Glacier remotes.
 -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}
@ -16,6 +16,7 @@ import Types.Remote
 import qualified Git
 import Config
 import Config.Cost
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.Messages
 import Remote.Helper.ExportImport
@ -31,16 +32,30 @@ type Vault = String
 type Archive = FilePath

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "glacier"
 	, enumerate = const (findSpecialRemotes "glacier")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[ optionalStringParser datacenterField
+		, optionalStringParser vaultField
+		, optionalStringParser fileprefixField
+		]
 	, setup = glacierSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+datacenterField :: RemoteConfigField
+datacenterField = Accepted "datacenter"
+	
+vaultField :: RemoteConfigField
+vaultField = Accepted "vault"
+
+fileprefixField :: RemoteConfigField
+fileprefixField = Accepted "fileprefix"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = new <$> remoteCost gc veryExpensiveRemoteCost
  where
 	new cst = Just $ specialRemote' specialcfg c
@ -100,8 +115,9 @@ glacierSetup' ss u mcreds c gc = do
 	(c', encsetup) <- encryptionSetup c gc
 	c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 	let fullconfig = c'' `M.union` defaults
+	pc <- either giveup return . parseRemoteConfig fullconfig =<< configParser remote
 	case ss of
-		Init -> genVault fullconfig gc u
+		Init -> genVault pc gc u
 		_ -> return ()
 	gitConfigSpecialRemote u fullconfig [("glacier", "true")]
 	return (fullconfig, u)
@ -225,21 +241,21 @@ checkKey r k = do
 glacierAction :: Remote -> [CommandParam] -> Annex Bool
 glacierAction r = runGlacier (config r) (gitconfig r) (uuid r)

-runGlacier :: RemoteConfig -> RemoteGitConfig -> UUID -> [CommandParam] -> Annex Bool
+runGlacier :: ParsedRemoteConfig -> RemoteGitConfig -> UUID -> [CommandParam] -> Annex Bool
 runGlacier c gc u params = go =<< glacierEnv c gc u
  where
 	go Nothing = return False
 	go (Just e) = liftIO $
 		boolSystemEnv "glacier" (glacierParams c params) (Just e)

-glacierParams :: RemoteConfig -> [CommandParam] -> [CommandParam]
+glacierParams :: ParsedRemoteConfig -> [CommandParam] -> [CommandParam]
 glacierParams c params = datacenter:params
  where
 	datacenter = Param $ "--region=" ++
-		maybe (giveup "Missing datacenter configuration") fromProposedAccepted
-			(M.lookup (Accepted "datacenter") c)
+		fromMaybe (giveup "Missing datacenter configuration")
+			(getRemoteConfigValue datacenterField c)

-glacierEnv :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe [(String, String)])
+glacierEnv :: ParsedRemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe [(String, String)])
 glacierEnv c gc u = do
 	liftIO checkSaneGlacierCommand
 	go =<< getRemoteCredPairFor "glacier" c gc creds
@ -252,17 +268,17 @@ glacierEnv c gc u = do
 	creds = AWS.creds u
 	(uk, pk) = credPairEnvironment creds

-getVault :: RemoteConfig -> Vault
-getVault = maybe (giveup "Missing vault configuration") fromProposedAccepted
-	. M.lookup (Accepted "vault")
+getVault :: ParsedRemoteConfig -> Vault
+getVault = fromMaybe (giveup "Missing vault configuration") 
+	. getRemoteConfigValue vaultField

 archive :: Remote -> Key -> Archive
 archive r k = fileprefix ++ serializeKey k
  where
-	fileprefix = maybe "" fromProposedAccepted $
-		M.lookup (Accepted "fileprefix") $ config r
+	fileprefix = fromMaybe "" $
+		getRemoteConfigValue fileprefixField $ config r

-genVault :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
+genVault :: ParsedRemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
 genVault c gc u = unlessM (runGlacier c gc u params) $
 	giveup "Failed creating glacier vault."
  where
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@ -72,7 +72,7 @@ encryptionConfigs = S.fromList (map fst encryptionConfigParsers)
 parseEncryptionConfig :: RemoteConfig -> Either String ParsedRemoteConfig
 parseEncryptionConfig c = parseRemoteConfig
 	(M.restrictKeys c encryptionConfigs)
-	(RemoteConfigParser encryptionConfigParsers False)
+	(RemoteConfigParser encryptionConfigParsers (const False))

 parseEncryptionMethod :: Maybe String -> RemoteConfig -> Either String EncryptionMethod
 parseEncryptionMethod (Just "none") _ = Right NoneEncryption
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@ -1,6 +1,6 @@
 {- A remote that provides hooks to run shell commands.
 -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}
@ -15,6 +15,7 @@ import Git.Types (fromConfigKey, fromConfigValue)
 import Config
 import Config.Cost
 import Annex.UUID
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.Messages
 import Remote.Helper.ExportImport
@ -28,16 +29,21 @@ type Action = String
 type HookName = String

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "hook"
 	, enumerate = const (findSpecialRemotes "hooktype")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[optionalStringParser hooktypeField]
 	, setup = hookSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+hooktypeField :: RemoteConfigField
+hooktypeField = Accepted "hooktype"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = do
 	cst <- remoteCost gc expensiveRemoteCost
 	return $ Just $ specialRemote c
@ -87,7 +93,7 @@ hookSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> Remot
 hookSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	let hooktype = maybe (giveup "Specify hooktype=") fromProposedAccepted $
-		M.lookup (Accepted "hooktype") c
+		M.lookup hooktypeField c
 	(c', _encsetup) <- encryptionSetup c gc
 	gitConfigSpecialRemote u c' [("hooktype", hooktype)]
 	return (c', u)
--- a/Remote/List.hs
+++ b/Remote/List.hs
@ -27,14 +27,11 @@ import qualified Git.Config
 import qualified Remote.Git
 import qualified Remote.GCrypt
 import qualified Remote.P2P
-{-
 #ifdef WITH_S3
 import qualified Remote.S3
 #endif
 import qualified Remote.Bup
-}
 import qualified Remote.Directory
-{-
 import qualified Remote.Rsync
 import qualified Remote.Web
 import qualified Remote.BitTorrent
@ -45,10 +42,9 @@ import qualified Remote.Adb
 import qualified Remote.Tahoe
 import qualified Remote.Glacier
 import qualified Remote.Ddar
-}
 import qualified Remote.GitLFS
-{-
 import qualified Remote.Hook
+{-
 import qualified Remote.External
 -}

@ -57,14 +53,11 @@ remoteTypes = map adjustExportImportRemoteType
 	[ Remote.Git.remote
 	, Remote.GCrypt.remote
 	, Remote.P2P.remote
-{-
 #ifdef WITH_S3
 	, Remote.S3.remote
 #endif
 	, Remote.Bup.remote
-}
 	, Remote.Directory.remote
-{-
 	, Remote.Rsync.remote
 	, Remote.Web.remote
 	, Remote.BitTorrent.remote
@ -75,10 +68,9 @@ remoteTypes = map adjustExportImportRemoteType
 	, Remote.Tahoe.remote
 	, Remote.Glacier.remote
 	, Remote.Ddar.remote
-}
 	, Remote.GitLFS.remote
-{-
 	, Remote.Hook.remote
+{-
 	, Remote.External.remote
 -}
 	]
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@ -1,6 +1,6 @@
 {- S3 remotes
 -
- - Copyright 2011-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}
@ -69,16 +69,72 @@ type BucketName = String
 type BucketObject = String

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "S3"
 	, enumerate = const (findSpecialRemotes "s3")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[ optionalStringParser bucketField
+		, optionalStringParser hostField
+		, optionalStringParser datacenterField
+		, optionalStringParser partsizeField
+		, optionalStringParser storageclassField
+		, optionalStringParser fileprefixField
+		, yesNoParser versioningField False
+		, yesNoParser publicField False
+		, optionalStringParser publicurlField
+		, optionalStringParser protocolField
+		, optionalStringParser portField
+		, optionalStringParser requeststyleField
+		, optionalStringParser mungekeysField
+		]
+		{ remoteConfigRestPassthrough = \f -> isMetaHeader f || isArchiveMetaHeader f
+		}
 	, setup = s3Setup
 	, exportSupported = exportIsSupported
 	, importSupported = importIsSupported
 	}

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+bucketField :: RemoteConfigField
+bucketField = Accepted "bucket"
+
+hostField :: RemoteConfigField
+hostField = Accepted "host"
+
+datacenterField :: RemoteConfigField
+datacenterField = Accepted "datacenter"
+
+partsizeField :: RemoteConfigField
+partsizeField = Accepted "partsize"
+
+storageclassField :: RemoteConfigField
+storageclassField = Accepted "storageclass"
+
+fileprefixField :: RemoteConfigField
+fileprefixField = Accepted "fileprefix"
+
+versioningField :: RemoteConfigField
+versioningField = Accepted "versioning"
+
+publicField :: RemoteConfigField
+publicField = Accepted "public"
+
+publicurlField :: RemoteConfigField
+publicurlField = Accepted "publicurl"
+
+protocolField :: RemoteConfigField
+protocolField = Accepted "protocol"
+
+requeststyleField :: RemoteConfigField
+requeststyleField = Accepted "requeststyle"
+
+portField :: RemoteConfigField
+portField = Accepted "port"
+
+mungekeysField :: RemoteConfigField
+mungekeysField = Accepted "mungekeys"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = do
 	cst <- remoteCost gc expensiveRemoteCost
 	info <- extractS3Info c
@ -135,7 +191,7 @@ gen r u c gc rs = do
 			, appendonly = versioning info
 			, availability = GloballyAvailable
 			, remotetype = remote
-			, mkUnavailable = gen r u (M.insert (Accepted "host") (Accepted "!dne!") c) gc rs
+			, mkUnavailable = gen r u (M.insert hostField (RemoteConfigValue "!dne!") c) gc rs
 			, getInfo = includeCredsInfo c (AWS.creds u) (s3Info c info)
 			, claimUrl = Nothing
 			, checkUrl = Nothing
@ -155,27 +211,19 @@ s3Setup' ss u mcreds c gc
 	remotename = fromJust (lookupName c)
 	defbucket = remotename ++ "-" ++ fromUUID u
 	defaults = M.fromList
-		[ (Proposed "datacenter", Proposed $ T.unpack $ AWS.defaultRegion AWS.S3)
+		[ (datacenterField, Proposed $ T.unpack $ AWS.defaultRegion AWS.S3)
 		, (Proposed "storageclass", Proposed "STANDARD")
-		, (Proposed "host", Proposed  AWS.s3DefaultHost)
+		, (hostField, Proposed  AWS.s3DefaultHost)
 		, (Proposed "port", Proposed "80")
 		, (Proposed "bucket", Proposed defbucket)
 		]

-	checkconfigsane = do
-		checkyesno "versioning"
-		checkyesno "public"
-	checkyesno k = case parseProposedAccepted (Accepted k) c yesNo False "yes or no" of
-		Left err -> giveup err
-		Right _ -> noop
-
 	use fullconfig info = do
 		enableBucketVersioning ss info fullconfig gc u
 		gitConfigSpecialRemote u fullconfig [("s3", "true")]
 		return (fullconfig, u)

 	defaulthost = do
-		checkconfigsane
 		(c', encsetup) <- encryptionSetup c gc
 		c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 		let fullconfig = c'' `M.union` defaults
@ -188,7 +236,6 @@ s3Setup' ss u mcreds c gc

 	archiveorg = do
 		showNote "Internet Archive mode"
-		checkconfigsane
 		c' <- setRemoteCredPair noEncryptionUsed c gc (AWS.creds u) mcreds
 		-- Ensure user enters a valid bucket name, since
 		-- this determines the name of the archive.org item.
@ -197,7 +244,7 @@ s3Setup' ss u mcreds c gc
 				(getBucketName c')
 		let archiveconfig = 
 			-- IA acdepts x-amz-* as an alias for x-archive-*
-			M.mapKeys (Proposed  . replace "x-archive-" "x-amz-" . fromProposedAccepted) $
+			M.mapKeys (Proposed . replace "x-archive-" "x-amz-" . fromProposedAccepted) $
 			-- encryption does not make sense here
 			M.insert encryptionField (Proposed "none") $
 			M.insert (Accepted "bucket") (Proposed validbucket) $
@ -303,7 +350,7 @@ storeHelper info h magic f object p = liftIO $ case partSize info of
 {- Implemented as a fileRetriever, that uses conduit to stream the chunks
 - out to the file. Would be better to implement a byteRetriever, but
 - that is difficult. -}
-retrieve :: S3HandleVar -> Remote -> RemoteStateHandle -> RemoteConfig -> S3Info -> Retriever
+retrieve :: S3HandleVar -> Remote -> RemoteStateHandle -> ParsedRemoteConfig -> S3Info -> Retriever
 retrieve hv r rs c info = fileRetriever $ \f k p -> withS3Handle hv $ \case
 	(Just h) -> 
 		eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case
@ -340,7 +387,7 @@ remove hv r info k = withS3HandleOrFail (uuid r) hv $ \h -> liftIO $ runResource
 		S3.DeleteObject (T.pack $ bucketObject info k) (bucket info)
 	return $ either (const False) (const True) res

-checkKey :: S3HandleVar -> Remote -> RemoteStateHandle -> RemoteConfig -> S3Info -> CheckPresent
+checkKey :: S3HandleVar -> Remote -> RemoteStateHandle -> ParsedRemoteConfig -> S3Info -> CheckPresent
 checkKey hv r rs c info k = withS3Handle hv $ \case
 	Just h -> do
 		showChecking r
@ -637,7 +684,7 @@ checkPresentExportWithContentIdentifierS3 hv r info _k loc knowncids =
 - so first check if the UUID file already exists and we can skip creating
 - it.
 -}
-genBucket :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
+genBucket :: ParsedRemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
 genBucket c gc u = do
 	showAction "checking bucket"
 	info <- extractS3Info c
@ -662,8 +709,7 @@ genBucket c gc u = do
 		writeUUIDFile c u info h
 	
 	locconstraint = mkLocationConstraint $ T.pack datacenter
-	datacenter = fromProposedAccepted $ fromJust $
-		M.lookup (Accepted "datacenter") c
+	datacenter = fromJust $ getRemoteConfigValue datacenterField c
 	-- "NEARLINE" as a storage class when creating a bucket is a
 	-- nonstandard extension of Google Cloud Storage.
 	storageclass = case getStorageClass c of
@ -678,7 +724,7 @@ genBucket c gc u = do
 - Note that IA buckets can only created by having a file
 - stored in them. So this also takes care of that.
 -}
-writeUUIDFile :: RemoteConfig -> UUID -> S3Info -> S3Handle -> Annex ()
+writeUUIDFile :: ParsedRemoteConfig -> UUID -> S3Info -> S3Handle -> Annex ()
 writeUUIDFile c u info h = do
 	v <- checkUUIDFile c u info h
 	case v of
@ -695,7 +741,7 @@ writeUUIDFile c u info h = do

 {- Checks if the UUID file exists in the bucket
 - and has the specified UUID already. -}
-checkUUIDFile :: RemoteConfig -> UUID -> S3Info -> S3Handle -> Annex (Either SomeException Bool)
+checkUUIDFile :: ParsedRemoteConfig -> UUID -> S3Info -> S3Handle -> Annex (Either SomeException Bool)
 checkUUIDFile c u info h = tryNonAsync $ liftIO $ runResourceT $ do
 	resp <- tryS3 $ sendS3Handle h (S3.getObject (bucket info) file)
 	case resp of
@ -711,7 +757,7 @@ checkUUIDFile c u info h = tryNonAsync $ liftIO $ runResourceT $ do
 	file = T.pack $ uuidFile c
 	uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u]

-uuidFile :: RemoteConfig -> FilePath
+uuidFile :: ParsedRemoteConfig -> FilePath
 uuidFile c = getFilePrefix c ++ "annex-uuid"

 tryS3 :: ResourceT IO a -> ResourceT IO (Either S3.S3Error a)
@ -735,7 +781,7 @@ type S3HandleVar = TVar (Either (Annex (Maybe S3Handle)) (Maybe S3Handle))

 {- Prepares a S3Handle for later use. Does not connect to S3 or do anything
 - else expensive. -}
-mkS3HandleVar :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex S3HandleVar
+mkS3HandleVar :: ParsedRemoteConfig -> RemoteGitConfig -> UUID -> Annex S3HandleVar
 mkS3HandleVar c gc u = liftIO $ newTVarIO $ Left $ do
 	mcreds <- getRemoteCredPair c gc (AWS.creds u)
 	case mcreds of
@ -766,26 +812,24 @@ withS3HandleOrFail u hv a = withS3Handle hv $ \case
 needS3Creds :: UUID -> String
 needS3Creds u = missingCredPairFor "S3" (AWS.creds u)

-s3Configuration :: RemoteConfig -> S3.S3Configuration AWS.NormalQuery
+s3Configuration :: ParsedRemoteConfig -> S3.S3Configuration AWS.NormalQuery
 s3Configuration c = cfg
 	{ S3.s3Port = port
-	, S3.s3RequestStyle = case fromProposedAccepted <$> M.lookup (Accepted "requeststyle") c of
+	, S3.s3RequestStyle = case getRemoteConfigValue requeststyleField c of
 		Just "path" -> S3.PathStyle
 		Just s -> giveup $ "bad S3 requeststyle value: " ++ s
 		Nothing -> S3.s3RequestStyle cfg
 	}
  where
-	h = fromProposedAccepted $ fromJust $
-		M.lookup (Accepted "host") c
-	datacenter = fromProposedAccepted $ fromJust $
-		M.lookup (Accepted "datacenter") c
+	h = fromJust $ getRemoteConfigValue hostField c
+	datacenter = fromJust $ getRemoteConfigValue datacenterField c
 	-- When the default S3 host is configured, connect directly to
 	-- the S3 endpoint for the configured datacenter.
 	-- When another host is configured, it's used as-is.
 	endpoint
 		| h == AWS.s3DefaultHost = AWS.s3HostName $ T.pack datacenter
 		| otherwise = T.encodeUtf8 $ T.pack h
-	port = case fromProposedAccepted <$> M.lookup (Accepted "port") c of
+	port = case getRemoteConfigValue portField c of
 		Just s -> 
 			case reads s of
 				[(p, _)]
@ -800,7 +844,7 @@ s3Configuration c = cfg
 			Just AWS.HTTPS -> 443
 			Just AWS.HTTP -> 80
 			Nothing -> 80
-	cfgproto = case fromProposedAccepted <$> M.lookup (Accepted "protocol") c of
+	cfgproto = case getRemoteConfigValue protocolField c of
 		Just "https" -> Just AWS.HTTPS
 		Just "http" -> Just AWS.HTTP
 		Just s -> giveup $ "bad S3 protocol value: " ++ s
@ -827,7 +871,7 @@ data S3Info = S3Info
 	, host :: Maybe String
 	}

-extractS3Info :: RemoteConfig -> Annex S3Info
+extractS3Info :: ParsedRemoteConfig -> Annex S3Info
 extractS3Info c = do
 	b <- maybe
 		(giveup "S3 bucket not configured")
@ -842,14 +886,13 @@ extractS3Info c = do
 		, metaHeaders = getMetaHeaders c
 		, partSize = getPartSize c
 		, isIA = configIA c
-		, versioning = boolcfg "versioning"
-		, public = boolcfg "public"
-		, publicurl = fromProposedAccepted <$> M.lookup (Accepted "publicurl") c
-		, host = fromProposedAccepted <$> M.lookup (Accepted "host") c
+		, versioning = fromMaybe False $
+			getRemoteConfigValue versioningField c
+		, public = fromMaybe False $
+			getRemoteConfigValue publicField c
+		, publicurl = getRemoteConfigValue publicurlField c
+		, host = getRemoteConfigValue hostField c
 		}
-  where
-	boolcfg k = fromMaybe False $
-		yesNo . fromProposedAccepted =<< M.lookup (Accepted k) c

 putObject :: S3Info -> T.Text -> RequestBody -> S3.PutObject
 putObject info file rbody = (S3.putObject (bucket info) file rbody)
@ -864,45 +907,51 @@ acl info
 	| public info = Just S3.AclPublicRead
 	| otherwise = Nothing

-getBucketName :: RemoteConfig -> Maybe BucketName
-getBucketName = map toLower . fromProposedAccepted
-	<$$> M.lookup (Accepted "bucket")
+getBucketName :: ParsedRemoteConfig -> Maybe BucketName
+getBucketName = map toLower <$$> getRemoteConfigValue bucketField

-getStorageClass :: RemoteConfig -> S3.StorageClass
-getStorageClass c = case fromProposedAccepted <$> M.lookup (Accepted "storageclass") c of
+getStorageClass :: ParsedRemoteConfig -> S3.StorageClass
+getStorageClass c = case getRemoteConfigValue storageclassField c of
 	Just "REDUCED_REDUNDANCY" -> S3.ReducedRedundancy
 	Just s -> S3.OtherStorageClass (T.pack s)
 	_ -> S3.Standard

-getPartSize :: RemoteConfig -> Maybe Integer
-getPartSize c = readSize dataUnits . fromProposedAccepted
-	=<< M.lookup (Accepted "partsize") c
+getPartSize :: ParsedRemoteConfig -> Maybe Integer
+getPartSize c = readSize dataUnits =<< getRemoteConfigValue partsizeField c

-getMetaHeaders :: RemoteConfig -> [(T.Text, T.Text)]
-getMetaHeaders = map munge . filter ismetaheader . map unwrap . M.assocs
+getMetaHeaders :: ParsedRemoteConfig -> [(T.Text, T.Text)]
+getMetaHeaders = map munge
+	. filter (isMetaHeader . fst)
+	. M.assocs
+	. getRemoteConfigPassedThrough
  where
-	unwrap (k, v) = (fromProposedAccepted k, fromProposedAccepted v)
-	ismetaheader (h, _) = metaprefix `isPrefixOf` h
-	metaprefix = "x-amz-meta-"
-	metaprefixlen = length metaprefix
-	munge (k, v) = (T.pack $ drop metaprefixlen k, T.pack v)
+	metaprefixlen = length metaPrefix
+	munge (k, v) = (T.pack $ drop metaprefixlen (fromProposedAccepted k), T.pack v)

-getFilePrefix :: RemoteConfig -> String
-getFilePrefix = maybe "" fromProposedAccepted
-	<$> M.lookup (Accepted "fileprefix")
+isMetaHeader :: RemoteConfigField -> Bool
+isMetaHeader h = metaPrefix `isPrefixOf` fromProposedAccepted h

-getBucketObject :: RemoteConfig -> Key -> BucketObject
+isArchiveMetaheader :: RemoteConfigField -> Bool
+isArchiveMetaheader h = "x-archive-" `isPrefixOf` fromProposedAccepted h
+
+metaPrefix :: String
+metaPrefix = "x-amz-meta-"
+
+getFilePrefix :: ParsedRemoteConfig -> String
+getFilePrefix = fromMaybe "" . getRemoteConfigValue fileprefixField
+
+getBucketObject :: ParsedRemoteConfig -> Key -> BucketObject
 getBucketObject c = munge . serializeKey
  where
-	munge s = case fromProposedAccepted <$> M.lookup (Accepted "mungekeys") c of
+	munge s = case getRemoteConfigValue mungekeysField c of
 		Just "ia" -> iaMunge $ getFilePrefix c ++ s
 		_ -> getFilePrefix c ++ s

-getBucketExportLocation :: RemoteConfig -> ExportLocation -> BucketObject
+getBucketExportLocation :: ParsedRemoteConfig -> ExportLocation -> BucketObject
 getBucketExportLocation c loc =
 	getFilePrefix c ++ fromRawFilePath (fromExportLocation loc)

-getBucketImportLocation :: RemoteConfig -> BucketObject -> Maybe ImportLocation
+getBucketImportLocation :: ParsedRemoteConfig -> BucketObject -> Maybe ImportLocation
 getBucketImportLocation c obj
 	-- The uuidFile should not be imported.
 	| obj == uuidfile = Nothing
@ -928,9 +977,8 @@ iaMunge = (>>= munge)
 		| isSpace c = []
 		| otherwise = "&" ++ show (ord c) ++ ";"

-configIA :: RemoteConfig -> Bool
-configIA = maybe False (isIAHost . fromProposedAccepted) 
-	. M.lookup (Accepted "host")
+configIA :: ParsedRemoteConfig -> Bool
+configIA = maybe False isIAHost . getRemoteConfigValue hostField

 {- Hostname to use for archive.org S3. -}
 iaHost :: HostName
@ -982,7 +1030,7 @@ debugMapper level t = forward "S3" (T.unpack t)
 		AWS.Warning -> warningM
 		AWS.Error -> errorM

-s3Info :: RemoteConfig -> S3Info -> [(String, String)]
+s3Info :: ParsedRemoteConfig -> S3Info -> [(String, String)]
 s3Info c info = catMaybes
 	[ Just ("bucket", fromMaybe "unknown" (getBucketName c))
 	, Just ("endpoint", w82s (BS.unpack (S3.s3Endpoint s3c)))
@ -1001,10 +1049,10 @@ s3Info c info = catMaybes
 	showstorageclass (S3.OtherStorageClass t) = T.unpack t
 	showstorageclass sc = show sc

-getPublicWebUrls :: UUID -> RemoteStateHandle -> S3Info -> RemoteConfig -> Key -> Annex [URLString]
+getPublicWebUrls :: UUID -> RemoteStateHandle -> S3Info -> ParsedRemoteConfig -> Key -> Annex [URLString]
 getPublicWebUrls u rs info c k = either (const []) id <$> getPublicWebUrls' u rs info c k

-getPublicWebUrls' :: UUID -> RemoteStateHandle -> S3Info -> RemoteConfig -> Key -> Annex (Either String [URLString])
+getPublicWebUrls' :: UUID -> RemoteStateHandle -> S3Info -> ParsedRemoteConfig -> Key -> Annex (Either String [URLString])
 getPublicWebUrls' u rs info c k
 	| not (public info) = return $ Left $ 
 		"S3 bucket does not allow public access; " ++ needS3Creds u
@ -1144,7 +1192,7 @@ getS3VersionID rs k = do
 s3VersionField :: MetaField
 s3VersionField = mkMetaFieldUnchecked "V"

-eitherS3VersionID :: S3Info -> RemoteStateHandle -> RemoteConfig -> Key -> S3.Object -> Annex (Either String (Either S3.Object S3VersionID))
+eitherS3VersionID :: S3Info -> RemoteStateHandle -> ParsedRemoteConfig -> Key -> S3.Object -> Annex (Either String (Either S3.Object S3VersionID))
 eitherS3VersionID info rs c k fallback
 	| versioning info = getS3VersionID rs k >>= return . \case
 		[] -> if exportTree c
@ -1169,7 +1217,7 @@ getS3VersionIDPublicUrls mk info rs k =
 -- Enable versioning on the bucket can only be done at init time;
 -- setting versioning in a bucket that git-annex has already exported
 -- files to risks losing the content of those un-versioned files.
-enableBucketVersioning :: SetupStage -> S3Info -> RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
+enableBucketVersioning :: SetupStage -> S3Info -> ParsedRemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
 #if MIN_VERSION_aws(0,21,1)
 enableBucketVersioning ss info c gc u = do
 #else
@ -1179,7 +1227,10 @@ enableBucketVersioning ss info _ _ _ = do
 		Init -> when (versioning info) $
 			enableversioning (bucket info)
 		Enable oldc -> do
-			oldinfo <- extractS3Info oldc
+			oldpc <- either (const mempty) id
+				. parseRemoteConfig oldc 
+				<$> configParser remote
+			oldinfo <- extractS3Info oldpc
 			when (versioning info /= versioning oldinfo) $
 				giveup "Cannot change versioning= of existing S3 remote."
  where
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@ -13,7 +13,7 @@
 -
 - Tahoe has its own encryption, so git-annex's encryption is not used.
 -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2019 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}
@ -54,16 +54,26 @@ type IntroducerFurl = String
 type Capability = String

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "tahoe"
 	, enumerate = const (findSpecialRemotes "tahoe")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[ optionalStringParser scsField
+		, optionalStringParser furlField
+		]
 	, setup = tahoeSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+scsField :: RemoteConfigField
+scsField = Accepted "shared-convergence-secret"
+
+furlField :: RemoteConfigField
+furlField = Accepted "introducer-furl"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = do
 	cst <- remoteCost gc expensiveRemoteCost
 	hdl <- liftIO $ TahoeHandle
@ -104,26 +114,23 @@ gen r u c gc rs = do

 tahoeSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 tahoeSetup _ mu _ c _ = do
-	furl <- maybe (fromMaybe missingfurl $ M.lookup furlk c) Proposed
+	furl <- maybe (fromMaybe missingfurl $ M.lookup furlField c) Proposed
 		<$> liftIO (getEnv "TAHOE_FURL")
 	u <- maybe (liftIO genUUID) return mu
 	configdir <- liftIO $ defaultTahoeConfigDir u
 	scs <- liftIO $ tahoeConfigure configdir
 		(fromProposedAccepted furl)
-		(fromProposedAccepted <$> (M.lookup scsk c))
-	let c' = case parseProposedAccepted embedCredsField c yesNo False "yes or no" of
-		Right (Just True) -> 
-			flip M.union c $ M.fromList
-				[ (furlk, furl)
-				, (scsk, Proposed scs)
-				]
-		Right _ -> c
-		Left err -> giveup err
+		(fromProposedAccepted <$> (M.lookup scsField c))
+	pc <- either giveup return . parseRemoteConfig c =<< configParser remote
+	let c' = if embedCreds pc
+		then flip M.union c $ M.fromList
+			[ (furlField, furl)
+			, (scsField, Proposed scs)
+			]
+		else c
 	gitConfigSpecialRemote u c' [("tahoe", configdir)]
 	return (c', u)
  where
-	scsk = Accepted "shared-convergence-secret"
-	furlk = Accepted "introducer-furl"
 	missingfurl = giveup "Set TAHOE_FURL to the introducer furl to use."

 store :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@ -1,6 +1,6 @@
 {- WebDAV remotes.
 -
- - Copyright 2012-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}
@ -29,6 +29,7 @@ import Types.Export
 import qualified Git
 import Config
 import Config.Cost
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.Messages
 import Remote.Helper.Http
@ -42,16 +43,22 @@ import Remote.WebDAV.DavLocation
 import Types.ProposedAccepted

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "webdav"
 	, enumerate = const (findSpecialRemotes "webdav")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[ optionalStringParser urlField
+		]
 	, setup = webdavSetup
 	, exportSupported = exportIsSupported
 	, importSupported = importUnsupported
 	}

-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+urlField :: RemoteConfigField
+urlField = Accepted "url"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = new <$> remoteCost gc expensiveRemoteCost
  where
 	new cst = Just $ specialRemote c
@ -96,9 +103,9 @@ gen r u c gc rs = new <$> remoteCost gc expensiveRemoteCost
 			, appendonly = False
 			, availability = GloballyAvailable
 			, remotetype = remote
-			, mkUnavailable = gen r u (M.insert (Accepted "url") (Accepted "http://!dne!/") c) gc rs
+			, mkUnavailable = gen r u (M.insert urlField (RemoteConfigValue "http://!dne!/") c) gc rs
 			, getInfo = includeCredsInfo c (davCreds u) $
-				[("url", maybe "unknown" fromProposedAccepted (M.lookup (Accepted "url") c))]
+				[("url", fromMaybe "unknown" $ getRemoteConfigValue urlField c)]
 			, claimUrl = Nothing
 			, checkUrl = Nothing
 			, remoteStateHandle = rs
@ -110,9 +117,10 @@ webdavSetup _ mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	url <- maybe (giveup "Specify url=")
 		(return . fromProposedAccepted)
-		(M.lookup (Accepted "url") c)
+		(M.lookup urlField c)
 	(c', encsetup) <- encryptionSetup c gc
-	creds <- maybe (getCreds c' gc u) (return . Just) mcreds
+	pc <- either giveup return . parseRemoteConfig c' =<< configParser remote
+	creds <- maybe (getCreds pc gc u) (return . Just) mcreds
 	testDav url creds
 	gitConfigSpecialRemote u c' [("webdav", "true")]
 	c'' <- setRemoteCredPair encsetup c' gc (davCreds u) creds
@ -256,8 +264,7 @@ runExport Nothing _ = return False
 runExport (Just h) a = fromMaybe False <$> liftIO (goDAV h $ safely (a h))

 configUrl :: Remote -> Maybe URLString
-configUrl r = fixup . fromProposedAccepted 
-	<$> M.lookup (Accepted "url") (config r)
+configUrl r = fixup <$> getRemoteConfigValue urlField (config r)
  where
 	-- box.com DAV url changed
 	fixup = replace "https://www.box.com/dav/" boxComUrl
@ -337,7 +344,7 @@ mkColRecursive d = go =<< existsDAV d
 				inLocation d mkCol
 			)

-getCreds :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe CredPair)
+getCreds :: ParsedRemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe CredPair)
 getCreds c gc u = getRemoteCredPairFor "webdav" c gc (davCreds u)

 davCreds :: UUID -> CredPairStorage
--- a/Types/RemoteConfig.hs
+++ b/Types/RemoteConfig.hs
@ -41,11 +41,11 @@ type RemoteConfigFieldParser = (RemoteConfigField, Maybe (ProposedAccepted Strin

 data RemoteConfigParser = RemoteConfigParser
 	{ remoteConfigFieldParsers :: [RemoteConfigFieldParser]
-	, remoteConfigRestPassthrough :: Bool
+	, remoteConfigRestPassthrough :: RemoteConfigField -> Bool
 	}

 mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> m RemoteConfigParser
-mkRemoteConfigParser l = pure (RemoteConfigParser l False)
+mkRemoteConfigParser l = pure (RemoteConfigParser l (const False))

 addRemoteConfigParser :: [RemoteConfigFieldParser] -> RemoteConfigParser -> RemoteConfigParser
 addRemoteConfigParser l rpc = rpc { remoteConfigFieldParsers = remoteConfigFieldParsers rpc ++ l }