separate RemoteConfig parsing basically working

Many special remotes are not updated yet and are commented out.

Annex/Drop.hs

@@ -16,7 +16,7 @@ import qualified Remote
 import qualified Command.Drop
 import Command
 import Annex.Wanted
-import Config
+import Annex.SpecialRemote.Config
 import qualified Database.Keys
 import Git.FilePath
 

Annex/Import.hs

@@ -8,7 +8,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Annex.Import (
-	importTree,
 	ImportTreeConfig(..),
 	ImportCommitConfig(..),
 	buildImportCommit,
@@ -37,7 +36,6 @@ import Annex.Export
 import Annex.RemoteTrackingBranch
 import Command
 import Backend
-import Config
 import Types.Key
 import Types.KeySource
 import Messages.Progress

Annex/SpecialRemote/Config.hs

@@ -1,19 +1,27 @@
 {- git-annex special remote configuration
  -
- - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Annex.SpecialRemote.Config where
 
 import Common
 import Types.Remote (RemoteConfigField, RemoteConfig)
 import Types.UUID
 import Types.ProposedAccepted
+import Types.RemoteConfig
+import Config
+import qualified Git.Config
 
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Data.Typeable
+import GHC.Stack
 
 newtype Sameas t = Sameas t
 	deriving (Show)
@@ -34,6 +42,9 @@ lookupName :: RemoteConfig -> Maybe String
 lookupName c = fmap fromProposedAccepted $
 	M.lookup nameField c <|> M.lookup sameasNameField c
 
+instance RemoteNameable RemoteConfig where
+	getRemoteName c = fromMaybe "" (lookupName c)
+
 {- The uuid that a sameas remote is the same as is stored in this key. -}
 sameasUUIDField :: RemoteConfigField
 sameasUUIDField = Accepted "sameas-uuid"
@@ -75,6 +86,22 @@ exportTreeField = Accepted "exporttree"
 importTreeField :: RemoteConfigField
 importTreeField = Accepted "importtree"
 
+exportTree :: ParsedRemoteConfig -> Bool
+exportTree = fromMaybe False . getRemoteConfigValue exportTreeField
+
+importTree :: ParsedRemoteConfig -> Bool
+importTree = fromMaybe False . getRemoteConfigValue importTreeField
+
+{- Parsers for fields that are common to all special remotes. -}
+commonFieldsParser :: [RemoteConfigParser]
+commonFieldsParser =
+	[ optionalStringParser nameField
+	, optionalStringParser sameasNameField
+	, optionalStringParser sameasUUIDField
+	, optionalStringParser typeField
+	, trueFalseParser autoEnableField False
+	]
+
 {- A remote with sameas-uuid set will inherit these values from the config
  - of that uuid. These values cannot be overridden in the remote's config. -}
 sameasInherits :: S.Set RemoteConfigField
@@ -124,3 +151,63 @@ findByRemoteConfig matching = map sameasuuid . filter (matching . snd) . M.toLis
 	sameasuuid (u, c) = case M.lookup sameasUUIDField c of
 		Nothing -> (u, c, Nothing)
 		Just u' -> (toUUID (fromProposedAccepted u'), c, Just (ConfigFrom u))
+
+{- Extracts a value from ParsedRemoteConfig. -}
+getRemoteConfigValue :: HasCallStack => Typeable v => RemoteConfigField -> ParsedRemoteConfig -> Maybe v
+getRemoteConfigValue f m = case M.lookup f m of
+	Just (RemoteConfigValue v) -> case cast v of
+		Just v' -> Just v'
+		Nothing -> error $ unwords
+			[ "getRemoteConfigValue"
+			, fromProposedAccepted f
+			, "found value of unexpected type"
+			, show (typeOf v) ++ "."
+			, "This is a bug in git-annex!"
+			]
+	Nothing -> Nothing
+
+parseRemoteConfig :: RemoteConfig -> [RemoteConfigParser] -> Either String ParsedRemoteConfig
+parseRemoteConfig c ps =
+	go [] (M.filterWithKey notaccepted c) (ps ++ commonFieldsParser)
+  where
+	go l c' []
+		| M.null c' = Right (M.fromList l)
+		| otherwise = Left $ "Unexpected fields: " ++
+			unwords (map fromProposedAccepted (M.keys c'))
+	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
+	notaccepted (Proposed _) _ = True
+	notaccepted (Accepted _) _ = False
+
+optionalStringParser :: RemoteConfigField -> RemoteConfigParser
+optionalStringParser f = (f, p)
+  where
+	p (Just v) _c = Right (Just (RemoteConfigValue (fromProposedAccepted v)))
+	p Nothing _c = Right Nothing
+
+yesNoParser :: RemoteConfigField -> Bool -> RemoteConfigParser
+yesNoParser = genParser yesNo "yes or no"
+
+trueFalseParser :: RemoteConfigField -> Bool -> RemoteConfigParser
+trueFalseParser = genParser Git.Config.isTrueFalse "true or false"
+
+genParser
+	:: Typeable t
+	=> (String -> Maybe t)
+	-> String -- ^ description of the value
+	-> RemoteConfigField
+	-> t -- ^ fallback value
+	-> RemoteConfigParser
+genParser parse desc f fallback = (f, p)
+  where
+	p Nothing _c = Right (Just (RemoteConfigValue fallback))
+	p (Just v) _c = case parse (fromProposedAccepted v) of
+		Just b -> Right (Just (RemoteConfigValue b))
+		Nothing -> case v of
+			Accepted _ -> Right (Just (RemoteConfigValue fallback))
+			Proposed _ -> Left $
+				"Bad value for " ++ fromProposedAccepted f ++
+				" (expected " ++ desc ++ ")"

Command/Sync.hs

@@ -43,6 +43,7 @@ import Git.FilePath
 import qualified Remote.Git
 import Config
 import Config.GitConfig
+import Annex.SpecialRemote.Config
 import Config.DynamicConfig
 import Config.Files
 import Annex.Wanted

Command/TestRemote.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2014-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -25,8 +25,11 @@ import Utility.CopyFile
 import Types.Messages
 import Types.Export
 import Types.ProposedAccepted
+import Types.Crypto
+import Types.RemoteConfig
 import Remote.Helper.ExportImport
 import Remote.Helper.Chunked
+import Remote.Helper.Encryptable (describeEncryption)
 import Git.Types
 
 import Test.Tasty
@@ -110,7 +113,7 @@ perform rs unavailrs exportr ks = do
 	desc r' k = intercalate "; " $ map unwords
 		[ [ "key size", show (fromKey keySize k) ]
 		, [ show (getChunkConfig (Remote.config r')) ]
-		, ["encryption", maybe "none" fromProposedAccepted (M.lookup (Accepted "encryption") (Remote.config r'))]
+		, ["encryption", describeEncryption (Remote.config r')]
 		]
 	descexport k1 k2 = intercalate "; " $ map unwords
 		[ [ "exporttree=yes" ]
@@ -120,16 +123,17 @@ perform rs unavailrs exportr ks = do
 
 adjustChunkSize :: Remote -> Int -> Annex (Maybe Remote)
 adjustChunkSize r chunksize = adjustRemoteConfig r
-	(M.insert (Proposed "chunk") (Proposed (show chunksize)))
+	(M.insert (Proposed "chunk") (RemoteConfigValue (show chunksize)))
 
 -- Variants of a remote with no encryption, and with simple shared
 -- encryption. Gpg key based encryption is not tested.
 encryptionVariants :: Remote -> Annex [Remote]
 encryptionVariants r = do
-	noenc <- adjustRemoteConfig r (M.insert (Proposed "encryption") (Proposed "none"))
+	noenc <- adjustRemoteConfig r $
+		M.insert (Proposed "encryption") (RemoteConfigValue NoneEncryption)
 	sharedenc <- adjustRemoteConfig r $
-		M.insert (Proposed "encryption") (Proposed "shared") .
-		M.insert (Proposed "highRandomQuality") (Proposed "false")
+		M.insert (Proposed "encryption") (RemoteConfigValue SharedEncryption) .
+		M.insert (Proposed "highRandomQuality") (RemoteConfigValue False)
 	return $ catMaybes [noenc, sharedenc]
 
 -- Variant of a remote with exporttree disabled.
@@ -141,13 +145,13 @@ disableExportTree r = maybe (error "failed disabling exportree") return
 exportTreeVariant :: Remote -> Annex (Maybe Remote)
 exportTreeVariant r = ifM (Remote.isExportSupported r)
 	( adjustRemoteConfig r $
-		M.insert (Proposed "encryption") (Proposed "none") . 
-		M.insert (Proposed "exporttree") (Proposed "yes")
+		M.insert (Proposed "encryption") (RemoteConfigValue NoneEncryption) . 
+		M.insert (Proposed "exporttree") (RemoteConfigValue True)
 	, return Nothing
 	)
 
 -- Regenerate a remote with a modified config.
-adjustRemoteConfig :: Remote -> (Remote.RemoteConfig -> Remote.RemoteConfig) -> Annex (Maybe Remote)
+adjustRemoteConfig :: Remote -> (Remote.ParsedRemoteConfig -> Remote.ParsedRemoteConfig) -> Annex (Maybe Remote)
 adjustRemoteConfig r adjustconfig = do
 	repo <- Remote.getRepo r
 	Remote.generate (Remote.remotetype r)

Config.hs

@@ -20,10 +20,7 @@ import Config.DynamicConfig
 import Types.Availability
 import Git.Types
 import qualified Types.Remote as Remote
-import qualified Annex.SpecialRemote.Config as SpecialRemote
-import Types.ProposedAccepted
 
-import qualified Data.Map as M
 import qualified Data.ByteString as S
 
 type UnqualifiedConfigKey = S.ByteString
@@ -65,9 +62,6 @@ instance RemoteNameable RemoteName where
 instance RemoteNameable Remote where
 	getRemoteName = Remote.name
 
-instance RemoteNameable Remote.RemoteConfig where
-	getRemoteName c = fromMaybe "" (SpecialRemote.lookupName c)
-
 {- A per-remote config setting in git config. -}
 remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
 remoteConfig r key = ConfigKey $
@@ -112,14 +106,6 @@ setCrippledFileSystem b = do
 	setConfig (annexConfig "crippledfilesystem") (Git.Config.boolConfig b)
 	Annex.changeGitConfig $ \c -> c { annexCrippledFileSystem = b }
 
-exportTree :: Remote.RemoteConfig -> Bool
-exportTree c = fromMaybe False $ yesNo . fromProposedAccepted
-	=<< M.lookup SpecialRemote.exportTreeField c
-
-importTree :: Remote.RemoteConfig -> Bool
-importTree c = fromMaybe False $ yesNo . fromProposedAccepted
-	=<< M.lookup SpecialRemote.importTreeField c
-
 yesNo :: String -> Maybe Bool
 yesNo "yes" = Just True
 yesNo "no" = Just False

Config/RemoteConfig.hs

@@ -1,44 +0,0 @@
-{- git-annex remote config parsing
- -
- - Copyright 2020 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU AGPL version 3 or higher.
- -}
-
-module Config.RemoteConfig where
-
-import qualified Data.Map as M
-import Data.Typeable
-
-import Types.RemoteConfig
-import Types.ProposedAccepted
-import Config
-
-parseRemoteConfig :: RemoteConfig -> [RemoteConfigParser] -> Either String ParsedRemoteConfig
-parseRemoteConfig c = go [] (M.filterWithKey notaccepted c)
-  where
-	go l c' []
-		| M.null c' = Right (M.fromList l)
-		| otherwise = Left $ "Unexpected fields: " ++
-			unwords (map fromProposedAccepted (M.keys c'))
-	go l c' ((f, p):rest) = do
-		v <- p (M.lookup f c) c
-		go ((f,v):l) (M.delete f c') rest
-	notaccepted (Proposed _) _ = True
-	notaccepted (Accepted _) _ = False
-
-yesNoParser :: RemoteConfigField -> Bool -> RemoteConfigParser
-yesNoParser f fallback = (f, p)
-  where
-	p v _c = case v of
-		Nothing -> Right (RemoteConfigValue fallback)
-		Just v' -> case yesNo (fromProposedAccepted v') of
-			Just b -> Right (RemoteConfigValue b)
-			Nothing -> case v' of
-				Accepted _ -> Right (RemoteConfigValue fallback)
-				Proposed _ -> Left $
-					"bad " ++ fromProposedAccepted f ++
-					" value (expected yes or no)"
-
-optStringParser :: RemoteConfigField -> RemoteConfigParser
-optStringParser f = (f, \v _c -> Right (RemoteConfigValue v))

Creds.hs

@@ -24,7 +24,7 @@ import Annex.Common
 import qualified Annex
 import Types.Creds
 import Types.RemoteConfig
-import Config.RemoteConfig
+import Annex.SpecialRemote.Config
 import Annex.Perms
 import Utility.FileMode
 import Crypto

Crypto.hs

@@ -39,7 +39,6 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import Data.ByteString.UTF8 (fromString)
 import Control.Monad.IO.Class
-import Data.Typeable
 
 import Annex.Common
 import qualified Utility.Gpg as Gpg
@@ -48,14 +47,6 @@ import Types.Remote
 import Types.Key
 import Annex.SpecialRemote.Config
 
-data EncryptionMethod
-	= NoneEncryption
-	| SharedEncryption
-	| PubKeyEncryption
-	| SharedPubKeyEncryption
-	| HybridEncryption
-	deriving (Typeable, Eq)
-
 {- The beginning of a Cipher is used for MAC'ing; the remainder is used
  - as the GPG symmetric encryption passphrase when using the hybrid
  - scheme. Note that the cipher itself is base-64 encoded, hence the

Remote/Directory.hs

@@ -1,6 +1,6 @@
 {- A "remote" that is just a filesystem directory.
  -
- - 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.
  -}
@@ -24,6 +24,7 @@ import Types.Creds
 import qualified Git
 import Config.Cost
 import Config
+import Annex.SpecialRemote.Config
 import Utility.FileMode
 import Remote.Helper.Special
 import Remote.Helper.ExportImport
@@ -37,16 +38,20 @@ import Utility.InodeCache
 import Types.ProposedAccepted
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "directory"
 	, enumerate = const (findSpecialRemotes "directory")
 	, generate = gen
+	, configParser = [optionalStringParser directoryField]
 	, setup = directorySetup
 	, exportSupported = exportIsSupported
 	, importSupported = importIsSupported
 	}
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+directoryField :: RemoteConfigField
+directoryField = Accepted "directory"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = do
 	cst <- remoteCost gc cheapRemoteCost
 	let chunkconfig = getChunkConfig c
@@ -113,7 +118,7 @@ directorySetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let dir = maybe (giveup "Specify directory=") fromProposedAccepted $
-		M.lookup (Accepted "directory") c
+		M.lookup directoryField c
 	absdir <- liftIO $ absPath dir
 	liftIO $ unlessM (doesDirectoryExist absdir) $
 		giveup $ "Directory does not exist: " ++ absdir
@@ -122,7 +127,7 @@ directorySetup _ mu _ c gc = do
 	-- The directory is stored in git config, not in this remote's
 	-- persistant state, so it can vary between hosts.
 	gitConfigSpecialRemote u c' [("directory", absdir)]
-	return (M.delete (Accepted "directory") c', u)
+	return (M.delete directoryField c', u)
 
 {- Locations to try to access a given Key in the directory.
  - We try more than one since we used to write to different hash

Remote/GCrypt.hs

@@ -39,6 +39,7 @@ import qualified Git.Construct
 import qualified Annex.Branch
 import Config
 import Config.Cost
+import Annex.SpecialRemote.Config
 import Remote.Helper.Git
 import Remote.Helper.Encryptable
 import Remote.Helper.Special
@@ -59,18 +60,22 @@ import Messages.Progress
 import Types.ProposedAccepted
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "gcrypt"
 	-- Remote.Git takes care of enumerating gcrypt remotes too,
 	-- and will call our gen on them.
 	, enumerate = const (return [])
 	, generate = gen
+	, configParser = [optionalStringParser gitRepoField]
 	, setup = gCryptSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}
 
-chainGen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+gitRepoField :: RemoteConfigField
+gitRepoField = Accepted "gitrepo"
+
+chainGen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 chainGen gcryptr u c gc rs = do
 	g <- gitRepo
 	-- get underlying git repo with real path, not gcrypt path
@@ -78,7 +83,7 @@ chainGen gcryptr u c gc rs = do
 	let r' = r { Git.remoteName = Git.remoteName gcryptr }
 	gen r' u c gc rs
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen baser u c gc rs = do
 	-- doublecheck that cache matches underlying repo's gcrypt-id
 	-- (which might not be set), only for local repos
@@ -99,15 +104,17 @@ gen baser u c gc rs = do
 		v <- M.lookup u' <$> readRemoteLog
 		case (Git.remoteName baser, v) of
 			(Just remotename, Just c') -> do
-				setGcryptEncryption c' remotename
+				pc <- either giveup return $
+					parseRemoteConfig c' (configParser remote)
+				setGcryptEncryption pc remotename
 				storeUUIDIn (remoteConfig baser "uuid") u'
 				setConfig (Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
-				gen' r u' c' gc rs
+				gen' r u' pc gc rs
 			_ -> do
 				warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r
 				return Nothing
 
-gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+gen' :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen' r u c gc rs = do
 	cst <- remoteCost gc $
 		if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
@@ -188,7 +195,7 @@ unsupportedUrl :: a
 unsupportedUrl = giveup "using non-ssh remote repo url with gcrypt is not supported"
 
 gCryptSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup (Accepted "gitrepo") c
+gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup gitRepoField c
   where
 	remotename = fromJust (lookupName c)
 	go Nothing = giveup "Specify gitrepo="
@@ -207,7 +214,9 @@ gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup (Accepted "gitr
 				| Git.repoLocation r == url -> noop
 				| otherwise -> error "Another remote with the same name already exists."		
 
-		setGcryptEncryption c' remotename
+		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
 		 - its gcrypt-id set up, so that later git annex commands
@@ -323,7 +332,7 @@ shellOrRsync r ashell arsync
  - Also, sets gcrypt-publish-participants to avoid unncessary gpg
  - passphrase prompts.
  -}
-setGcryptEncryption :: RemoteConfig -> String -> Annex ()
+setGcryptEncryption :: ParsedRemoteConfig -> String -> Annex ()
 setGcryptEncryption c remotename = do
 	let participants = remoteconfig Git.GCrypt.remoteParticipantConfigKey
 	case extractCipher c of

Remote/Git.hs

@@ -37,6 +37,7 @@ import qualified Annex.SpecialRemote.Config as SpecialRemote
 import Utility.Tmp
 import Config
 import Config.Cost
+import Annex.SpecialRemote.Config
 import Config.DynamicConfig
 import Annex.Init
 import Types.CleanupActions
@@ -79,11 +80,15 @@ remote = RemoteType
 	{ typename = "git"
 	, enumerate = list
 	, generate = gen
+	, configParser = [optionalStringParser locationField]
 	, setup = gitSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}
 
+locationField :: RemoteConfigField
+locationField = Accepted "location"
+
 list :: Bool -> Annex [Git.Repo]
 list autoinit = do
 	c <- fromRepo Git.config
@@ -113,7 +118,7 @@ gitSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> Remote
 gitSetup Init mu _ c _ = do
 	let location = fromMaybe (giveup "Specify location=url") $
 		Url.parseURIRelaxed . fromProposedAccepted
-			=<< M.lookup (Accepted "location") c
+			=<< M.lookup locationField c
 	rs <- Annex.getGitRemotes
 	u <- case filter (\r -> Git.location r == Git.Url location) rs of
 		[r] -> getRepoUUID r
@@ -127,7 +132,7 @@ gitSetup (Enable _) (Just u) _ c _ = do
 		[ Param "remote"
 		, Param "add"
 		, Param $ fromMaybe (giveup "no name") (SpecialRemote.lookupName c)
-		, Param $ maybe (giveup "no location") fromProposedAccepted (M.lookup (Accepted "location") c)
+		, Param $ maybe (giveup "no location") fromProposedAccepted (M.lookup locationField c)
 		]
 	return (c, u)
 gitSetup (Enable _) Nothing _ _ _ = error "unable to enable git remote with no specified uuid"
@@ -153,7 +158,7 @@ configRead autoinit r = do
 			Just r' -> return r'
 		_ -> return r
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs
 	-- Remote.GitLFS may be used with a repo that is also encrypted
 	-- with gcrypt so is checked first.
@@ -204,7 +209,7 @@ gen r u c gc rs
 			, remoteStateHandle = rs
 			}
 
-unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+unavailable :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 unavailable r = gen r'
   where
 	r' = case Git.location r of

Remote/GitLFS.hs

@@ -1,6 +1,6 @@
 {- Using git-lfs as a remote.
  -
- - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -25,6 +25,7 @@ import qualified Git.GCrypt
 import qualified Git.Credential as Git
 import Config
 import Config.Cost
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.ExportImport
 import Remote.Helper.Git
@@ -53,18 +54,22 @@ import qualified Data.Text.Encoding as E
 import qualified Control.Concurrent.MSemN as MSemN
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "git-lfs"
 	-- Remote.Git takes care of enumerating git-lfs remotes too,
 	-- and will call our gen on them.
 	, enumerate = const (return [])
 	, generate = gen
+	, configParser = [optionalStringParser urlField]
 	, setup = mySetup
 	, exportSupported = exportUnsupported
 	, 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 = do
 	-- If the repo uses gcrypt, get the underlaying repo without the
 	-- gcrypt url, to do LFS endpoint discovery on.
@@ -128,9 +133,10 @@ mySetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	(c', _encsetup) <- encryptionSetup c gc
-	case (isEncrypted c', Git.GCrypt.urlPrefix `isPrefixOf` url) of
+	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 c' remotename
+		(True, True) -> Remote.GCrypt.setGcryptEncryption pc remotename
 		(True, False) -> unlessM (Annex.getState Annex.force) $
 			giveup $ unwords $
 				[ "Encryption is enabled for this remote,"
@@ -160,7 +166,7 @@ mySetup _ mu _ c gc = do
 	return (c', u)
   where
 	url = maybe (giveup "Specify url=") fromProposedAccepted 
-		(M.lookup (Accepted "url") c)
+		(M.lookup urlField c)
 	remotename = fromJust (lookupName c)
 
 {- Check if a remote's url is one known to belong to a git-lfs repository.
@@ -180,7 +186,7 @@ configKnownUrl r
 		t <- fromProposedAccepted
 			<$> M.lookup Annex.SpecialRemote.Config.typeField c
 		u <- fromProposedAccepted
-			<$> M.lookup (Accepted "url") c
+			<$> M.lookup urlField c
 		let u' = Git.Remote.parseRemoteLocation u g
 		return $ Git.Remote.RemoteUrl (Git.repoLocation r) == u' 
 			&& t == typename remote

Remote/Helper/Chunked.hs

@@ -28,7 +28,6 @@ import Utility.Metered
 import Crypto (EncKey)
 import Backend (isStableKey)
 import Annex.SpecialRemote.Config
-import Config.RemoteConfig
 
 import qualified Data.ByteString.Lazy as L
 
@@ -52,8 +51,8 @@ noChunks _ = False
 
 chunkConfigParser :: [RemoteConfigParser]
 chunkConfigParser =
-	[ optStringParser chunksizeField
-	, optStringParser chunkField
+	[ optionalStringParser chunksizeField
+	, optionalStringParser chunkField
 	]
 
 getChunkConfig :: ParsedRemoteConfig -> ChunkConfig

Remote/Helper/Encryptable.hs

@@ -13,6 +13,7 @@ module Remote.Helper.Encryptable (
 	noEncryptionUsed,
 	encryptionAlreadySetup,
 	encryptionConfigParser,
+	parseEncryptionConfig,
 	remoteCipher,
 	remoteCipher',
 	embedCreds,
@@ -23,12 +24,12 @@ module Remote.Helper.Encryptable (
 ) where
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 import qualified "sandi" Codec.Binary.Base64 as B64
 import qualified Data.ByteString as B
 
 import Annex.Common
 import Types.Remote
-import Config.RemoteConfig
 import Crypto
 import Types.Crypto
 import Types.ProposedAccepted
@@ -52,18 +53,25 @@ encryptionAlreadySetup = EncryptionIsSetup
 
 encryptionConfigParser :: [RemoteConfigParser]
 encryptionConfigParser =
-	[ (encryptionField, \v c -> RemoteConfigValue <$> parseEncryptionMethod (fmap fromProposedAccepted v) c)
-	, optStringParser cipherField
-	, optStringParser cipherkeysField
-	, optStringParser pubkeysField
+	[ (encryptionField, \v c -> Just  . RemoteConfigValue <$> parseEncryptionMethod (fmap fromProposedAccepted v) c)
+	, optionalStringParser cipherField
+	, optionalStringParser cipherkeysField
+	, optionalStringParser pubkeysField
 	, yesNoParser embedCredsField False
-	, (macField, \v _c -> RemoteConfigValue <$> parseMac v)
-	, optStringParser (Accepted "keyid")
-	, optStringParser (Accepted "keyid+")
-	, optStringParser (Accepted "keyid-")
-	, (Accepted "highRandomQuality", \v _c -> RemoteConfigValue <$> parseHighRandomQuality (fmap fromProposedAccepted v))
+	, (macField, \v _c -> Just . RemoteConfigValue <$> parseMac v)
+	, optionalStringParser (Accepted "keyid")
+	, optionalStringParser (Accepted "keyid+")
+	, optionalStringParser (Accepted "keyid-")
+	, (Accepted "highRandomQuality", \v _c -> Just . RemoteConfigValue <$> parseHighRandomQuality (fmap fromProposedAccepted v))
 	]
 
+encryptionConfigs :: S.Set RemoteConfigField
+encryptionConfigs = S.fromList (map fst encryptionConfigParser)
+
+-- Parse only encryption fields, ignoring all others.
+parseEncryptionConfig :: RemoteConfig -> Either String ParsedRemoteConfig
+parseEncryptionConfig c = parseRemoteConfig (M.restrictKeys c encryptionConfigs) encryptionConfigParser
+
 parseEncryptionMethod :: Maybe String -> RemoteConfig -> Either String EncryptionMethod
 parseEncryptionMethod (Just "none") _ = Right NoneEncryption
 parseEncryptionMethod (Just "shared") _ = Right SharedEncryption
@@ -100,7 +108,7 @@ parseMac (Just (Proposed s)) = case readMac s of
  - could opt to use a shared cipher, which is stored unencrypted. -}
 encryptionSetup :: RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup)
 encryptionSetup c gc = do
-	pc <- either giveup return $ parseRemoteConfig c encryptionConfigParser
+	pc <- either giveup return $ parseEncryptionConfig c
 	cmd <- gpgCmd <$> Annex.getGitConfig
 	maybe (genCipher pc cmd) (updateCipher pc cmd) (extractCipher pc)
   where
@@ -228,7 +236,7 @@ isEncrypted = isJust . extractCipher
 
 describeEncryption :: ParsedRemoteConfig -> String
 describeEncryption c = case extractCipher c of
-	Nothing -> "none"
+	Nothing -> "none" ++ show (getRemoteConfigValue cipherField c :: Maybe String) ++ show (M.keys c)
 	Just cip -> nameCipher cip ++ " (" ++ describeCipher cip ++ ")"
 
 nameCipher :: StorableCipher -> String

Remote/Helper/ExportImport.hs

@@ -20,20 +20,18 @@ import qualified Database.Export as Export
 import qualified Database.ContentIdentifier as ContentIdentifier
 import Annex.Export
 import Annex.LockFile
-import Config
-import Annex.SpecialRemote.Config (exportTreeField, importTreeField)
+import Annex.SpecialRemote.Config
 import Git.Types (fromRef)
 import Logs.Export
 import Logs.ContentIdentifier (recordContentIdentifier)
 
-import qualified Data.Map as M
 import Control.Concurrent.STM
 
 -- | Use for remotes that do not support exports.
 class HasExportUnsupported a where
 	exportUnsupported :: a
 
-instance HasExportUnsupported (RemoteConfig -> RemoteGitConfig -> Annex Bool) where
+instance HasExportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool) where
 	exportUnsupported = \_ _ -> return False
 
 instance HasExportUnsupported (ExportActions Annex) where
@@ -52,7 +50,7 @@ instance HasExportUnsupported (ExportActions Annex) where
 class HasImportUnsupported a where
 	importUnsupported :: a
 
-instance HasImportUnsupported (RemoteConfig -> RemoteGitConfig -> Annex Bool) where
+instance HasImportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool) where
 	importUnsupported = \_ _ -> return False
 
 instance HasImportUnsupported (ImportActions Annex) where
@@ -65,62 +63,67 @@ instance HasImportUnsupported (ImportActions Annex) where
 		, checkPresentExportWithContentIdentifier = \_ _ _ -> return False
 		}
 
-exportIsSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool
+exportIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool
 exportIsSupported = \_ _ -> return True
 
-importIsSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool
+importIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool
 importIsSupported = \_ _ -> return True
 
 -- | Prevent or allow exporttree=yes and importtree=yes when
 -- setting up a new remote, depending on exportSupported and importSupported.
 adjustExportImportRemoteType :: RemoteType -> RemoteType
-adjustExportImportRemoteType rt = rt { setup = setup' }
+adjustExportImportRemoteType rt = rt
+	{ setup = setup'
+	, configParser = configparser
+	}
   where
-	setup' st mu cp c gc =
-		let checkconfig supported configured configfield cont = do
-			case parseProposedAccepted configfield c yesNo False "yes or no" of
-				Right _ -> noop
-				Left err -> giveup err
-			ifM (supported rt c gc)
+	configparser = configParser rt ++ exportImportConfigParser
+	setup' st mu cp c gc = do
+		pc <- either giveup return $ parseRemoteConfig c configparser
+		let checkconfig supported configured configfield cont =
+			ifM (supported rt pc gc)
 				( case st of
 					Init
-						| configured c && isEncrypted c ->
+						| configured pc && isEncrypted pc ->
 							giveup $ "cannot enable both encryption and " ++ fromProposedAccepted configfield
 						| otherwise -> cont
-					Enable oldc
-						| configured c /= configured oldc ->
-							giveup $ "cannot change " ++ fromProposedAccepted configfield ++ " of existing special remote"
-						| otherwise -> cont
-				, if configured c
+					Enable oldc ->
+						let oldpc = either mempty id $ parseRemoteConfig oldc configparser
+						in if configured pc /= configured oldpc
+							then giveup $ "cannot change " ++ fromProposedAccepted configfield ++ " of existing special remote"
+							else cont
+				, if configured pc
 					then giveup $ fromProposedAccepted configfield ++ " is not supported by this special remote"
 					else cont
 				)
-		in checkconfig exportSupported exportTree exportTreeField $
+		checkconfig exportSupported exportTree exportTreeField $
 			checkconfig importSupported importTree importTreeField $
-				if importTree c && not (exportTree c)
+				if importTree pc && not (exportTree pc)
 					then giveup "cannot enable importtree=yes without also enabling exporttree=yes"
 					else setup rt st mu cp c gc
 
+exportImportConfigParser :: [RemoteConfigParser]
+exportImportConfigParser =
+	[ yesNoParser exportTreeField False
+	, yesNoParser importTreeField False
+	]
+
 -- | Adjust a remote to support exporttree=yes and importree=yes.
 --
 -- Note that all remotes with importree=yes also have exporttree=yes.
 adjustExportImport :: Remote -> RemoteStateHandle -> Annex Remote
-adjustExportImport r rs = case M.lookup exportTreeField (config r) of
+adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) of
 	Nothing -> return $ notexport r
-	Just c -> case yesNo (fromProposedAccepted c) of
-		Just True -> ifM (isExportSupported r)
-			( do
-				exportdbv <- prepexportdb
-				r' <- isexport exportdbv
-				if importTree (config r)
-					then isimport r' exportdbv
-					else return r'
-			, return $ notexport r
-			)
-		Just False -> return $ notexport r
-		Nothing -> do
-			warning $ "bad exporttree value for " ++ name r ++ ", assuming not an export"
-			return $ notexport r
+	Just True -> ifM (isExportSupported r)
+		( do
+			exportdbv <- prepexportdb
+			r' <- isexport exportdbv
+			if importTree (config r)
+				then isimport r' exportdbv
+				else return r'
+		, return $ notexport r
+		)
+	Just False -> return $ notexport r
   where
 	notexport r' = notimport r'
 		{ exportActions = exportUnsupported

Remote/Helper/Special.hs

@@ -31,6 +31,7 @@ module Remote.Helper.Special (
 	specialRemoteConfigParser,
 	SpecialRemoteCfg(..),
 	specialRemoteCfg,
+	specialRemoteType,
 	specialRemote,
 	specialRemote',
 	lookupName,
@@ -158,9 +159,6 @@ type RemoteModifier
 	-> Remote
 	-> Remote
 
-specialRemoteConfigParser :: [RemoteConfigParser]
-specialRemoteConfigParser = chunkConfigParser ++ encryptionConfigParser
-
 data SpecialRemoteCfg = SpecialRemoteCfg
 	{ chunkConfig :: ChunkConfig
 	, displayProgress :: Bool
@@ -169,6 +167,15 @@ data SpecialRemoteCfg = SpecialRemoteCfg
 specialRemoteCfg :: ParsedRemoteConfig -> SpecialRemoteCfg
 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
+	}
+
+specialRemoteConfigParser :: [RemoteConfigParser]
+specialRemoteConfigParser = chunkConfigParser ++ encryptionConfigParser
+
 -- Modifies a base Remote to support both chunking and encryption,
 -- which special remotes typically should support.
 -- 

Remote/List.hs

@@ -1,6 +1,6 @@
 {- git-annex remote list
  -
- - 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.
  -}
@@ -20,17 +20,21 @@ import Annex.UUID
 import Remote.Helper.Hooks
 import Remote.Helper.ReadOnly
 import Remote.Helper.ExportImport
+import Annex.SpecialRemote.Config
 import qualified Git
 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
@@ -41,20 +45,26 @@ 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
+-}
 
 remoteTypes :: [RemoteType]
 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
@@ -65,9 +75,12 @@ remoteTypes = map adjustExportImportRemoteType
 	, Remote.Tahoe.remote
 	, Remote.Glacier.remote
 	, Remote.Ddar.remote
+-}
 	, Remote.GitLFS.remote
+{-
 	, Remote.Hook.remote
 	, Remote.External.remote
+-}
 	]
 
 {- Builds a list of all available Remotes.
@@ -109,7 +122,8 @@ remoteGen m t g = do
 	let cu = fromMaybe u $ remoteAnnexConfigUUID gc
 	let rs = RemoteStateHandle cu
 	let c = fromMaybe M.empty $ M.lookup cu m
-	generate t g u c gc rs >>= \case
+	let 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,12 +36,13 @@ remote = RemoteType
 	-- and will call chainGen on them.
 	, enumerate = const (return [])
 	, generate = \_ _ _ _ _ -> return Nothing
+	, configParser = []
 	, setup = error "P2P remotes are set up using git-annex p2p"
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}
 
-chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+chainGen :: P2PAddress -> Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 chainGen addr r u c gc rs = do
 	connpool <- mkConnectionPool
 	cst <- remoteCost gc veryExpensiveRemoteCost

Remote/Rsync.hs

@@ -1,6 +1,6 @@
 {- A remote that is only accessible by rsync.
  -
- - Copyright 2011-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -42,20 +42,31 @@ import Types.Creds
 import Annex.DirHashes
 import Utility.Tmp.Dir
 import Utility.SshHost
+import Annex.SpecialRemote.Config
 
 import qualified Data.Map as M
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "rsync"
 	, enumerate = const (findSpecialRemotes "rsyncurl")
 	, generate = gen
+	, configParser =
+		[ yesNoParser shellEscapeField True
+		, optionalStringParser rsyncUrlField
+		]
 	, setup = rsyncSetup
 	, exportSupported = exportIsSupported
 	, importSupported = importUnsupported
 	}
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+shellEscapeField :: RemoteConfigField
+shellEscapeField = Accepted "shellescape"
+
+rsyncUrlField :: RemoteConfigField
+rsyncUrlField = Accepted "rsyncurl"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs = do
 	cst <- remoteCost gc expensiveRemoteCost
 	(transport, url) <- rsyncTransport gc $
@@ -112,7 +123,7 @@ gen r u c gc rs = do
 		-- Rsync displays its own progress.
 		{ displayProgress = False }
 
-genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> Annex [CommandParam] -> RsyncUrl -> RsyncOpts
+genRsyncOpts :: ParsedRemoteConfig -> RemoteGitConfig -> Annex [CommandParam] -> RsyncUrl -> RsyncOpts
 genRsyncOpts c gc transport url = RsyncOpts
 	{ rsyncUrl = url
 	, rsyncOptions = appendtransport $ opts []
@@ -120,7 +131,7 @@ genRsyncOpts c gc transport url = RsyncOpts
 		opts (remoteAnnexRsyncUploadOptions gc)
 	, rsyncDownloadOptions = appendtransport $
 		opts (remoteAnnexRsyncDownloadOptions gc)
-	, rsyncShellEscape = (yesNo . fromProposedAccepted =<< M.lookup (Accepted "shellescape") c) /= Just False
+	, rsyncShellEscape = fromMaybe True (getRemoteConfigValue shellEscapeField c)
 	}
   where
 	appendtransport l = (++ l) <$> transport
@@ -163,10 +174,7 @@ rsyncSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let url = maybe (giveup "Specify rsyncurl=") fromProposedAccepted $
-		M.lookup (Accepted "rsyncurl") c
-	case parseProposedAccepted (Accepted "shellescape") c yesNo False "yes or no" of
-		Left err -> giveup err
-		_ -> noop
+		M.lookup rsyncUrlField c
 	(c', _encsetup) <- encryptionSetup c gc
 
 	-- The rsyncurl is stored in git config, not only in this remote's

Remote/Web.hs

@@ -27,6 +27,7 @@ remote = RemoteType
 	{ typename = "web"
 	, enumerate = list
 	, generate = gen
+	, configParser = []
 	, setup = error "not supported"
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
@@ -40,7 +41,7 @@ list _autoinit = do
 	r <- liftIO $ Git.Construct.remoteNamed "web" (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

Test.hs

@@ -1614,7 +1614,7 @@ test_crypto = do
 			annexed_present annexedfile
 	{- Ensure the configuration complies with the encryption scheme, and
 	 - that all keys are encrypted properly for the given directory remote. -}
-	testEncryptedRemote scheme ks c keys = case Remote.Helper.Encryptable.extractCipher c of
+	testEncryptedRemote scheme ks c keys = case Remote.Helper.Encryptable.extractCipher pc of
 		Just cip@Crypto.SharedCipher{} | scheme == "shared" && isNothing ks ->
 			checkKeys cip Nothing
 		Just cip@(Crypto.EncryptedCipher encipher v ks')
@@ -1622,6 +1622,8 @@ test_crypto = do
 				checkKeys cip (Just v) <&&> checkCipher encipher ks'
 		_ -> return False
 	  where
+		pc =either mempty id $
+			Remote.Helper.Encryptable.parseEncryptionConfig c
 		keysMatch (Utility.Gpg.KeyIds ks') =
 			maybe False (\(Utility.Gpg.KeyIds ks2) ->
 					sort (nub ks2) == sort (nub ks')) ks
@@ -1630,7 +1632,7 @@ test_crypto = do
 		checkScheme Types.Crypto.PubKey = scheme == "pubkey"
 		checkKeys cip mvariant = do
 			dummycfg <- Types.GitConfig.dummyRemoteGitConfig
-			let encparams = (mempty :: Types.Remote.RemoteConfig, dummycfg)
+			let encparams = (mempty :: Types.Remote.ParsedRemoteConfig, dummycfg)
 			cipher <- Crypto.decryptCipher gpgcmd encparams cip
 			files <- filterM doesFileExist $
 				map ("dir" </>) $ concatMap (serializeKeys cipher) keys

Types/Crypto.hs

@@ -1,11 +1,12 @@
 {- git-annex crypto types
  -
- - Copyright 2011-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
 module Types.Crypto (
+	EncryptionMethod(..),
 	Cipher(..),
 	StorableCipher(..),
 	EncryptedCipherVariant(..),
@@ -21,6 +22,16 @@ module Types.Crypto (
 import Utility.Hash
 import Utility.Gpg (KeyIds(..))
 
+import Data.Typeable
+
+data EncryptionMethod
+	= NoneEncryption
+	| SharedEncryption
+	| PubKeyEncryption
+	| SharedPubKeyEncryption
+	| HybridEncryption
+	deriving (Typeable, Eq)
+
 -- XXX ideally, this would be a locked memory region
 data Cipher = Cipher String | MacOnlyCipher String
 

Types/ProposedAccepted.hs

@@ -7,7 +7,6 @@
 
 module Types.ProposedAccepted where
 
-import qualified Data.Map as M
 import Test.QuickCheck
 
 -- | A value that may be proposed, or accepted.
@@ -37,28 +36,3 @@ instance Arbitrary t => Arbitrary (ProposedAccepted t) where
 		[ Proposed <$> arbitrary
 		, Accepted <$> arbitrary
 		]
-
--- | Looks up a config in the map, and parses its value if found.
---
--- Accepted values will always result in a Right, using a fallback value
--- if unable to parse.
---
--- Proposed values that cannot be parsed will result in a Left message.
-parseProposedAccepted
-	:: ProposedAccepted String
-	-> M.Map (ProposedAccepted String) (ProposedAccepted v) -- config map
-	-> (v -> Maybe a) -- ^ parse the value
-	-> a -- ^ fallback used when accepted value cannot be parsed
-	-> String -- ^ short description of expected value
-	-> Either String (Maybe a)
-parseProposedAccepted k m parser fallback desc =
-	case M.lookup k m of
-		Nothing -> Right Nothing
-		Just (Proposed v) -> case parser v of
-			Nothing -> Left $
-				"bad " ++ fromProposedAccepted k ++
-				" value (expected " ++ desc ++ ")"
-			Just a -> Right (Just a)
-		Just (Accepted v) -> case parser v of
-			Nothing -> Right (Just fallback)
-			Just a -> Right (Just a)

Types/Remote.hs

@@ -57,10 +57,10 @@ data RemoteTypeA a = RemoteType
 	-- enumerates remotes of this type
 	-- The Bool is True if automatic initialization of remotes is desired
 	, enumerate :: Bool -> a [Git.Repo]
+	-- 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]
-	-- generates a remote of this type
-	, generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> a (Maybe (RemoteA a))
 	-- 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

@@ -28,12 +28,6 @@ type ParsedRemoteConfig = M.Map RemoteConfigField RemoteConfigValue
 data RemoteConfigValue where
 	RemoteConfigValue :: Typeable v => v -> RemoteConfigValue
 
-{- Extracts the value, if the field was parsed to the requested type. -}
-getRemoteConfigValue :: Typeable v => RemoteConfigField -> ParsedRemoteConfig -> Maybe v
-getRemoteConfigValue f m = case M.lookup f m of
-	Just (RemoteConfigValue v) -> cast v
-	Nothing -> Nothing
-
 {- Parse a field's value provided by the user into a RemoteConfigValue.
  -
  - The RemoteConfig is provided to the parser function for cases
@@ -43,4 +37,4 @@ getRemoteConfigValue f m = case M.lookup f m of
  - Presence of fields that are not included in this list will cause
  - a parse failure.
  -}
-type RemoteConfigParser = (RemoteConfigField, Maybe (ProposedAccepted String) -> RemoteConfig -> Either String RemoteConfigValue)
+type RemoteConfigParser = (RemoteConfigField, Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue))