wip separate RemoteConfig parsing

Remote now contains a ParsedRemoteConfig. The parsing happens when the
Remote is constructed, rather than when individual configs are used.

This is more efficient, and it lets initremote/enableremote
reject configs that have unknown fields or unparsable values.

It also allows for improved type safety, as shown in
Remote.Helper.Encryptable where things that used to match on string
configs now match on data types.

This is a work in progress, it does not build yet.

The main risk in this conversion is forgetting to add a field to
RemoteConfigParser. That will prevent using that field with
initremote/enableremote, and will prevent remotes that already are set
up from seeing that configuration. So will need to check carefully that
every field that getRemoteConfigValue is called on has been added to
RemoteConfigParser.

(One such case I need to remember is that credPairRemoteField needs to be
included in the RemoteConfigParser.)

Annex/SpecialRemote/Config.hs

@@ -60,6 +60,9 @@ cipherkeysField = Accepted "cipherkeys"
 pubkeysField :: RemoteConfigField
 pubkeysField = Accepted "pubkeys"
 
+chunkField :: RemoteConfigField
+chunkField = Accepted "chunk"
+
 chunksizeField :: RemoteConfigField
 chunksizeField = Accepted "chunksize"
 

Config/RemoteConfig.hs

@@ -0,0 +1,44 @@
+{- 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

@@ -23,12 +23,14 @@ module Creds (
 import Annex.Common
 import qualified Annex
 import Types.Creds
+import Types.RemoteConfig
+import Config.RemoteConfig
 import Annex.Perms
 import Utility.FileMode
 import Crypto
 import Types.Remote (RemoteConfig, RemoteConfigField)
 import Types.ProposedAccepted
-import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher)
+import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher, encryptionConfigParser)
 import Utility.Env (getEnv)
 
 import qualified Data.ByteString.Lazy.Char8 as L
@@ -56,30 +58,34 @@ data CredPairStorage = CredPairStorage
 setRemoteCredPair :: EncryptionIsSetup -> RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
 setRemoteCredPair encsetup c gc storage mcreds = case mcreds of
 	Nothing -> maybe (return c) (setRemoteCredPair encsetup c gc storage . Just)
-		=<< getRemoteCredPair c gc storage
+		=<< getRemoteCredPair pc gc storage
 	Just creds
-		| embedCreds c ->
+		| embedCreds pc -> do
 			let key = credPairRemoteField storage
-			in storeconfig creds key =<< flip remoteCipher gc =<< localcache creds
+			localcache creds
-		| otherwise -> localcache creds
+			storeconfig creds key =<< remoteCipher pc gc
+		| otherwise -> do
+			localcache creds
+			return c
   where
-	localcache creds = do
+	localcache creds = writeCacheCredPair creds storage
-		writeCacheCredPair creds storage
-		return c
 
 	storeconfig creds key (Just cipher) = do
 		cmd <- gpgCmd <$> Annex.getGitConfig
-		s <- liftIO $ encrypt cmd (c, gc) cipher
+		s <- liftIO $ encrypt cmd (pc, gc) cipher
 			(feedBytes $ L.pack $ encodeCredPair creds)
 			(readBytes $ return . L.unpack)
 		return $ M.insert key (Accepted (toB64 s)) c
 	storeconfig creds key Nothing =
 		return $ M.insert key (Accepted (toB64 $ encodeCredPair creds)) c
+	
+	pc = either (const mempty) id
+		(parseRemoteConfig c encryptionConfigParser)
 
 {- Gets a remote's credpair, from the environment if set, otherwise
  - from the cache in gitAnnexCredsDir, or failing that, from the
  - value in RemoteConfig. -}
-getRemoteCredPair :: RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPair :: ParsedRemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
 getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
   where
 	fromenv = liftIO $ getEnvCredPair storage
@@ -87,7 +93,7 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
 	fromconfig = do
 		let key = credPairRemoteField storage
 		mcipher <- remoteCipher' c gc
-		case (fromProposedAccepted <$> M.lookup key c, mcipher) of
+		case (fromProposedAccepted <$> getRemoteConfigValue key c, mcipher) of
 			(Nothing, _) -> return Nothing
 			(Just enccreds, Just (cipher, storablecipher)) ->
 				fromenccreds enccreds cipher storablecipher
@@ -115,7 +121,7 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
 			return $ Just credpair
 		_ -> error "bad creds"
 
-getRemoteCredPairFor :: String -> RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPairFor :: String -> ParsedRemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
 getRemoteCredPairFor this c gc storage = go =<< getRemoteCredPair c gc storage
   where
 	go Nothing = do
@@ -184,7 +190,7 @@ removeCreds file = do
 	let f = d </> file
 	liftIO $ nukeFile f
 
-includeCredsInfo :: RemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)]
+includeCredsInfo :: ParsedRemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)]
 includeCredsInfo c storage info = do
 	v <- liftIO $ getEnvCredPair storage
 	case v of

Crypto.hs

@@ -3,7 +3,7 @@
  - Currently using gpg; could later be modified to support different
  - crypto backends if neccessary.
  -
- - Copyright 2011-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -13,6 +13,7 @@
 {-# LANGUAGE Rank2Types #-}
 
 module Crypto (
+	EncryptionMethod(..),
 	Cipher,
 	KeyIds(..),
 	EncKey,
@@ -37,17 +38,24 @@ module Crypto (
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import Data.ByteString.UTF8 (fromString)
-import qualified Data.Map as M
 import Control.Monad.IO.Class
+import Data.Typeable
 
 import Annex.Common
 import qualified Utility.Gpg as Gpg
 import Types.Crypto
 import Types.Remote
 import Types.Key
-import Types.ProposedAccepted
 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
@@ -233,14 +241,18 @@ class LensGpgEncParams a where
 
 {- Extract the GnuPG options from a pair of a Remote Config and a Remote
  - Git Config. -}
-instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where
+instance LensGpgEncParams (ParsedRemoteConfig, RemoteGitConfig) where
 	getGpgEncParamsBase (_c,gc) = map Param (remoteAnnexGnupgOptions gc)
 	getGpgEncParams (c,gc) = getGpgEncParamsBase (c,gc) ++
  		{- When the remote is configured to use public-key encryption,
 		 - look up the recipient keys and add them to the option list. -}
-		case fromProposedAccepted <$> M.lookup encryptionField c of
+		case getRemoteConfigValue encryptionField c of
-			Just "pubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',' . fromProposedAccepted) $ M.lookup cipherkeysField c
+			Just PubKeyEncryption -> 
-			Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',' . fromProposedAccepted) $ M.lookup pubkeysField c
+				Gpg.pkEncTo $ maybe [] (splitc ',') $
+					getRemoteConfigValue cipherkeysField c
+			Just SharedPubKeyEncryption ->
+				Gpg.pkEncTo $ maybe [] (splitc ',') $
+					getRemoteConfigValue pubkeysField c
 			_ -> []
 	getGpgDecParams (_c,gc) = map Param (remoteAnnexGnupgDecryptOptions gc)
 

Remote/Helper/Chunked.hs

@@ -1,6 +1,6 @@
 {- git-annex chunked remotes
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,6 +10,7 @@ module Remote.Helper.Chunked (
 	ChunkConfig(..),
 	noChunks,
 	describeChunkConfig,
+	chunkConfigParser,
 	getChunkConfig,
 	storeChunks,
 	removeChunks,
@@ -27,9 +28,9 @@ import Utility.Metered
 import Crypto (EncKey)
 import Backend (isStableKey)
 import Annex.SpecialRemote.Config
+import Config.RemoteConfig
 
 import qualified Data.ByteString.Lazy as L
-import qualified Data.Map as M
 
 data ChunkConfig
 	= NoChunks
@@ -49,18 +50,24 @@ noChunks :: ChunkConfig -> Bool
 noChunks NoChunks = True
 noChunks _ = False
 
-getChunkConfig :: RemoteConfig -> ChunkConfig
+chunkConfigParser :: [RemoteConfigParser]
-getChunkConfig m =
+chunkConfigParser =
-	case M.lookup chunksizeField m of
+	[ optStringParser chunksizeField
-		Nothing -> case M.lookup (Accepted "chunk") m of
+	, optStringParser chunkField
+	]
+
+getChunkConfig :: ParsedRemoteConfig -> ChunkConfig
+getChunkConfig c =
+	case getRemoteConfigValue chunksizeField c of
+		Nothing -> case getRemoteConfigValue chunkField c of
 			Nothing -> NoChunks
-			Just v -> readsz UnpaddedChunks (fromProposedAccepted v) (Accepted "chunk")
+			Just v -> readsz UnpaddedChunks (fromProposedAccepted v) chunkField
 		Just v -> readsz LegacyChunks (fromProposedAccepted v) chunksizeField
   where
-	readsz c v f = case readSize dataUnits v of
+	readsz mk v f = case readSize dataUnits v of
 		Just size
 			| size == 0 -> NoChunks
-			| size > 0 -> c (fromInteger size)
+			| size > 0 -> mk (fromInteger size)
 		_ -> giveup $ "bad configuration " ++ fromProposedAccepted f ++ "=" ++ v
 
 -- An infinite stream of chunk keys, starting from chunk 1.

Remote/Helper/Encryptable.hs

@@ -1,15 +1,18 @@
 {- common functions for encryptable remotes
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
+
 module Remote.Helper.Encryptable (
 	EncryptionIsSetup,
 	encryptionSetup,
 	noEncryptionUsed,
 	encryptionAlreadySetup,
+	encryptionConfigParser,
 	remoteCipher,
 	remoteCipher',
 	embedCreds,
@@ -25,7 +28,7 @@ import qualified Data.ByteString as B
 
 import Annex.Common
 import Types.Remote
-import Config
+import Config.RemoteConfig
 import Crypto
 import Types.Crypto
 import Types.ProposedAccepted
@@ -47,68 +50,117 @@ noEncryptionUsed = NoEncryption
 encryptionAlreadySetup :: EncryptionIsSetup
 encryptionAlreadySetup = EncryptionIsSetup
 
+encryptionConfigParser :: [RemoteConfigParser]
+encryptionConfigParser =
+	[ (encryptionField, \v c -> RemoteConfigValue <$> parseEncryptionMethod (fmap fromProposedAccepted v) c)
+	, optStringParser cipherField
+	, optStringParser cipherkeysField
+	, optStringParser 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))
+	]
+
+parseEncryptionMethod :: Maybe String -> RemoteConfig -> Either String EncryptionMethod
+parseEncryptionMethod (Just "none") _ = Right NoneEncryption
+parseEncryptionMethod (Just "shared") _ = Right SharedEncryption
+parseEncryptionMethod (Just "hybrid") _ = Right HybridEncryption
+parseEncryptionMethod (Just "pubkey") _ = Right PubKeyEncryption
+parseEncryptionMethod (Just "sharedpubkey") _ = Right SharedPubKeyEncryption
+-- Hybrid encryption is the default when a keyid is specified without
+-- an encryption field, or when there's a cipher already but no encryption
+-- field.
+parseEncryptionMethod Nothing c
+	| M.member (Accepted "keyid") c || M.member cipherField c = Right HybridEncryption
+parseEncryptionMethod _ _ = 
+	Left $ "Specify " ++ intercalate " or "
+		(map ((fromProposedAccepted encryptionField ++ "=") ++)
+		["none","shared","hybrid","pubkey", "sharedpubkey"])
+		++ "."
+ 
+parseHighRandomQuality :: Maybe String -> Either String Bool
+parseHighRandomQuality Nothing = Right True
+parseHighRandomQuality (Just "false") = Right False
+parseHighRandomQuality (Just "true") = Right True
+parseHighRandomQuality _ = Left "expected highRandomQuality=true/false"
+
+parseMac :: Maybe (ProposedAccepted String) -> Either String Mac
+parseMac Nothing = Right defaultMac
+parseMac (Just (Accepted s)) = Right $ fromMaybe defaultMac (readMac s)
+parseMac (Just (Proposed s)) = case readMac s of
+	Just mac -> Right mac
+	Nothing -> Left "bad mac value"
+
 {- Encryption setup for a remote. The user must specify whether to use
  - an encryption key, or not encrypt. An encrypted cipher is created, or is
  - updated to be accessible to an additional encryption key. Or the user
  - 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
 	cmd <- gpgCmd <$> Annex.getGitConfig
-	maybe (genCipher cmd) (updateCipher cmd) (extractCipher c)
+	maybe (genCipher pc cmd) (updateCipher pc cmd) (extractCipher pc)
   where
 	-- The type of encryption
-	encryption = fromProposedAccepted <$> M.lookup encryptionField c
+	encryption = parseEncryptionMethod (fromProposedAccepted <$> M.lookup encryptionField c) c
 	-- Generate a new cipher, depending on the chosen encryption scheme
-	genCipher cmd = case encryption of
+	genCipher pc cmd = case encryption of
-		_ | hasEncryptionConfig c -> cannotchange
+		Right NoneEncryption -> return (c, NoEncryption)
-		Just "none" -> return (c, NoEncryption)
+		Right SharedEncryption -> encsetup $ genSharedCipher cmd
-		Just "shared" -> encsetup $ genSharedCipher cmd
+		Right HybridEncryption -> encsetup $ genEncryptedCipher cmd (pc, gc) key Hybrid
-		-- hybrid encryption is the default when a keyid is
+		Right PubKeyEncryption -> encsetup $ genEncryptedCipher cmd (pc, gc) key PubKey
-		-- specified but no encryption
+		Right SharedPubKeyEncryption -> encsetup $ genSharedPubKeyCipher cmd key
-		_ | maybe (M.member (Accepted "keyid") c) (== "hybrid") encryption ->
+		Left err -> giveup err
-			encsetup $ genEncryptedCipher cmd (c, gc) key Hybrid
-		Just "pubkey" -> encsetup $ genEncryptedCipher cmd (c, gc) key PubKey
-		Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key
-		_ -> giveup $ "Specify " ++ intercalate " or "
-			(map ((fromProposedAccepted encryptionField ++ "=") ++)
-				["none","shared","hybrid","pubkey", "sharedpubkey"])
-			++ "."
 	key = maybe (giveup "Specify keyid=...") fromProposedAccepted $
 		M.lookup (Accepted "keyid") c
 	newkeys = maybe [] (\k -> [(True,fromProposedAccepted k)]) (M.lookup (Accepted "keyid+") c) ++
 		maybe [] (\k -> [(False,fromProposedAccepted k)]) (M.lookup (Accepted "keyid-") c)
 	cannotchange = giveup "Cannot set encryption type of existing remotes."
 	-- Update an existing cipher if possible.
-	updateCipher cmd v = case v of
+	updateCipher pc cmd v = case v of
-		SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
+		SharedCipher _ | encryption == Right SharedEncryption ->
-		EncryptedCipher _ variant _
+			return (c', EncryptionIsSetup)
-			| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption -> do
+		EncryptedCipher _ variant _ | sameasencryption variant ->
-				use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v
+			use "encryption update" $ updateCipherKeyIds cmd (pc, gc) newkeys v
 		SharedPubKeyCipher _ _ ->
-			use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v
+			use "encryption update" $ updateCipherKeyIds cmd (pc, gc) newkeys v
 		_ -> cannotchange
+	sameasencryption variant = case encryption of
+		Right HybridEncryption -> variant == Hybrid
+		Right PubKeyEncryption -> variant == PubKey
+		Right _ -> False
+		Left _ -> True
 	encsetup a = use "encryption setup" . a =<< highRandomQuality
 	use m a = do
 		showNote m
 		cipher <- liftIO a
 		showNote (describeCipher cipher)
 		return (storeCipher cipher c', EncryptionIsSetup)
-	highRandomQuality = 
+	highRandomQuality = ifM (Annex.getState Annex.fast)
-		(&&) (maybe True (\v -> fromProposedAccepted v /= "false") $ M.lookup (Accepted "highRandomQuality") c)
+		( return False
-			<$> fmap not (Annex.getState Annex.fast)
+		, case parseHighRandomQuality (fromProposedAccepted <$> M.lookup (Accepted "highRandomQuality") c) of
+			Left err -> giveup err
+			Right v -> return v
+		)
 	c' = foldr M.delete c
-		-- git-annex used to remove 'encryption' as well, since
+		-- Remove configs that are only used in here to generate
+		-- the encryption keys, and should not be stored in
+		-- remote.log.
+		-- Older versions used to remove 'encryption' as well, since
 		-- it was redundant; we now need to keep it for
 		-- public-key encryption, hence we leave it on newer
 		-- remotes (while being backward-compatible).
-		(map Accepted [ "keyid", "keyid+", "keyid-", "highRandomQuality" ])
+		(map Accepted ["keyid", "keyid+", "keyid-", "highRandomQuality"])
 
-remoteCipher :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe Cipher)
+remoteCipher :: ParsedRemoteConfig -> RemoteGitConfig -> Annex (Maybe Cipher)
 remoteCipher c gc = fmap fst <$> remoteCipher' c gc
 
 {- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
  - state. -}
-remoteCipher' :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, StorableCipher))
+remoteCipher' :: ParsedRemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, StorableCipher))
 remoteCipher' c gc = go $ extractCipher c
   where
 	go Nothing = return Nothing
@@ -130,18 +182,19 @@ remoteCipher' c gc = go $ extractCipher c
  - When gpg encryption is used and the creds are encrypted using it.
  - Not when a shared cipher is used.
  -}
-embedCreds :: RemoteConfig -> Bool
+embedCreds :: ParsedRemoteConfig -> Bool
-embedCreds c = case yesNo . fromProposedAccepted =<< M.lookup embedCredsField c of
+embedCreds c = case getRemoteConfigValue embedCredsField c of
 	Just v -> v
-	Nothing -> isJust (M.lookup cipherkeysField c) && isJust (M.lookup cipherField c)
+	Nothing -> case (getRemoteConfigValue cipherkeysField c, getRemoteConfigValue cipherField c) of
+		(Just (_ :: ProposedAccepted String), Just (_ :: ProposedAccepted String)) -> True
+		_ -> False
 
 {- Gets encryption Cipher, and key encryptor. -}
-cipherKey :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, EncKey))
+cipherKey :: ParsedRemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, EncKey))
 cipherKey c gc = fmap make <$> remoteCipher c gc
   where
 	make ciphertext = (ciphertext, encryptKey mac ciphertext)
-	mac = fromMaybe defaultMac $
+	mac = fromMaybe defaultMac $ getRemoteConfigValue macField c
-		M.lookup macField c >>= readMac . fromProposedAccepted
 
 {- Stores an StorableCipher in a remote's configuration. -}
 storeCipher :: StorableCipher -> RemoteConfig -> RemoteConfig
@@ -154,34 +207,26 @@ storeCipher cip = case cip of
 	storekeys (KeyIds l) n = M.insert n (Accepted (intercalate "," l))
 
 {- Extracts an StorableCipher from a remote's configuration. -}
-extractCipher :: RemoteConfig -> Maybe StorableCipher
+extractCipher :: ParsedRemoteConfig -> Maybe StorableCipher
-extractCipher c = case (fromProposedAccepted <$> M.lookup cipherField c,
+extractCipher c = case (getRemoteConfigValue cipherField c,
-			fromProposedAccepted <$> (M.lookup cipherkeysField c <|> M.lookup pubkeysField c),
+			(getRemoteConfigValue cipherkeysField c <|> getRemoteConfigValue pubkeysField c),
-			fromProposedAccepted <$> M.lookup encryptionField c) of
+			getRemoteConfigValue encryptionField c) of
-	(Just t, Just ks, encryption) | maybe True (== "hybrid") encryption ->
+	(Just t, Just ks, Just HybridEncryption) ->
 		Just $ EncryptedCipher (fromB64bs t) Hybrid (readkeys ks)
-	(Just t, Just ks, Just "pubkey") ->
+	(Just t, Just ks, Just PubKeyEncryption) ->
 		Just $ EncryptedCipher (fromB64bs t) PubKey (readkeys ks)
-	(Just t, Just ks, Just "sharedpubkey") ->
+	(Just t, Just ks, Just SharedPubKeyEncryption) ->
 		Just $ SharedPubKeyCipher (fromB64bs t) (readkeys ks)
-	(Just t, Nothing, encryption) | maybe True (== "shared") encryption ->
+	(Just t, Nothing, Just SharedEncryption) ->
 		Just $ SharedCipher (fromB64bs t)
 	_ -> Nothing
   where
 	readkeys = KeyIds . splitc ','
 
-isEncrypted :: RemoteConfig -> Bool
+isEncrypted :: ParsedRemoteConfig -> Bool
-isEncrypted c = case fromProposedAccepted <$> M.lookup encryptionField c of
+isEncrypted = isJust . extractCipher
-	Just "none" -> False
-	Just _ -> True
-	Nothing -> hasEncryptionConfig c
 
-hasEncryptionConfig :: RemoteConfig -> Bool
+describeEncryption :: ParsedRemoteConfig -> String
-hasEncryptionConfig c = M.member cipherField c
-	|| M.member cipherkeysField c
-	|| M.member pubkeysField c
-
-describeEncryption :: RemoteConfig -> String
 describeEncryption c = case extractCipher c of
 	Nothing -> "none"
 	Just cip -> nameCipher cip ++ " (" ++ describeCipher cip ++ ")"

Remote/Helper/Special.hs

@@ -1,6 +1,6 @@
 {- helpers for special 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.
  -}
@@ -28,6 +28,7 @@ module Remote.Helper.Special (
 	retreiveKeyFileDummy,
 	removeKeyDummy,
 	checkPresentDummy,
+	specialRemoteConfigParser,
 	SpecialRemoteCfg(..),
 	specialRemoteCfg,
 	specialRemote,
@@ -149,7 +150,7 @@ checkPresentDummy :: Key -> Annex Bool
 checkPresentDummy _ = error "missing checkPresent implementation"
 
 type RemoteModifier
-	= RemoteConfig
+	= ParsedRemoteConfig
 	-> Preparer Storer
 	-> Preparer Retriever
 	-> Preparer Remover
@@ -157,12 +158,15 @@ type RemoteModifier
 	-> Remote
 	-> Remote
 
+specialRemoteConfigParser :: [RemoteConfigParser]
+specialRemoteConfigParser = chunkConfigParser ++ encryptionConfigParser
+
 data SpecialRemoteCfg = SpecialRemoteCfg
 	{ chunkConfig :: ChunkConfig
 	, displayProgress :: Bool
 	}
 
-specialRemoteCfg :: RemoteConfig -> SpecialRemoteCfg
+specialRemoteCfg :: ParsedRemoteConfig -> SpecialRemoteCfg
 specialRemoteCfg c = SpecialRemoteCfg (getChunkConfig c) True
 
 -- Modifies a base Remote to support both chunking and encryption,
@@ -212,7 +216,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 			}
 		}
 	cip = cipherKey c (gitconfig baser)
-	isencrypted = isJust (extractCipher c)
+	isencrypted = isEncrypted c
 
 	safely a = catchNonAsync a (\e -> warning (show e) >> return False)
 

Types/Remote.hs

@@ -2,7 +2,7 @@
  -
  - Most things should not need this, using Types instead
  -
- - 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.
  -}
@@ -10,8 +10,7 @@
 {-# LANGUAGE RankNTypes #-}
 
 module Types.Remote
-	( RemoteConfigField
+	( module Types.RemoteConfig
-	, RemoteConfig
 	, RemoteTypeA(..)
 	, RemoteA(..)
 	, RemoteStateHandle
@@ -28,7 +27,6 @@ module Types.Remote
 	)
 	where
 
-import qualified Data.Map as M
 import Data.Ord
 
 import qualified Git
@@ -42,7 +40,7 @@ import Types.UrlContents
 import Types.NumCopies
 import Types.Export
 import Types.Import
-import Types.ProposedAccepted
+import Types.RemoteConfig
 import Config.Cost
 import Utility.Metered
 import Git.Types (RemoteName)
@@ -50,10 +48,6 @@ import Utility.SafeCommand
 import Utility.Url
 import Utility.DataUnits
 
-type RemoteConfigField = ProposedAccepted String
-
-type RemoteConfig = M.Map RemoteConfigField (ProposedAccepted String)
-
 data SetupStage = Init | Enable RemoteConfig
 
 {- There are different types of remotes. -}
@@ -63,14 +57,16 @@ 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]
+	-- 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
-	, exportSupported :: RemoteConfig -> RemoteGitConfig -> a Bool
+	, exportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a Bool
 	-- check if a remote of this type is able to support import
-	, importSupported :: RemoteConfig -> RemoteGitConfig -> a Bool
+	, importSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a Bool
 	}
 
 instance Eq (RemoteTypeA a) where
@@ -125,7 +121,7 @@ data RemoteA a = Remote
 	-- Runs an action to repair the remote's git repository.
 	, repairRepo :: Maybe (a Bool -> a (IO Bool))
 	-- a Remote has a persistent configuration store
-	, config :: RemoteConfig
+	, config :: ParsedRemoteConfig
 	-- Get the git repo for the Remote.
 	, getRepo :: a Git.Repo
 	-- a Remote's configuration from git

Types/RemoteConfig.hs

@@ -0,0 +1,46 @@
+{- git-annex remote config types
+ -
+ - Copyright 2020 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE GADTs #-}
+
+module Types.RemoteConfig where
+
+import qualified Data.Map as M
+import Data.Typeable
+
+import Types.ProposedAccepted
+
+type RemoteConfigField = ProposedAccepted String
+
+{- What the user provides to configure the remote, and what is stored for
+ - later; a bunch of fields and values. -}
+type RemoteConfig = M.Map RemoteConfigField (ProposedAccepted String)
+
+{- Before being used a RemoteConfig has to be parsed. -}
+type ParsedRemoteConfig = M.Map RemoteConfigField RemoteConfigValue
+
+{- Remotes can have configuration values of many types, so use Typeable
+ - to let them all be stored in here. -}
+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
+ - where multiple fields need to be looked at. However, it's important
+ - that, when a parser looks at an additional field in that way, the
+ - parser list contains a dedicated parser for that field as well.
+ - 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)

git-annex.cabal

@@ -811,6 +811,7 @@ Executable git-annex
     Config.Files
     Config.DynamicConfig
     Config.GitConfig
+    Config.RemoteConfig
     Config.Smudge
     Creds
     Crypto
@@ -998,6 +999,7 @@ Executable git-annex
     Types.ProposedAccepted
     Types.RefSpec
     Types.Remote
+    Types.RemoteConfig
     Types.RemoteState
     Types.RepoVersion
     Types.ScheduledActivity