convert configParser to Annex action and add passthrough option

Needed so Remote.External can query the external program for its
configs. When the external program does not support the query,
the passthrough option will make all input fields be available.

Annex/SpecialRemote/Config.hs

@@ -93,8 +93,8 @@ importTree :: ParsedRemoteConfig -> Bool
 importTree = fromMaybe False . getRemoteConfigValue importTreeField
 
 {- Parsers for fields that are common to all special remotes. -}
-commonFieldsParser :: [RemoteConfigParser]
-commonFieldsParser =
+commonFieldParsers :: [RemoteConfigFieldParser]
+commonFieldParsers =
 	[ optionalStringParser nameField
 	, optionalStringParser sameasNameField
 	, optionalStringParser sameasUUIDField
@@ -166,11 +166,13 @@ getRemoteConfigValue f m = case M.lookup f m of
 			]
 	Nothing -> Nothing
 
-parseRemoteConfig :: RemoteConfig -> [RemoteConfigParser] -> Either String ParsedRemoteConfig
-parseRemoteConfig c ps =
-	go [] (M.filterWithKey notaccepted c) (ps ++ commonFieldsParser)
+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'))
@@ -179,19 +181,22 @@ parseRemoteConfig c ps =
 		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))
+
 	notaccepted (Proposed _) _ = True
 	notaccepted (Accepted _) _ = False
 
-optionalStringParser :: RemoteConfigField -> RemoteConfigParser
+optionalStringParser :: RemoteConfigField -> RemoteConfigFieldParser
 optionalStringParser f = (f, p)
   where
 	p (Just v) _c = Right (Just (RemoteConfigValue (fromProposedAccepted v)))
 	p Nothing _c = Right Nothing
 
-yesNoParser :: RemoteConfigField -> Bool -> RemoteConfigParser
+yesNoParser :: RemoteConfigField -> Bool -> RemoteConfigFieldParser
 yesNoParser = genParser yesNo "yes or no"
 
-trueFalseParser :: RemoteConfigField -> Bool -> RemoteConfigParser
+trueFalseParser :: RemoteConfigField -> Bool -> RemoteConfigFieldParser
 trueFalseParser = genParser Git.Config.isTrueFalse "true or false"
 
 genParser
@@ -200,7 +205,7 @@ genParser
 	-> String -- ^ description of the value
 	-> RemoteConfigField
 	-> t -- ^ fallback value
-	-> RemoteConfigParser
+	-> RemoteConfigFieldParser
 genParser parse desc f fallback = (f, p)
   where
 	p Nothing _c = Right (Just (RemoteConfigValue fallback))

Creds.hs

@@ -1,6 +1,6 @@
 {- Credentials storage
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -30,7 +30,7 @@ import Utility.FileMode
 import Crypto
 import Types.Remote (RemoteConfig, RemoteConfigField)
 import Types.ProposedAccepted
-import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher, encryptionConfigParser)
+import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher, parseEncryptionConfig)
 import Utility.Env (getEnv)
 
 import qualified Data.ByteString.Lazy.Char8 as L
@@ -79,8 +79,7 @@ setRemoteCredPair encsetup c gc storage mcreds = case mcreds of
 	storeconfig creds key Nothing =
 		return $ M.insert key (Accepted (toB64 $ encodeCredPair creds)) c
 	
-	pc = either (const mempty) id
-		(parseRemoteConfig c encryptionConfigParser)
+	pc = either (const mempty) id (parseEncryptionConfig c)
 
 {- Gets a remote's credpair, from the environment if set, otherwise
  - from the cache in gitAnnexCredsDir, or failing that, from the

Remote/Directory.hs

@@ -42,7 +42,8 @@ remote = specialRemoteType $ RemoteType
 	{ typename = "directory"
 	, enumerate = const (findSpecialRemotes "directory")
 	, generate = gen
-	, configParser = [optionalStringParser directoryField]
+	, configParser = mkRemoteConfigParser
+		[optionalStringParser directoryField]
 	, setup = directorySetup
 	, exportSupported = exportIsSupported
 	, importSupported = importIsSupported

Remote/GCrypt.hs

@@ -66,7 +66,8 @@ remote = specialRemoteType $ RemoteType
 	-- and will call our gen on them.
 	, enumerate = const (return [])
 	, generate = gen
-	, configParser = [optionalStringParser gitRepoField]
+	, configParser = mkRemoteConfigParser
+		[optionalStringParser gitRepoField]
 	, setup = gCryptSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
@@ -104,8 +105,9 @@ gen baser u c gc rs = do
 		v <- M.lookup u' <$> readRemoteLog
 		case (Git.remoteName baser, v) of
 			(Just remotename, Just c') -> do
-				pc <- either giveup return $
-					parseRemoteConfig c' (configParser remote)
+				pc <- either giveup return
+					. parseRemoteConfig c'
+					=<< configParser remote
 				setGcryptEncryption pc remotename
 				storeUUIDIn (remoteConfig baser "uuid") u'
 				setConfig (Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
@@ -214,8 +216,8 @@ gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup gitRepoField c
 				| Git.repoLocation r == url -> noop
 				| otherwise -> error "Another remote with the same name already exists."		
 
-		pc <- either giveup return $
-			parseRemoteConfig c' (configParser remote)
+		pc <- either giveup return . parseRemoteConfig c'
+			=<< configParser remote
 		setGcryptEncryption pc remotename
 
 		{- Run a git fetch and a push to the git repo in order to get

Remote/Git.hs

@@ -80,7 +80,8 @@ remote = RemoteType
 	{ typename = "git"
 	, enumerate = list
 	, generate = gen
-	, configParser = [optionalStringParser locationField]
+	, configParser = mkRemoteConfigParser
+		[optionalStringParser locationField]
 	, setup = gitSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported

Remote/GitLFS.hs

@@ -60,7 +60,8 @@ remote = specialRemoteType $ RemoteType
 	-- and will call our gen on them.
 	, enumerate = const (return [])
 	, generate = gen
-	, configParser = [optionalStringParser urlField]
+	, configParser = mkRemoteConfigParser
+		[optionalStringParser urlField]
 	, setup = mySetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
@@ -133,7 +134,7 @@ mySetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	(c', _encsetup) <- encryptionSetup c gc
-	pc <- either giveup return $ parseRemoteConfig c' (configParser remote)
+	pc <- either giveup return . parseRemoteConfig c' =<< configParser remote
 	case (isEncrypted pc, Git.GCrypt.urlPrefix `isPrefixOf` url) of
 		(False, False) -> noop
 		(True, True) -> Remote.GCrypt.setGcryptEncryption pc remotename

Remote/Helper/Chunked.hs

@@ -10,7 +10,7 @@ module Remote.Helper.Chunked (
 	ChunkConfig(..),
 	noChunks,
 	describeChunkConfig,
-	chunkConfigParser,
+	chunkConfigParsers,
 	getChunkConfig,
 	storeChunks,
 	removeChunks,
@@ -49,8 +49,8 @@ noChunks :: ChunkConfig -> Bool
 noChunks NoChunks = True
 noChunks _ = False
 
-chunkConfigParser :: [RemoteConfigParser]
-chunkConfigParser =
+chunkConfigParsers :: [RemoteConfigFieldParser]
+chunkConfigParsers =
 	[ optionalStringParser chunksizeField
 	, optionalStringParser chunkField
 	]

Remote/Helper/Encryptable.hs

@@ -12,7 +12,7 @@ module Remote.Helper.Encryptable (
 	encryptionSetup,
 	noEncryptionUsed,
 	encryptionAlreadySetup,
-	encryptionConfigParser,
+	encryptionConfigParsers,
 	parseEncryptionConfig,
 	remoteCipher,
 	remoteCipher',
@@ -51,8 +51,8 @@ noEncryptionUsed = NoEncryption
 encryptionAlreadySetup :: EncryptionIsSetup
 encryptionAlreadySetup = EncryptionIsSetup
 
-encryptionConfigParser :: [RemoteConfigParser]
-encryptionConfigParser =
+encryptionConfigParsers :: [RemoteConfigFieldParser]
+encryptionConfigParsers =
 	[ (encryptionField, \v c -> Just  . RemoteConfigValue <$> parseEncryptionMethod (fmap fromProposedAccepted v) c)
 	, optionalStringParser cipherField
 	, optionalStringParser cipherkeysField
@@ -66,11 +66,13 @@ encryptionConfigParser =
 	]
 
 encryptionConfigs :: S.Set RemoteConfigField
-encryptionConfigs = S.fromList (map fst encryptionConfigParser)
+encryptionConfigs = S.fromList (map fst encryptionConfigParsers)
 
 -- Parse only encryption fields, ignoring all others.
 parseEncryptionConfig :: RemoteConfig -> Either String ParsedRemoteConfig
-parseEncryptionConfig c = parseRemoteConfig (M.restrictKeys c encryptionConfigs) encryptionConfigParser
+parseEncryptionConfig c = parseRemoteConfig
+	(M.restrictKeys c encryptionConfigs)
+	(RemoteConfigParser encryptionConfigParsers False)
 
 parseEncryptionMethod :: Maybe String -> RemoteConfig -> Either String EncryptionMethod
 parseEncryptionMethod (Just "none") _ = Right NoneEncryption

Remote/Helper/ExportImport.hs

@@ -77,9 +77,10 @@ adjustExportImportRemoteType rt = rt
 	, configParser = configparser
 	}
   where
-	configparser = configParser rt ++ exportImportConfigParser
+	configparser = addRemoteConfigParser exportImportConfigParsers 
+		<$> configParser rt
 	setup' st mu cp c gc = do
-		pc <- either giveup return $ parseRemoteConfig c configparser
+		pc <- either giveup return . parseRemoteConfig c =<< configparser
 		let checkconfig supported configured configfield cont =
 			ifM (supported rt pc gc)
 				( case st of
@@ -87,9 +88,9 @@ adjustExportImportRemoteType rt = rt
 						| configured pc && isEncrypted pc ->
 							giveup $ "cannot enable both encryption and " ++ fromProposedAccepted configfield
 						| otherwise -> cont
-					Enable oldc ->
-						let oldpc = either mempty id $ parseRemoteConfig oldc configparser
-						in if configured pc /= configured oldpc
+					Enable oldc -> do
+						oldpc <- either mempty id . parseRemoteConfig oldc <$> configparser
+						if configured pc /= configured oldpc
 							then giveup $ "cannot change " ++ fromProposedAccepted configfield ++ " of existing special remote"
 							else cont
 				, if configured pc
@@ -102,8 +103,8 @@ adjustExportImportRemoteType rt = rt
 					then giveup "cannot enable importtree=yes without also enabling exporttree=yes"
 					else setup rt st mu cp c gc
 
-exportImportConfigParser :: [RemoteConfigParser]
-exportImportConfigParser =
+exportImportConfigParsers :: [RemoteConfigFieldParser]
+exportImportConfigParsers =
 	[ yesNoParser exportTreeField False
 	, yesNoParser importTreeField False
 	]

Remote/Helper/Special.hs

@@ -28,7 +28,6 @@ module Remote.Helper.Special (
 	retreiveKeyFileDummy,
 	removeKeyDummy,
 	checkPresentDummy,
-	specialRemoteConfigParser,
 	SpecialRemoteCfg(..),
 	specialRemoteCfg,
 	specialRemoteType,
@@ -170,11 +169,12 @@ specialRemoteCfg c = SpecialRemoteCfg (getChunkConfig c) True
 -- Modifies a base RemoteType to support chunking and encryption configs.
 specialRemoteType :: RemoteType -> RemoteType
 specialRemoteType r = r 
-	{ configParser = configParser r ++ specialRemoteConfigParser
+	{ configParser = addRemoteConfigParser specialRemoteConfigParsers
+		<$> configParser r
 	}
 
-specialRemoteConfigParser :: [RemoteConfigParser]
-specialRemoteConfigParser = chunkConfigParser ++ encryptionConfigParser
+specialRemoteConfigParsers :: [RemoteConfigFieldParser]
+specialRemoteConfigParsers = chunkConfigParsers ++ encryptionConfigParsers
 
 -- Modifies a base Remote to support both chunking and encryption,
 -- which special remotes typically should support.

Remote/List.hs

@@ -122,7 +122,7 @@ remoteGen m t g = do
 	let cu = fromMaybe u $ remoteAnnexConfigUUID gc
 	let rs = RemoteStateHandle cu
 	let c = fromMaybe M.empty $ M.lookup cu m
-	let pc = either mempty id (parseRemoteConfig c (configParser t))
+	pc <- either mempty id . parseRemoteConfig c <$> configParser t
 	generate t g u pc gc rs >>= \case
 		Nothing -> return Nothing
 		Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r)) rs

Remote/P2P.hs

@@ -36,7 +36,7 @@ remote = RemoteType
 	-- and will call chainGen on them.
 	, enumerate = const (return [])
 	, generate = \_ _ _ _ _ -> return Nothing
-	, configParser = []
+	, configParser = mkRemoteConfigParser []
 	, setup = error "P2P remotes are set up using git-annex p2p"
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported

Remote/Rsync.hs

@@ -51,7 +51,7 @@ remote = specialRemoteType $ RemoteType
 	{ typename = "rsync"
 	, enumerate = const (findSpecialRemotes "rsyncurl")
 	, generate = gen
-	, configParser =
+	, configParser = mkRemoteConfigParser
 		[ yesNoParser shellEscapeField True
 		, optionalStringParser rsyncUrlField
 		]

Remote/Web.hs

@@ -27,7 +27,7 @@ remote = RemoteType
 	{ typename = "web"
 	, enumerate = list
 	, generate = gen
-	, configParser = []
+	, configParser = mkRemoteConfigParser []
 	, setup = error "not supported"
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported

Types/Remote.hs

@@ -60,7 +60,7 @@ data RemoteTypeA a = RemoteType
 	-- generates a remote of this type
 	, generate :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> a (Maybe (RemoteA a))
 	-- parse configs of remotes of this type
-	, configParser :: [RemoteConfigParser]
+	, configParser :: a RemoteConfigParser
 	-- initializes or enables a remote
 	, setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID)
 	-- check if a remote of this type is able to support export

Types/RemoteConfig.hs

@@ -37,4 +37,15 @@ data RemoteConfigValue where
  - Presence of fields that are not included in this list will cause
  - a parse failure.
  -}
-type RemoteConfigParser = (RemoteConfigField, Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue))
+type RemoteConfigFieldParser = (RemoteConfigField, Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue))
+
+data RemoteConfigParser = RemoteConfigParser
+	{ remoteConfigFieldParsers :: [RemoteConfigFieldParser]
+	, remoteConfigRestPassthrough :: Bool
+	}
+
+mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> m RemoteConfigParser
+mkRemoteConfigParser l = pure (RemoteConfigParser l False)
+
+addRemoteConfigParser :: [RemoteConfigFieldParser] -> RemoteConfigParser -> RemoteConfigParser
+addRemoteConfigParser l rpc = rpc { remoteConfigFieldParsers = remoteConfigFieldParsers rpc ++ l }