Merge branch 'master' into v8

Annex/AdjustedBranch.hs

@@ -558,8 +558,8 @@ reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch
 reverseAdjustedTree :: Sha -> Adjustment -> Sha -> Annex Sha
 reverseAdjustedTree basis adj csha = do
 	(diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha)
-	let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff
-	let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others
+	let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti `elem` nullShas) diff
+	let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti `elem` nullShas) others
 	adds' <- catMaybes <$>
 		mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds)
 	treesha <- Git.Tree.adjustTree

Annex/Branch.hs

@@ -577,10 +577,11 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 	 -}
 	run [] = noop
 	run changers = do
+		config <- Annex.getGitConfig
 		trustmap <- calcTrustMap <$> getStaged trustLog
 		remoteconfigmap <- calcRemoteConfigMap <$> getStaged remoteLog
 		-- partially apply, improves performance
-		let changers' = map (\c -> c trustmap remoteconfigmap) changers
+		let changers' = map (\c -> c config trustmap remoteconfigmap) changers
 		fs <- branchFiles
 		forM_ fs $ \f -> do
 			content <- getStaged f

Annex/Branch/Transitions.hs

@@ -22,6 +22,8 @@ import Types.TrustLevel
 import Types.UUID
 import Types.MetaData
 import Types.Remote
+import Types.GitConfig (GitConfig)
+import Types.ProposedAccepted
 import Annex.SpecialRemote.Config
 
 import qualified Data.Map as M
@@ -34,7 +36,7 @@ data FileTransition
 	= ChangeFile Builder
 	| PreserveFile
 
-type TransitionCalculator = TrustMap -> M.Map UUID RemoteConfig -> RawFilePath -> L.ByteString -> FileTransition
+type TransitionCalculator = GitConfig -> TrustMap -> M.Map UUID RemoteConfig -> RawFilePath -> L.ByteString -> FileTransition
 
 getTransitionCalculator :: Transition -> Maybe TransitionCalculator
 getTransitionCalculator ForgetGitHistory = Nothing
@@ -53,7 +55,7 @@ getTransitionCalculator ForgetDeadRemotes = Just dropDead
 -- is not removed from the remote log, for the same reason the trust log
 -- is not changed.
 dropDead :: TransitionCalculator
-dropDead trustmap remoteconfigmap f content = case getLogVariety f of
+dropDead gc trustmap remoteconfigmap f content = case getLogVariety gc f of
 	Just OldUUIDBasedLog
 		| f == trustLog -> PreserveFile
 		| f == remoteLog -> ChangeFile $
@@ -85,7 +87,7 @@ dropDead trustmap remoteconfigmap f content = case getLogVariety f of
 	trustmap' = trustmap `M.union`
 		M.map (const DeadTrusted) (M.filter sameasdead remoteconfigmap)
 	sameasdead cm =
-		case toUUID <$> M.lookup sameasUUIDField cm of
+		case toUUID . fromProposedAccepted <$> M.lookup sameasUUIDField cm of
 			Nothing -> False
 			Just u' -> M.lookup u' trustmap == Just DeadTrusted
 	minimizesameasdead u l

Annex/Content.hs

@@ -780,13 +780,12 @@ saveState nocommit = doSideAction $ do
 
 {- Downloads content from any of a list of urls, displaying a progress
  - meter. -}
-downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Annex Bool
-downloadUrl k p urls file = 
+downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool
+downloadUrl k p urls file uo = 
 	-- Poll the file to handle configurations where an external
 	-- download command is used.
 	meteredFile file (Just p) k $
-		Url.withUrlOptions $ \uo -> 
-			anyM (\u -> Url.download p u file uo) urls
+		anyM (\u -> Url.download p u file uo) urls
 
 {- Copies a key's content, when present, to a temp file.
  - This is used to speed up some rsyncs. -}

Annex/Content/PointerFile.hs

@@ -22,7 +22,9 @@ import Annex.ReplaceFile
 import Annex.InodeSentinal
 import Annex.Content.LowLevel
 import Utility.InodeCache
+#if ! defined(mingw32_HOST_OS)
 import Utility.Touch
+#endif
 
 {- Populates a pointer file with the content of a key. 
  -

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/FileMatcher.hs

@@ -37,8 +37,10 @@ import Types.Group
 import Types.FileMatcher
 import Types.GitConfig
 import Config.GitConfig
+import Annex.SpecialRemote.Config (preferreddirField)
 import Git.FilePath
 import Types.Remote (RemoteConfig)
+import Types.ProposedAccepted
 import Annex.CheckAttr
 import Git.CheckAttr (unspecifiedAttr)
 import qualified Git.Config
@@ -155,8 +157,8 @@ preferredContentKeylessTokens pcd =
 	, SimpleToken "inpreferreddir" (simply $ limitInDir preferreddir)
 	] ++ commonKeylessTokens LimitAnnexFiles
   where
-	preferreddir = fromMaybe "public" $
-		M.lookup "preferreddir" =<< (`M.lookup` configMap pcd) =<< repoUUID pcd
+	preferreddir = maybe "public" fromProposedAccepted $
+		M.lookup preferreddirField =<< (`M.lookup` configMap pcd) =<< repoUUID pcd
 
 preferredContentKeyedTokens :: PreferredContentData -> [ParseToken (MatchFiles Annex)]
 preferredContentKeyedTokens pcd =

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.hs

@@ -17,6 +17,7 @@ import Annex.SpecialRemote.Config
 import Remote (remoteTypes)
 import Types.Remote (RemoteConfig, SetupStage(..), typename, setup)
 import Types.GitConfig
+import Types.ProposedAccepted
 import Config
 import Remote.List
 import Logs.Remote
@@ -49,10 +50,10 @@ newConfig
 	-- when sameas is used
 	-> RemoteConfig
 newConfig name sameas fromuser m = case sameas of
-	Nothing -> M.insert nameField name fromuser
+	Nothing -> M.insert nameField (Proposed name) fromuser
 	Just (Sameas u) -> addSameasInherited m $ M.fromList
-		[ (sameasNameField, name)
-		, (sameasUUIDField, fromUUID u)
+		[ (sameasNameField, Proposed name)
+		, (sameasUUIDField, Proposed (fromUUID u))
 		] `M.union` fromuser
 
 specialRemoteMap :: Annex (M.Map UUID RemoteName)
@@ -66,11 +67,15 @@ specialRemoteMap = do
 
 {- find the remote type -}
 findType :: RemoteConfig -> Either String RemoteType
-findType config = maybe unspecified specified $ M.lookup typeField config
+findType config = maybe unspecified (specified . fromProposedAccepted) $
+	M.lookup typeField config
   where
 	unspecified = Left "Specify the type of remote with type="
 	specified s = case filter (findtype s) remoteTypes of
 		[] -> Left $ "Unknown remote type " ++ s 
+			++ " (pick from: "
+			++ intercalate " " (map typename remoteTypes)
+			++ ")"
 		(t:_) -> Right t
 	findtype s i = typename i == s
 
@@ -90,11 +95,12 @@ autoEnable = do
 					Left e -> warning (show e)
 					Right (_c, _u) ->
 						when (cu /= u) $
-							setConfig (remoteConfig c "config-uuid") (fromUUID cu)
+							setConfig (remoteAnnexConfig c "config-uuid") (fromUUID cu)
 			_ -> return ()
   where
 	configured rc = fromMaybe False $
-		Git.Config.isTrueFalse =<< M.lookup autoEnableField rc
+		Git.Config.isTrueFalse . fromProposedAccepted
+			=<< M.lookup autoEnableField rc
 	canenable u = (/= DeadTrusted) <$> lookupTrust u
 	getenabledremotes = M.fromList
 		. map (\r -> (getcu r, r))

Annex/SpecialRemote/Config.hs

@@ -1,18 +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)
@@ -22,44 +31,84 @@ newtype ConfigFrom t = ConfigFrom t
 
 {- The name of a configured remote is stored in its config using this key. -}
 nameField :: RemoteConfigField
-nameField = "name"
+nameField = Accepted "name"
 
 {- The name of a sameas remote is stored using this key instead. 
  - This prevents old versions of git-annex getting confused. -}
 sameasNameField :: RemoteConfigField
-sameasNameField = "sameas-name"
+sameasNameField = Accepted "sameas-name"
 
 lookupName :: RemoteConfig -> Maybe String
-lookupName c = M.lookup nameField c <|> M.lookup sameasNameField c
+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 = "sameas-uuid"
+sameasUUIDField = Accepted "sameas-uuid"
 
 {- The type of a remote is stored in its config using this key. -}
 typeField :: RemoteConfigField
-typeField = "type"
+typeField = Accepted "type"
 
 autoEnableField :: RemoteConfigField
-autoEnableField = "autoenable"
+autoEnableField = Accepted "autoenable"
 
 encryptionField :: RemoteConfigField
-encryptionField = "encryption"
+encryptionField = Accepted "encryption"
 
 macField :: RemoteConfigField
-macField = "mac"
+macField = Accepted "mac"
 
 cipherField :: RemoteConfigField
-cipherField = "cipher"
+cipherField = Accepted "cipher"
 
 cipherkeysField :: RemoteConfigField
-cipherkeysField = "cipherkeys"
+cipherkeysField = Accepted "cipherkeys"
 
 pubkeysField :: RemoteConfigField
-pubkeysField = "pubkeys"
+pubkeysField = Accepted "pubkeys"
+
+chunkField :: RemoteConfigField
+chunkField = Accepted "chunk"
 
 chunksizeField :: RemoteConfigField
-chunksizeField = "chunksize"
+chunksizeField = Accepted "chunksize"
+
+embedCredsField :: RemoteConfigField
+embedCredsField = Accepted "embedcreds"
+
+preferreddirField :: RemoteConfigField
+preferreddirField = Accepted "preferreddir"
+
+exportTreeField :: RemoteConfigField
+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. -}
+commonFieldParsers :: [RemoteConfigFieldParser]
+commonFieldParsers =
+	[ optionalStringParser nameField
+		(FieldDesc "name for the special remote")
+	, optionalStringParser sameasNameField HiddenField
+	, optionalStringParser sameasUUIDField HiddenField
+	, optionalStringParser typeField
+		(FieldDesc "type of special remote")
+	, trueFalseParser autoEnableField False
+		(FieldDesc "automatically enable special remote")
+	, optionalStringParser preferreddirField
+		(FieldDesc "directory whose content is preferred")
+	]
 
 {- 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. -}
@@ -92,7 +141,8 @@ addSameasInherited m c = case findSameasUUID c of
 			M.restrictKeys parentc sameasInherits
 
 findSameasUUID :: RemoteConfig -> Maybe (Sameas UUID)
-findSameasUUID c = Sameas . toUUID <$> M.lookup sameasUUIDField c
+findSameasUUID c = Sameas . toUUID . fromProposedAccepted
+	<$> M.lookup sameasUUIDField c
 
 {- Remove any fields inherited from a sameas-uuid. When storing a
  - RemoteConfig, those fields don't get stored, since they were already
@@ -108,4 +158,98 @@ findByRemoteConfig matching = map sameasuuid . filter (matching . snd) . M.toLis
   where
 	sameasuuid (u, c) = case M.lookup sameasUUIDField c of
 		Nothing -> (u, c, Nothing)
-		Just u' -> (toUUID u', c, Just (ConfigFrom u))
+		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
+
+{- Gets all fields that remoteConfigRestPassthrough matched. -}
+getRemoteConfigPassedThrough :: ParsedRemoteConfig -> M.Map RemoteConfigField String
+getRemoteConfigPassedThrough = M.mapMaybe $ \(RemoteConfigValue 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 [] c (remoteConfigFieldParsers rpc ++ commonFieldParsers)
+  where
+	go l c' [] =
+		let (passover, leftovers) = partition
+			(maybe (const False) fst (remoteConfigRestPassthrough rpc) . fst)
+			(M.toList c')
+		    leftovers' = filter (notaccepted . fst) leftovers
+		in if not (null leftovers')
+			then Left $ "Unexpected parameters: " ++
+				unwords (map (fromProposedAccepted . fst) leftovers')
+			else Right $ M.fromList $
+				l ++ map (uncurry passthrough) passover
+	go l c' (p:rest) = do
+		let f = parserForField p
+		(valueParser p) (M.lookup f c) c >>= \case
+			Just v -> go ((f,v):l) (M.delete f c') rest
+			Nothing -> go l (M.delete f c') rest
+	
+	passthrough f v = (f, RemoteConfigValue (PassedThrough (fromProposedAccepted v)))
+	
+	notaccepted (Proposed _) = True
+	notaccepted (Accepted _) = False
+
+optionalStringParser :: RemoteConfigField -> FieldDesc -> RemoteConfigFieldParser
+optionalStringParser f fielddesc = RemoteConfigFieldParser
+	{ parserForField = f 
+	, valueParser = p
+	, fieldDesc = fielddesc
+	, valueDesc = Nothing
+	}
+  where
+	p (Just v) _c = Right (Just (RemoteConfigValue (fromProposedAccepted v)))
+	p Nothing _c = Right Nothing
+
+yesNoParser :: RemoteConfigField -> Bool -> FieldDesc -> RemoteConfigFieldParser
+yesNoParser f v fd = genParser yesNo f v fd
+	(Just (ValueDesc "yes or no"))
+
+trueFalseParser :: RemoteConfigField -> Bool -> FieldDesc -> RemoteConfigFieldParser
+trueFalseParser f v fd = genParser Git.Config.isTrueFalse f v fd
+	(Just (ValueDesc "true or false"))
+
+genParser
+	:: Typeable t
+	=> (String -> Maybe t)
+	-> RemoteConfigField
+	-> t -- ^ fallback value
+	-> FieldDesc
+	-> Maybe ValueDesc
+	-> RemoteConfigFieldParser
+genParser parse f fallback fielddesc valuedesc = RemoteConfigFieldParser	
+	{ parserForField = f
+	, valueParser = p
+	, fieldDesc = fielddesc
+	, valueDesc = valuedesc
+	}
+  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 ++
+				case valuedesc of
+					Just (ValueDesc vd) ->
+						" (expected " ++ vd ++ ")"
+					Nothing -> ""

Annex/Ssh.hs

@@ -1,6 +1,6 @@
 {- git-annex ssh interface, with connection caching
  -
- - 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.
  -}
@@ -98,13 +98,31 @@ consumeStdinParams NoConsumeStdin = [Param "-n"]
 {- Returns a filename to use for a ssh connection caching socket, and
  - parameters to enable ssh connection caching. -}
 sshCachingInfo :: (SshHost, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
-sshCachingInfo (host, port) = go =<< sshCacheDir
+sshCachingInfo (host, port) = go =<< sshCacheDir'
   where
-	go Nothing = return (Nothing, [])
-	go (Just dir) =
+	go (Right dir) =
 		liftIO (bestSocketPath $ dir </> hostport2socket host port) >>= return . \case
 			Nothing -> (Nothing, [])
 			Just socketfile -> (Just socketfile, sshConnectionCachingParams socketfile)
+	-- No connection caching with concurrency is not a good
+	-- combination, so warn the user.
+	go (Left whynocaching) = do
+		Annex.getState Annex.concurrency >>= \case
+                	NonConcurrent -> return ()
+			Concurrent {} -> warnnocaching whynocaching
+			ConcurrentPerCpu -> warnnocaching whynocaching
+		return (Nothing, [])
+	
+	warnnocaching whynocaching = do
+		warning nocachingwarning
+		warning whynocaching
+	
+	nocachingwarning = unwords
+		[ "You have enabled concurrency, but git-annex is not able"
+		, "to use ssh connection caching. This may result in"
+		, "multiple ssh processes prompting for passwords at the"
+		, "same time."
+		]
 
 {- Given an absolute path to use for a socket file,
  - returns whichever is shorter of that or the relative path to the same
@@ -133,27 +151,44 @@ sshConnectionCachingParams socketfile =
 	, Param "-o", Param "ControlPersist=yes"
 	]
 
+sshSocketDirEnv :: String
+sshSocketDirEnv = "GIT_ANNEX_SSH_SOCKET_DIR"
+
 {- ssh connection caching creates sockets, so will not work on a
- - crippled filesystem. A GIT_ANNEX_TMP_DIR can be provided to use
- - a different filesystem. -}
+ - crippled filesystem. -}
 sshCacheDir :: Annex (Maybe FilePath)
-sshCacheDir
-	| BuildInfo.sshconnectioncaching = 
-		ifM (fromMaybe True . annexSshCaching <$> Annex.getGitConfig)
-			( ifM crippledFileSystem
-				( maybe (return Nothing) usetmpdir =<< gettmpdir
-				, Just <$> fromRepo gitAnnexSshDir 
-				)
-			, return Nothing
+sshCacheDir = eitherToMaybe <$> sshCacheDir'
+
+sshCacheDir' :: Annex (Either String FilePath)
+sshCacheDir' = 
+	ifM (fromMaybe BuildInfo.sshconnectioncaching . annexSshCaching <$> Annex.getGitConfig)
+		( ifM crippledFileSystem
+			( gettmpdir >>= \case
+				Nothing ->
+					return (Left crippledfswarning)
+				Just tmpdir -> 
+					liftIO $ catchMsgIO $
+						usetmpdir tmpdir
+			, Right <$> fromRepo gitAnnexSshDir 
 			)
-	| otherwise = return Nothing
+		, return (Left "annex.sshcaching is not set to true")
+		)
   where
-	gettmpdir = liftIO $ getEnv "GIT_ANNEX_TMP_DIR"
-	usetmpdir tmpdir = liftIO $ catchMaybeIO $ do
+	gettmpdir = liftIO $ getEnv sshSocketDirEnv
+
+	usetmpdir tmpdir = do
 		let socktmp = tmpdir </> "ssh"
 		createDirectoryIfMissing True socktmp
 		return socktmp
 	
+	crippledfswarning = unwords
+		[ "This repository is on a crippled filesystem, so unix named"
+		, "pipes probably don't work, and ssh connection caching"
+		, "relies on those. One workaround is to set"
+		, sshSocketDirEnv
+		, "to point to a directory on a non-crippled filesystem."
+		]
+
 portParams :: Maybe Integer -> [CommandParam]
 portParams Nothing = []
 portParams (Just port) = [Param "-p", Param $ show port]

Annex/UUID.hs

@@ -81,7 +81,7 @@ getRepoUUID r = do
 	updatecache u = do
 		g <- gitRepo
 		when (g /= r) $ storeUUIDIn cachekey u
-	cachekey = remoteConfig r "uuid"
+	cachekey = remoteAnnexConfig r "uuid"
 
 removeRepoUUID :: Annex ()
 removeRepoUUID = do

Annex/Url.hs

@@ -1,13 +1,14 @@
 {- Url downloading, with git-annex user agent and configured http
  - headers, security restrictions, etc.
  -
- - Copyright 2013-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
 module Annex.Url (
 	withUrlOptions,
+	withUrlOptionsPromptingCreds,
 	getUrlOptions,
 	getUserAgent,
 	ipAddressesUnlimited,
@@ -34,6 +35,7 @@ import qualified Utility.Url as U
 import Utility.IPAddress
 import Utility.HttpManagerRestricted
 import Utility.Metered
+import Git.Credential
 import qualified BuildInfo
 
 import Network.Socket
@@ -64,6 +66,7 @@ getUrlOptions = Annex.getState Annex.urloptions >>= \case
 			<*> pure urldownloader
 			<*> pure manager
 			<*> (annexAllowedUrlSchemes <$> Annex.getGitConfig)
+			<*> pure U.noBasicAuth
 	
 	headers = annexHttpHeadersCommand <$> Annex.getGitConfig >>= \case
 		Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
@@ -124,6 +127,24 @@ ipAddressesUnlimited =
 withUrlOptions :: (U.UrlOptions -> Annex a) -> Annex a
 withUrlOptions a = a =<< getUrlOptions
 
+-- When downloading an url, if authentication is needed, uses
+-- git-credential to prompt for username and password.
+withUrlOptionsPromptingCreds :: (U.UrlOptions -> Annex a) -> Annex a
+withUrlOptionsPromptingCreds a = do
+	g <- Annex.gitRepo
+	uo <- getUrlOptions
+	prompter <- mkPrompter
+	a $ uo
+		{ U.getBasicAuth = \u -> prompter $
+			getBasicAuthFromCredential g u
+		-- Can't download with curl and handle basic auth,
+		-- so make sure it uses conduit.
+		, U.urlDownloader = case U.urlDownloader uo of
+			U.DownloadWithCurl _ -> U.DownloadWithConduit $
+				U.DownloadWithCurlRestricted mempty
+			v -> v
+		}
+
 checkBoth :: U.URLString -> Maybe Integer -> U.UrlOptions -> Annex Bool
 checkBoth url expected_size uo =
 	liftIO (U.checkBoth url expected_size uo) >>= \case

Annex/View.hs

@@ -396,12 +396,12 @@ withViewChanges addmeta removemeta = do
 	void $ liftIO cleanup
   where
 	handleremovals item
-		| DiffTree.srcsha item /= nullSha =
+		| DiffTree.srcsha item `notElem` nullShas =
 			handlechange item removemeta
 				=<< catKey (DiffTree.srcsha item)
 		| otherwise = noop
 	handleadds item
-		| DiffTree.dstsha item /= nullSha = 
+		| DiffTree.dstsha item `notElem` nullShas = 
 			handlechange item addmeta
 				=<< catKey (DiffTree.dstsha item)
 		| otherwise = noop

Assistant/DaemonStatus.hs

@@ -19,8 +19,8 @@ import Logs.Trust
 import Utility.TimeStamp
 import qualified Remote
 import qualified Types.Remote as Remote
-import Config
 import Config.DynamicConfig
+import Annex.SpecialRemote.Config
 
 import Control.Concurrent.STM
 import System.Posix.Types
@@ -60,7 +60,7 @@ calcSyncRemotes = do
 
 	return $ \dstatus -> dstatus
 		{ syncRemotes = syncable
-		, syncGitRemotes = filter Remote.gitSyncableRemote syncable
+		, syncGitRemotes = filter (Remote.gitSyncableRemoteType . Remote.remotetype) syncable
 		, syncDataRemotes = dataremotes
 		, exportRemotes = exportremotes
 		, downloadRemotes = contentremotes

Assistant/Gpg.hs

@@ -11,6 +11,7 @@ import Utility.Gpg
 import Utility.UserInfo
 import Types.Remote (RemoteConfigField)
 import Annex.SpecialRemote.Config
+import Types.ProposedAccepted
 
 import qualified Data.Map as M
 import Control.Applicative
@@ -31,7 +32,7 @@ data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption
 	deriving (Eq)
 
 {- Generates Remote configuration for encryption. -}
-configureEncryption :: EnableEncryption -> (RemoteConfigField, String)
-configureEncryption SharedEncryption = (encryptionField, "shared")
-configureEncryption NoEncryption = (encryptionField, "none")
-configureEncryption HybridEncryption = (encryptionField, "hybrid")
+configureEncryption :: EnableEncryption -> (RemoteConfigField, ProposedAccepted String)
+configureEncryption SharedEncryption = (encryptionField, Proposed "shared")
+configureEncryption NoEncryption = (encryptionField, Proposed "none")
+configureEncryption HybridEncryption = (encryptionField, Proposed "hybrid")

Assistant/MakeRemote.hs

@@ -30,6 +30,7 @@ import Assistant.Gpg
 import Utility.Gpg (KeyId)
 import Types.GitConfig
 import Config
+import Types.ProposedAccepted
 
 import qualified Data.Map as M
 
@@ -59,19 +60,19 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
 	go (Just (u, c, mcu)) = setupSpecialRemote name Rsync.remote config Nothing
 		(Just u, R.Enable c, c) mcu
 	config = M.fromList
-		[ (encryptionField, "shared")
-		, ("rsyncurl", location)
-		, ("type", "rsync")
+		[ (encryptionField, Proposed "shared")
+		, (Proposed "rsyncurl", Proposed location)
+		, (typeField, Proposed "rsync")
 		]
 
 {- Inits a gcrypt special remote, and returns its name. -}
 makeGCryptRemote :: RemoteName -> String -> KeyId -> Annex RemoteName
 makeGCryptRemote remotename location keyid = 
 	initSpecialRemote remotename GCrypt.remote Nothing $ M.fromList
-		[ ("type", "gcrypt")
-		, ("gitrepo", location)
+		[ (typeField, Proposed "gcrypt")
+		, (Proposed "gitrepo", Proposed location)
 		, configureEncryption HybridEncryption
-		, ("keyid", keyid)
+		, (Proposed "keyid", Proposed keyid)
 		]
 
 type SpecialRemoteMaker = RemoteName -> RemoteType -> Maybe CredPair -> R.RemoteConfig -> Annex RemoteName
@@ -105,14 +106,14 @@ setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) mcu = do
 	 - assistant, because otherwise GnuPG may block once the entropy
 	 - pool is drained, and as of now there's no way to tell the user
 	 - to perform IO actions to refill the pool. -}
-	let weakc = M.insert "highRandomQuality" "false" $ M.union config c
+	let weakc = M.insert (Proposed "highRandomQuality") (Proposed "false") (M.union config c)
 	dummycfg <- liftIO dummyRemoteGitConfig
 	(c', u) <- R.setup remotetype ss mu mcreds weakc dummycfg
 	case mcu of
 		Nothing ->
 			configSet u c'
 		Just (Annex.SpecialRemote.ConfigFrom cu) -> do
-			setConfig (remoteConfig c' "config-uuid") (fromUUID cu)
+			setConfig (remoteAnnexConfig c' "config-uuid") (fromUUID cu)
 			configSet cu c'
 	when setdesc $
 		whenM (isNothing . M.lookup u <$> uuidDescMap) $

Assistant/Sync.hs

@@ -164,7 +164,7 @@ pushToRemotes' now remotes = do
 		updatemap succeeded failed
 		return failed
 		
-	push branch remote = Command.Sync.pushBranch remote branch
+	push branch remote = Command.Sync.pushBranch remote (Just branch)
 
 parallelPush :: Git.Repo -> [Remote] -> (Remote -> Git.Repo -> IO Bool)-> Assistant ([Remote], [Remote])
 parallelPush g rs a = do
@@ -265,7 +265,7 @@ changeSyncable (Just r) False = do
 changeSyncFlag :: Remote -> Bool -> Annex ()
 changeSyncFlag r enabled = do
 	repo <- Remote.getRepo r
-	let key = Config.remoteConfig repo "sync"
+	let key = Config.remoteAnnexConfig repo "sync"
 	Config.setConfig key (boolConfig enabled)
 	void Remote.remoteListRefresh
 

Assistant/WebApp/Configurators/AWS.hs

@@ -25,6 +25,7 @@ import Creds
 import Assistant.Gpg
 import Git.Types (RemoteName)
 import Annex.SpecialRemote.Config
+import Types.ProposedAccepted
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -131,10 +132,10 @@ postAddS3R = awsConfigurator $ do
 			let name = T.unpack $ repoName input
 			makeAWSRemote initSpecialRemote S3.remote TransferGroup (extractCreds input) name $ M.fromList
 				[ configureEncryption $ enableEncryption input
-				, ("type", "S3")
-				, ("datacenter", T.unpack $ datacenter input)
-				, ("storageclass", show $ storageClass input)
-				, ("chunk", "1MiB")
+				, (typeField, Proposed "S3")
+				, (Proposed "datacenter", Proposed $ T.unpack $ datacenter input)
+				, (Proposed "storageclass", Proposed $ show $ storageClass input)
+				, (Proposed "chunk", Proposed "1MiB")
 				]
 		_ -> $(widgetFile "configurators/adds3")
 #else
@@ -155,8 +156,8 @@ postAddGlacierR = glacierConfigurator $ do
 			let name = T.unpack $ repoName input
 			makeAWSRemote initSpecialRemote Glacier.remote SmallArchiveGroup (extractCreds input) name $ M.fromList
 				[ configureEncryption $ enableEncryption input
-				, ("type", "glacier")
-				, ("datacenter", T.unpack $ datacenter input)
+				, (typeField, Proposed "glacier")
+				, (Proposed "datacenter", Proposed $ T.unpack $ datacenter input)
 				]
 		_ -> $(widgetFile "configurators/addglacier")
 #else
@@ -167,7 +168,13 @@ getEnableS3R :: UUID -> Handler Html
 #ifdef WITH_S3
 getEnableS3R uuid = do
 	m <- liftAnnex readRemoteLog
-	if maybe False S3.configIA (M.lookup uuid m)
+	isia <- case M.lookup uuid m of
+		Just c -> liftAnnex $ do
+			pc <- either mempty id . parseRemoteConfig c
+				<$> Remote.configParser S3.remote c
+			return $ S3.configIA pc
+		Nothing -> return False
+	if isia
 		then redirect $ EnableIAR uuid
 		else postEnableS3R uuid
 #else
@@ -222,7 +229,7 @@ makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config =
 getRepoInfo :: RemoteConfig -> Widget
 getRepoInfo c = [whamlet|S3 remote using bucket: #{bucket}|]
   where
-	bucket = fromMaybe "" $ M.lookup "bucket" c
+	bucket = maybe "" fromProposedAccepted $ M.lookup (Accepted "bucket") c
 
 #ifdef WITH_S3
 previouslyUsedAWSCreds :: Annex (Maybe CredPair)

Assistant/WebApp/Configurators/Edit.hs

@@ -37,7 +37,7 @@ import qualified Git.Command
 import qualified Git.Config
 import qualified Annex
 import Git.Remote
-import Remote.Helper.Encryptable (extractCipher)
+import Remote.Helper.Encryptable (extractCipher, parseEncryptionConfig)
 import Types.Crypto
 import Utility.Gpg
 import Annex.UUID
@@ -46,6 +46,8 @@ import Config
 import Config.GitConfig
 import Config.DynamicConfig
 import Types.Group
+import Types.ProposedAccepted
+import Annex.SpecialRemote.Config
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -125,7 +127,7 @@ setRepoConfig uuid mremote oldc newc = do
 				case M.lookup uuid m of
 					Nothing -> noop
 					Just remoteconfig -> configSet uuid $
-						M.insert "preferreddir" dir remoteconfig
+						M.insert (Proposed "preferreddir") (Proposed dir) remoteconfig
 	when groupChanged $ do
 		liftAnnex $ case repoGroup newc of
 			RepoGroupStandard g -> setStandardGroup uuid g
@@ -217,13 +219,21 @@ editForm new (RepoUUID uuid)
 				redirect DashboardR
 			_ -> do
 				let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
-				config <- liftAnnex $ M.lookup uuid <$> readRemoteLog
+				config <- liftAnnex $ fromMaybe mempty 
+					. M.lookup uuid
+					<$> readRemoteLog
 				let repoInfo = getRepoInfo mremote config
-				let repoEncryption = getRepoEncryption mremote config
+				let repoEncryption = getRepoEncryption mremote (Just config)
 				$(widgetFile "configurators/edit/repository")
 editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
 	mr <- liftAnnex (repoIdRemote r)
-	let repoInfo = getRepoInfo mr Nothing
+	let repoInfo = case mr of
+		Just rmt -> do
+			config <- liftAnnex $ fromMaybe mempty
+				. M.lookup (Remote.uuid rmt)
+				<$> readRemoteLog
+			getRepoInfo mr config
+		Nothing -> getRepoInfo Nothing mempty
 	g <- liftAnnex gitRepo
 	mrepo <- liftAnnex $ maybe (pure Nothing) (Just <$$> Remote.getRepo) mr
 	let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation) mrepo
@@ -242,17 +252,21 @@ checkAssociatedDirectory cfg (Just r) = do
 			Nothing -> noop
 		_ -> noop
 
-getRepoInfo :: Maybe Remote.Remote -> Maybe Remote.RemoteConfig -> Widget
-getRepoInfo (Just r) (Just c) = case M.lookup "type" c of
-	Just "S3"
+getRepoInfo :: Maybe Remote.Remote -> Remote.RemoteConfig -> Widget
+getRepoInfo (Just r) c = case fromProposedAccepted <$> M.lookup typeField c of
+	Just "S3" -> do
 #ifdef WITH_S3
-		| S3.configIA c -> IA.getRepoInfo c
+		pc <- liftAnnex $ either mempty id . parseRemoteConfig c
+			<$> Remote.configParser S3.remote c
+		if S3.configIA pc
+			then IA.getRepoInfo c
+			else AWS.getRepoInfo c
+#else
+		AWS.getRepoInfo c
 #endif
-		| otherwise -> AWS.getRepoInfo c
 	Just t
 		| t /= "git" -> [whamlet|#{t} remote|]
 	_ -> getGitRepoInfo =<< liftAnnex (Remote.getRepo r)
-getRepoInfo (Just r) _ = getRepoInfo (Just r) (Just $ Remote.config r)
 getRepoInfo _ _ = [whamlet|git repository|]
 
 getGitRepoInfo :: Git.Repo -> Widget
@@ -261,7 +275,7 @@ getGitRepoInfo r = do
 	[whamlet|git repository located at <tt>#{loc}</tt>|]
 
 getRepoEncryption :: Maybe Remote.Remote -> Maybe Remote.RemoteConfig -> Widget
-getRepoEncryption (Just _) (Just c) = case extractCipher c of
+getRepoEncryption (Just _) (Just c) = case extractCipher pc of
 	Nothing ->
 		[whamlet|not encrypted|]
 	(Just (SharedCipher _)) ->
@@ -269,6 +283,7 @@ getRepoEncryption (Just _) (Just c) = case extractCipher c of
 	(Just (EncryptedCipher _ _ ks)) -> desckeys ks
 	(Just (SharedPubKeyCipher _ ks)) -> desckeys ks
   where
+	pc = either mempty id $ parseEncryptionConfig c
 	desckeys (KeyIds { keyIds = ks }) = do
 		cmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig
 		knownkeys <- liftIO (secretKeys cmd)
@@ -291,7 +306,7 @@ getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r)
 		liftAnnex $ do
 			repo <- Remote.getRepo rmt
 			setConfig
-				(remoteConfig repo "ignore")
+				(remoteAnnexConfig repo "ignore")
 				(Git.Config.boolConfig False)
 		liftAnnex $ void Remote.remoteListRefresh
 		liftAssistant updateSyncRemotes

Assistant/WebApp/Configurators/IA.hs

@@ -25,6 +25,7 @@ import Types.Remote (RemoteConfig)
 import qualified Annex.Url as Url
 import Creds
 import Annex.SpecialRemote.Config
+import Types.ProposedAccepted
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -131,21 +132,22 @@ postAddIAR = iaConfigurator $ do
 	case result of
 		FormSuccess input -> liftH $ do
 			let name = escapeBucket $ T.unpack $ itemName input
+			let wrap (k, v) = (Proposed k, Proposed v)
+			let c = map wrap $ catMaybes
+				[ Just ("type", "S3")
+				, Just ("host", S3.iaHost)
+				, Just ("bucket", escapeHeader name)
+				, Just ("x-archive-meta-title", escapeHeader $ T.unpack $ itemName input)
+				, if mediaType input == MediaOmitted
+					then Nothing
+					else Just ("x-archive-mediatype", formatMediaType $ mediaType input)
+				, (,) <$> pure "x-archive-meta-collection" <*> collectionMediaType (mediaType input)
+				-- Make item show up ASAP.
+				, Just ("x-archive-interactive-priority", "1")
+				, Just ("preferreddir", name)
+				]
 			AWS.makeAWSRemote initSpecialRemote S3.remote PublicGroup (extractCreds input) name $
-				M.fromList $ catMaybes
-					[ Just $ configureEncryption NoEncryption
-					, Just ("type", "S3")
-					, Just ("host", S3.iaHost)
-					, Just ("bucket", escapeHeader name)
-					, Just ("x-archive-meta-title", escapeHeader $ T.unpack $ itemName input)
-					, if mediaType input == MediaOmitted
-						then Nothing
-						else Just ("x-archive-mediatype", formatMediaType $ mediaType input)
-					, (,) <$> pure "x-archive-meta-collection" <*> collectionMediaType (mediaType input)
-					-- Make item show up ASAP.
-					, Just ("x-archive-interactive-priority", "1")
-					, Just ("preferreddir", name)
-					]
+				M.fromList $ configureEncryption NoEncryption : c
 		_ -> $(widgetFile "configurators/addia")
 #else
 postAddIAR = giveup "S3 not supported by this build"
@@ -202,7 +204,7 @@ $if (not exists)
     have been uploaded, and the Internet Archive has processed them.
 |]
   where
-	bucket = fromMaybe "" $ M.lookup "bucket" c
+	bucket = maybe "" fromProposedAccepted $ M.lookup (Accepted "bucket") c
 #ifdef WITH_S3
 	url = S3.iaItemUrl bucket
 #else

Assistant/WebApp/Configurators/Local.hs

@@ -39,6 +39,7 @@ import Utility.Gpg
 import qualified Remote.GCrypt as GCrypt
 import qualified Types.Remote
 import Utility.Android
+import Types.ProposedAccepted
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -325,7 +326,7 @@ getFinishAddDriveR drive = go
 		makewith $ const $ do
 			r <- liftAnnex $ addRemote $
 				enableSpecialRemote remotename' GCrypt.remote Nothing $ M.fromList
-					[("gitrepo", dir)]
+					[(Proposed "gitrepo", Proposed dir)]
 			return (u, r)
 	{- Making a new unencrypted repo, or combining with an existing one. -}
 	makeunencrypted = makewith $ \isnew -> (,)

Assistant/WebApp/Configurators/Ssh.hs

@@ -20,6 +20,7 @@ import Types.StandardGroups
 import Utility.UserInfo
 import Utility.Gpg
 import Types.Remote (RemoteConfig)
+import Types.ProposedAccepted
 import Git.Types (RemoteName, fromRef, fromConfigKey)
 import qualified Remote.GCrypt as GCrypt
 import qualified Annex
@@ -177,7 +178,7 @@ postEnableRsyncR = enableSshRemote getsshinput enableRsyncNet enablersync
   where
 	enablersync sshdata u = redirect $ ConfirmSshR
 		(sshdata { sshCapabilities = [RsyncCapable] }) u
-	getsshinput = parseSshUrl <=< M.lookup "rsyncurl"
+	getsshinput = parseSshUrl . fromProposedAccepted <=< M.lookup (Accepted "rsyncurl")
 
 {- This only handles gcrypt repositories that are located on ssh servers;
  - ones on local drives are handled via another part of the UI. -}
@@ -191,7 +192,7 @@ postEnableSshGCryptR u = whenGcryptInstalled $
 		sshConfigurator $
 			checkExistingGCrypt sshdata' $
 				giveup "Expected to find an encrypted git repository, but did not."
-	getsshinput = parseSshUrl <=< M.lookup "gitrepo"
+	getsshinput = parseSshUrl . fromProposedAccepted <=< M.lookup (Accepted "gitrepo")
 
 getEnableSshGitRemoteR :: UUID -> Handler Html
 getEnableSshGitRemoteR = postEnableSshGitRemoteR
@@ -200,7 +201,7 @@ postEnableSshGitRemoteR = enableSshRemote getsshinput enableRsyncNet enablesshgi
   where
 	enablesshgitremote sshdata u = redirect $ ConfirmSshR sshdata u
 
-	getsshinput = parseSshUrl <=< M.lookup "location"
+	getsshinput = parseSshUrl . fromProposedAccepted <=< M.lookup (Accepted "location")
 
 {- To enable a remote that uses ssh as its transport, 
  - parse a config key to get its url, and display a form
@@ -424,7 +425,7 @@ getConfirmSshR sshdata u
 		$(widgetFile "configurators/ssh/combine")
 	handleexisting (Just _) = prepSsh False sshdata $ \sshdata' -> do
 		m <- liftAnnex readRemoteLog
-		case M.lookup "type" =<< M.lookup u m of
+		case fromProposedAccepted <$> (M.lookup typeField =<< M.lookup u m) of
 			Just "gcrypt" -> combineExistingGCrypt sshdata' u
 			_ -> makeSshRepo ExistingRepo sshdata'
 
@@ -474,7 +475,7 @@ enableGCrypt :: SshData -> RemoteName -> Handler Html
 enableGCrypt sshdata reponame = setupRemote postsetup Nothing Nothing mk
   where
 	mk = enableSpecialRemote reponame GCrypt.remote Nothing $
-		M.fromList [("gitrepo", genSshUrl sshdata)]
+		M.fromList [(Proposed "gitrepo", Proposed (genSshUrl sshdata))]
 	postsetup _ = redirect DashboardR
 
 {- Combining with a gcrypt repository that may not be
@@ -546,11 +547,11 @@ makeSshRepo rs sshdata
 	setup r = do
 		m <- readRemoteLog
 		let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m)
-		let c' = M.insert "location" (genSshUrl sshdata) $
-			M.insert "type" "git" $
-			case M.lookup nameField c of
+		let c' = M.insert (Proposed "location") (Proposed (genSshUrl sshdata)) $
+			M.insert typeField (Proposed "git") $
+			case fromProposedAccepted <$> M.lookup nameField c of
 				Just _ -> c
-				Nothing -> M.insert nameField (Remote.name r) c
+				Nothing -> M.insert nameField (Proposed (Remote.name r)) c
 		configSet (Remote.uuid r) c'
 
 makeSshRepoConnection :: RepoStatus -> Annex RemoteName -> (Remote -> Annex ()) -> Handler Html

Assistant/WebApp/Configurators/WebDAV.hs

@@ -15,13 +15,14 @@ import Creds
 import qualified Remote.WebDAV as WebDAV
 import Assistant.WebApp.MakeRemote
 import qualified Remote
-import Types.Remote (RemoteConfig)
+import Types.Remote (RemoteConfig, configParser)
 import Types.StandardGroups
 import Logs.Remote
 import Git.Types (RemoteName)
 import Assistant.Gpg
 import Types.GitConfig
 import Annex.SpecialRemote.Config
+import Types.ProposedAccepted
 
 import qualified Data.Map as M
 #endif
@@ -58,10 +59,12 @@ postEnableWebDAVR uuid = do
 	m <- liftAnnex readRemoteLog
 	let c = fromJust $ M.lookup uuid m
 	let name = fromJust $ lookupName c
-	let url = fromJust $ M.lookup "url" c
+	let url = fromProposedAccepted $ fromJust $ M.lookup (Accepted "url") c
 	mcreds <- liftAnnex $ do
 		dummycfg <- liftIO dummyRemoteGitConfig
-		getRemoteCredPairFor "webdav" c dummycfg (WebDAV.davCreds uuid)
+		pc <- either mempty id . parseRemoteConfig c
+			<$> configParser WebDAV.remote c
+		getRemoteCredPairFor "webdav" pc dummycfg (WebDAV.davCreds uuid)
 	case mcreds of
 		Just creds -> webDAVConfigurator $ liftH $
 			makeWebDavRemote enableSpecialRemote name creds M.empty

Assistant/WebApp/RepoList.hs

@@ -26,6 +26,7 @@ import Assistant.Sync
 import Config.Cost
 import Utility.NotificationBroadcaster
 import qualified Git
+import Types.ProposedAccepted
 
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -175,7 +176,7 @@ repoList reposelector
 	selectedremote (Just (iscloud, _))
 		| onlyCloud reposelector = iscloud
 		| otherwise = True
-	findinfo m g u = case getconfig "type" of
+	findinfo m g u = case fromProposedAccepted <$> getconfig (Accepted "type") of
 		Just "rsync" -> val True EnableRsyncR
 		Just "directory" -> val False EnableDirectoryR
 #ifdef WITH_S3
@@ -188,12 +189,12 @@ repoList reposelector
 		Just "gcrypt" ->
 			-- Skip gcrypt repos on removable drives;
 			-- handled separately.
-			case getconfig "gitrepo" of
+			case fromProposedAccepted <$> getconfig (Accepted "gitrepo") of
 				Just rr	| remoteLocationIsUrl (parseRemoteLocation rr g) ->
 					val True EnableSshGCryptR
 				_ -> Nothing
 		Just "git" -> 
-			case getconfig "location" of
+			case fromProposedAccepted <$> getconfig (Accepted "location") of
 				Just loc | remoteLocationIsSshUrl (parseRemoteLocation loc g) ->
 					val True EnableSshGitRemoteR
 				_ -> Nothing

CHANGELOG

@@ -1,4 +1,4 @@
-git-annex (8.20191107) UNRELEASED; urgency=medium
+git-annex (8.20200221) UNRELEASED; urgency=medium
 
   * New v8 repository version.
   * v7 upgrades automatically to v8.
@@ -23,13 +23,72 @@ git-annex (8.20191107) UNRELEASED; urgency=medium
 
  -- Joey Hess <id@joeyh.name>  Tue, 29 Oct 2019 15:13:03 -0400
 
-git-annex (7.20191231) UNRELEASED; urgency=medium
+git-annex (7.20200220) UNRELEASED; urgency=medium
+
+  * Bugfix: export --tracking (a deprecated option) set 
+    annex-annex-tracking-branch, instead of annex-tracking-branch.
+  * initremote, enableremote: Set remote.name.skipFetchAll when
+    the remote cannot be fetched from by git, so git fetch --all
+    will not try to use it.
+
+ -- Joey Hess <id@joeyh.name>  Wed, 19 Feb 2020 12:48:58 -0400
+
+git-annex (7.20200219) upstream; urgency=medium
+
+  * Added sync --only-annex, which syncs the git-annex branch and annexed
+    content but leaves managing the other git branches up to you.
+  * Added annex.synconlyannex git config setting, which can also be set with
+    git-annex config to configure sync in all clones of the repo.
+  * fsck --from remote: Fix a concurrency bug that could make it incorrectly
+    detect that content in the remote is corrupt, and remove it, resulting in
+    data loss.
+  * When git-annex is built with a ssh that does not support ssh connection
+    caching, default annex.sshcaching to false, but let the user override it.
+  * Improve warning messages further when ssh connection caching cannot
+    be used, to clearly state why.
+  * Avoid throwing fatal errors when asked to write to a readonly
+    git remote on http.
+  * Fix support for repositories tuned with annex.tune.branchhash1=true,
+    including --all not working and git-annex log not displaying anything
+    for annexed files.
+
+ -- Joey Hess <id@joeyh.name>  Wed, 19 Feb 2020 12:44:43 -0400
+
+git-annex (7.20200204) upstream; urgency=medium
+
+  * Fix build with persistent-template 2.8.0.
+  * Makefile: Really move the fish completion to the
+    vendor_completions.d directory.
+
+ -- Joey Hess <id@joeyh.name>  Tue, 04 Feb 2020 14:30:55 -0400
+
+git-annex (7.20200202.7) upstream; urgency=medium
 
   * add: --force-annex/--force-git options make it easier to override
     annex.largefiles configuration (and potentially safer as it avoids
     bugs like the smudge bug fixed in the last release).
+  * reinject --known: Fix bug that prevented it from working in a bare repo.
+  * Support being used in a git repository that uses sha256 rather than sha1.
+  * initremote, enableremote: Be stricter about rejecting invalid
+    configuration parameters for remotes, particularly things like foo=true
+    when foo=yes is expected.
+  * initremote, enableremote: Reject unknown configuration parameters
+    provided to these commands.
+  * initremote: Added --whatelse option, to show additional
+    configuration parameters you might want to set. Eg:
+    git annex initremote type=directory encryption=none --whatelse
+  * Added LISTCONFIGS to external special remote protocol. Special remote
+    programs that use GETCONFIG/SETCONFIG are recommended to implement it.
+  * init: Avoid an ugly error message when http remote has no git-annex
+    uuid configured.
+  * Support git remotes that need http basic auth to be accessed,
+    using git credential to get the password.
+  * Display a warning when concurrency is enabled but ssh connection caching
+    is not enabled or won't work due to a crippled filesystem.
+  * Makefile: Move the fish completion to the vendor_completions.d directory.
+  * Fixed a test suite failure when run in the C locale.
 
- -- Joey Hess <id@joeyh.name>  Wed, 01 Jan 2020 12:51:40 -0400
+ -- Joey Hess <id@joeyh.name>  Sun, 02 Feb 2020 00:00:00 -0400
 
 git-annex (7.20191230) upstream; urgency=medium
 

COPYRIGHT

@@ -2,7 +2,7 @@ Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
 Source: native package
 
 Files: *
-Copyright: © 2010-2019 Joey Hess <id@joeyh.name>
+Copyright: © 2010-2020 Joey Hess <id@joeyh.name>
 License: AGPL-3+
 
 Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/*

CmdLine/Usage.hs

@@ -96,8 +96,8 @@ paramItem :: String
 paramItem = "ITEM"
 paramTreeish :: String
 paramTreeish = "TREEISH"
-paramKeyValue :: String
-paramKeyValue = "K=V"
+paramParamValue :: String
+paramParamValue = "PARAM=VALUE"
 paramNothing :: String
 paramNothing = ""
 paramRepeating :: String -> String

Command/AddUrl.hs

@@ -261,7 +261,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
 	go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just (toRawFilePath file)))
   where
 	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing
-	downloader f p = downloadUrl urlkey p [url] f
+	downloader f p = Url.withUrlOptions $ downloadUrl urlkey p [url] f
 	go Nothing = return Nothing
 	-- If we downloaded a html file, try to use youtube-dl to
 	-- extract embedded media.

Command/EnableRemote.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2013-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -24,13 +24,15 @@ import Annex.UUID
 import Config
 import Config.DynamicConfig
 import Types.GitConfig
+import Types.ProposedAccepted
+import Git.Config
 
 import qualified Data.Map as M
 
 cmd :: Command
 cmd = command "enableremote" SectionSetup
 	"enables git-annex to use a remote"
-	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
+	(paramPair paramName $ paramOptional $ paramRepeating paramParamValue)
 	(withParams seek)
 
 seek :: CmdParams -> CommandSeek
@@ -41,7 +43,7 @@ start [] = unknownNameError "Specify the remote to enable."
 start (name:rest) = go =<< filter matchingname <$> Annex.getGitRemotes
   where
 	matchingname r = Git.remoteName r == Just name
-	go [] = startSpecialRemote name (Logs.Remote.keyValToConfig rest)
+	go [] = startSpecialRemote name (Logs.Remote.keyValToConfig Proposed rest)
 		=<< SpecialRemote.findExisting name
 	go (r:_) = do
 		-- This could be either a normal git remote or a special
@@ -85,21 +87,23 @@ startSpecialRemote name config (Just (u, c, mcu)) =
 performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandPerform
 performSpecialRemote t u oldc c gc mcu = do
 	(c', u') <- R.setup t (R.Enable oldc) (Just u) Nothing c gc
-	next $ cleanupSpecialRemote u' c' mcu
+	next $ cleanupSpecialRemote t u' c' mcu
 
-cleanupSpecialRemote :: UUID -> R.RemoteConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandCleanup
-cleanupSpecialRemote u c mcu = do
+cleanupSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandCleanup
+cleanupSpecialRemote t u c mcu = do
 	case mcu of
 		Nothing -> 
 			Logs.Remote.configSet u c
 		Just (SpecialRemote.ConfigFrom cu) -> do
-			setConfig (remoteConfig c "config-uuid") (fromUUID cu)
+			setConfig (remoteAnnexConfig c "config-uuid") (fromUUID cu)
 			Logs.Remote.configSet cu c
 	Remote.byUUID u >>= \case
 		Nothing -> noop
 		Just r -> do
 			repo <- R.getRepo r
 			setRemoteIgnore repo False
+	unless (Remote.gitSyncableRemoteType t) $
+		setConfig (remoteConfig c "skipFetchAll") (boolConfig True)
 	return True
 
 unknownNameError :: String -> Annex a

Command/Export.hs

@@ -81,7 +81,7 @@ seek o = do
 	
 	-- handle deprecated option
 	when (exportTracking o) $
-		setConfig (remoteConfig r "annex-tracking-branch")
+		setConfig (remoteAnnexConfig r "tracking-branch")
 			(fromRef $ exportTreeish o)
 	
 	tree <- filterPreferredContent r =<<
@@ -216,7 +216,7 @@ mkDiffMap old new db = do
 			, (, (Nothing, Just (Git.DiffTree.file i))) <$> dstek
 			]
 	getek sha
-		| sha == nullSha = return Nothing
+		| sha `elem` nullShas = return Nothing
 		| otherwise = Just <$> exportKey sha
 
 newtype FileUploaded = FileUploaded { fromFileUploaded :: Bool }
@@ -310,7 +310,7 @@ cleanupExport r db ek loc sent = do
 
 startUnexport :: Remote -> ExportHandle -> TopFilePath -> [Git.Sha] -> CommandStart
 startUnexport r db f shas = do
-	eks <- forM (filter (/= nullSha) shas) exportKey
+	eks <- forM (filter (`notElem` nullShas) shas) exportKey
 	if null eks
 		then stop
 		else starting ("unexport " ++ name r) (ActionItemOther (Just (fromRawFilePath f'))) $
@@ -359,7 +359,7 @@ cleanupUnexport r db eks loc = do
 
 startRecoverIncomplete :: Remote -> ExportHandle -> Git.Sha -> TopFilePath -> CommandStart
 startRecoverIncomplete r db sha oldf
-	| sha == nullSha = stop
+	| sha `elem` nullShas = stop
 	| otherwise = do
 		ek <- exportKey sha
 		let loc = exportTempName ek

Command/Fsck.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -161,6 +161,11 @@ performRemote key afile backend numcopies remote =
 		]
 	ai = mkActionItem (key, afile)
 	withtmp a = do
+		-- Put it in the gitAnnexTmpObjectDir since that's on a
+		-- filesystem where object temp files are normally
+		-- stored. The pid prevents multiple fsck processes
+		-- contending over the same file. (Multiple threads cannot,
+		-- because OnlyActionOn is used.)
 		pid <- liftIO getPID
 		t <- fromRepo gitAnnexTmpObjectDir
 		createAnnexDirectory t
@@ -541,7 +546,7 @@ badContentRemote remote localcopy key = do
 
 runFsck :: Incremental -> ActionItem -> Key -> Annex Bool -> CommandStart
 runFsck inc ai key a = stopUnless (needFsck inc key) $
-	starting "fsck" ai $ do
+	starting "fsck" (OnlyActionOn key ai) $ do
 		ok <- a
 		when ok $
 			recordFsckTime inc key

Command/InitRemote.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - 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.
  -}
@@ -16,27 +16,36 @@ import Annex.SpecialRemote
 import qualified Remote
 import qualified Logs.Remote
 import qualified Types.Remote as R
+import Types.RemoteConfig
 import Annex.UUID
 import Logs.UUID
 import Logs.Remote
 import Types.GitConfig
+import Types.ProposedAccepted
 import Config
+import Git.Config
 
 cmd :: Command
 cmd = command "initremote" SectionSetup
 	"creates a special (non-git) remote"
-	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
+	(paramPair paramName $ paramOptional $ paramRepeating paramParamValue)
 	(seek <$$> optParser)
 
 data InitRemoteOptions = InitRemoteOptions
 	{ cmdparams :: CmdParams
 	, sameas :: Maybe (DeferredParse UUID)
+	, whatElse :: Bool
 	}
 
 optParser :: CmdParamsDesc -> Parser InitRemoteOptions
 optParser desc = InitRemoteOptions
 	<$> cmdParams desc
 	<*> optional parseSameasOption
+	<*> switch
+		( long "whatelse"
+		<> short 'w'
+		<> help "describe other configuration parameters for a special remote"
+		)
 
 parseSameasOption :: Parser (DeferredParse UUID)
 parseSameasOption = parseUUIDOption <$> strOption
@@ -63,35 +72,67 @@ start o (name:ws) = ifM (isJust <$> findExisting name)
 					(Just . Sameas <$$> getParsed)
 					(sameas o) 
 				c <- newConfig name sameasuuid
-					(Logs.Remote.keyValToConfig ws)
+					(Logs.Remote.keyValToConfig Proposed ws)
 					<$> readRemoteLog
 				t <- either giveup return (findType c)
-				starting "initremote" (ActionItemOther (Just name)) $
-					perform t name c o
+				if whatElse o
+					then startingCustomOutput (ActionItemOther Nothing) $
+						describeOtherParamsFor c t
+					else starting "initremote" (ActionItemOther (Just name)) $
+						perform t name c o
 			)
 	)
 
 perform :: RemoteType -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandPerform
 perform t name c o = do
 	dummycfg <- liftIO dummyRemoteGitConfig
-	(c', u) <- R.setup t R.Init (sameasu <|> uuidfromuser) Nothing c dummycfg
-	next $ cleanup u name c' o
+	let c' = M.delete uuidField c
+	(c'', u) <- R.setup t R.Init (sameasu <|> uuidfromuser) Nothing c' dummycfg
+	next $ cleanup t u name c'' o
   where
-	uuidfromuser = case M.lookup "uuid" c of
+	uuidfromuser = case fromProposedAccepted <$> M.lookup uuidField c of
 		Just s
 			| isUUID s -> Just (toUUID s)
 			| otherwise -> giveup "invalid uuid"
 		Nothing -> Nothing
-	sameasu = toUUID <$> M.lookup sameasUUIDField c
+	sameasu = toUUID . fromProposedAccepted <$> M.lookup sameasUUIDField c
 
-cleanup :: UUID -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandCleanup
-cleanup u name c o = do
+uuidField :: R.RemoteConfigField
+uuidField = Accepted "uuid"
+
+cleanup :: RemoteType -> UUID -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandCleanup
+cleanup t u name c o = do
 	case sameas o of
 		Nothing -> do
 			describeUUID u (toUUIDDesc name)
 			Logs.Remote.configSet u c
 		Just _ -> do
 			cu <- liftIO genUUID
-			setConfig (remoteConfig c "config-uuid") (fromUUID cu)
+			setConfig (remoteAnnexConfig c "config-uuid") (fromUUID cu)
 			Logs.Remote.configSet cu c
+	unless (Remote.gitSyncableRemoteType t) $
+		setConfig (remoteConfig c "skipFetchAll") (boolConfig True)
 	return True
+
+describeOtherParamsFor :: RemoteConfig -> RemoteType -> CommandPerform
+describeOtherParamsFor c t = do
+	cp <- R.configParser t c
+	let l = map mk (filter notinconfig $ remoteConfigFieldParsers cp)
+		++ map mk' (maybe [] snd (remoteConfigRestPassthrough cp))
+	liftIO $ forM_ l $ \(p, fd, vd) -> case fd of
+		HiddenField -> return ()
+		FieldDesc d -> do
+			putStrLn p
+			putStrLn ("\t" ++ d)
+			case vd of
+				Nothing -> return ()
+				Just (ValueDesc d') ->
+					putStrLn $ "\t(" ++ d' ++ ")"
+	next $ return True
+  where
+	notinconfig fp = not (M.member (parserForField fp) c)
+	mk fp = ( fromProposedAccepted (parserForField fp)
+		, fieldDesc fp
+		, valueDesc fp
+		)
+	mk' (k, v) = (k, v, Nothing)

Command/Log.hs

@@ -210,17 +210,18 @@ getAllLog = getGitLog []
 
 getGitLog :: [FilePath] -> [CommandParam] -> Annex ([RefChange], IO Bool)
 getGitLog fs os = do
+	config <- Annex.getGitConfig
 	(ls, cleanup) <- inRepo $ pipeNullSplit $
 		[ Param "log"
 		, Param "-z"
 		, Param "--pretty=format:%ct"
 		, Param "--raw"
-		, Param "--abbrev=40"
+		, Param "--no-abbrev"
 		] ++ os ++
 		[ Param $ Git.fromRef Annex.Branch.fullname
 		, Param "--"
 		] ++ map Param fs
-	return (parseGitRawLog (map decodeBL' ls), cleanup)
+	return (parseGitRawLog config (map decodeBL' ls), cleanup)
 
 -- Parses chunked git log --raw output, which looks something like:
 --
@@ -236,8 +237,8 @@ getGitLog fs os = do
 --
 -- The timestamp is not included before all changelines, so
 -- keep track of the most recently seen timestamp.
-parseGitRawLog :: [String] -> [RefChange]
-parseGitRawLog = parse epoch
+parseGitRawLog :: GitConfig -> [String] -> [RefChange]
+parseGitRawLog config = parse epoch
   where
 	epoch = toEnum 0 :: POSIXTime
 	parse oldts ([]:rest) = parse oldts rest
@@ -250,7 +251,7 @@ parseGitRawLog = parse epoch
 			(tss, cl') -> (parseTimeStamp tss, cl')
 	  	mrc = do
 			(old, new) <- parseRawChangeLine cl
-			key <- locationLogFileKey (toRawFilePath c2)
+			key <- locationLogFileKey config (toRawFilePath c2)
 			return $ RefChange
 				{ changetime = ts
 				, oldref = old

Command/Merge.hs

@@ -12,7 +12,7 @@ import qualified Annex.Branch
 import qualified Git
 import qualified Git.Branch
 import Annex.CurrentBranch
-import Command.Sync (prepMerge, mergeLocal, mergeConfig, merge)
+import Command.Sync (prepMerge, mergeLocal, mergeConfig, merge, SyncOptions(..))
 
 cmd :: Command
 cmd = command "merge" SectionMaintenance
@@ -41,4 +41,5 @@ mergeSyncedBranch = mergeLocal mergeConfig def =<< getCurrentBranch
 mergeBranch :: Git.Ref -> CommandStart
 mergeBranch r = starting "merge" (ActionItemOther (Just (Git.fromRef r))) $ do
 	currbranch <- getCurrentBranch
-	next $ merge currbranch mergeConfig def Git.Branch.ManualCommit r
+	let o = def { notOnlyAnnexOption = True }
+	next $ merge currbranch mergeConfig o Git.Branch.ManualCommit r

Command/P2P.hs

@@ -320,7 +320,7 @@ setupLink remotename (P2PAddressAuth addr authtoken) = do
 			, Param (formatP2PAddress addr)
 			]
 		when ok $ do
-			storeUUIDIn (remoteConfig remotename "uuid") theiruuid
+			storeUUIDIn (remoteAnnexConfig remotename "uuid") theiruuid
 			storeP2PRemoteAuthToken addr authtoken
 		return LinkSuccess
 	go (Right Nothing) = return $ AuthenticationError "Unable to authenticate with peer. Please check the address and try again."

Command/PostReceive.hs

@@ -14,7 +14,7 @@ import qualified Annex
 import Git.Types
 import Annex.UpdateInstead
 import Annex.CurrentBranch
-import Command.Sync (mergeLocal, prepMerge, mergeConfig)
+import Command.Sync (mergeLocal, prepMerge, mergeConfig, SyncOptions(..))
 
 -- This does not need to modify the git-annex branch to update the 
 -- work tree, but auto-initialization might change the git-annex branch.
@@ -51,4 +51,5 @@ fixPostReceiveHookEnv = do
 updateInsteadEmulation :: CommandStart
 updateInsteadEmulation = do
 	prepMerge
-	mergeLocal mergeConfig def =<< getCurrentBranch
+	let o = def { notOnlyAnnexOption = True }
+	mergeLocal mergeConfig o =<< getCurrentBranch

Command/Reinject.hs

@@ -13,6 +13,7 @@ import Annex.Content
 import Backend
 import Types.KeySource
 import Utility.Metered
+import qualified Git
 
 cmd :: Command
 cmd = command "reinject" SectionUtility 
@@ -65,8 +66,13 @@ startKnown src = notAnnexed src $
 				)
 
 notAnnexed :: FilePath -> CommandStart -> CommandStart
-notAnnexed src = ifAnnexed (toRawFilePath src) $
-	giveup $ "cannot used annexed file as src: " ++ src
+notAnnexed src a = 
+	ifM (fromRepo Git.repoIsLocalBare)
+		( a
+		, ifAnnexed (toRawFilePath src)
+			(giveup $ "cannot used annexed file as src: " ++ src)
+			a
+		)
 
 perform :: FilePath -> Key -> CommandPerform
 perform src key = ifM move

Command/RenameRemote.hs

@@ -13,6 +13,7 @@ import Annex.SpecialRemote.Config (nameField, sameasNameField)
 import qualified Logs.Remote
 import qualified Types.Remote as R
 import qualified Remote
+import Types.ProposedAccepted
 
 import qualified Data.Map as M
 
@@ -50,6 +51,6 @@ perform u cfg mcu newname = do
 	let (namefield, cu) = case mcu of
 		Nothing -> (nameField, u)
 		Just (Annex.SpecialRemote.ConfigFrom u') -> (sameasNameField, u')
-	Logs.Remote.configSet cu (M.insert namefield newname cfg)
+	Logs.Remote.configSet cu (M.insert namefield (Proposed newname) cfg)
 	
 	next $ return True

Command/Sync.hs

@@ -1,7 +1,7 @@
 {- git-annex command
  -
  - Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
- - 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 @@ module Command.Sync (
 	syncBranch,
 	updateBranches,
 	seekExportContent,
+	SyncOptions(..),
 ) where
 
 import Command
@@ -43,6 +44,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
@@ -77,8 +79,10 @@ cmd = withGlobalOptions [jobsOption] $
 		"synchronize local repository with remotes"
 		(paramRepeating paramRemote) (seek <--< optParser)
 
-data SyncOptions  = SyncOptions
+data SyncOptions = SyncOptions
 	{ syncWith :: CmdParams
+	, onlyAnnexOption :: Bool
+	, notOnlyAnnexOption :: Bool
 	, commitOption :: Bool
 	, noCommitOption :: Bool
 	, messageOption :: Maybe String
@@ -89,13 +93,26 @@ data SyncOptions  = SyncOptions
 	, contentOfOption :: [FilePath]
 	, cleanupOption :: Bool
 	, keyOptions :: Maybe KeyOptions
-	, resolveMergeOverride :: ResolveMergeOverride
+	, resolveMergeOverride :: Bool
 	}
 
-newtype ResolveMergeOverride = ResolveMergeOverride Bool
-
-instance Default ResolveMergeOverride where
-	def = ResolveMergeOverride False
+instance Default SyncOptions where
+	def = SyncOptions
+		{ syncWith = []
+		, onlyAnnexOption = False
+		, notOnlyAnnexOption = False
+		, commitOption = False
+		, noCommitOption = False
+		, messageOption = Nothing
+		, pullOption = False
+		, pushOption = False
+		, contentOption = False
+		, noContentOption = False
+		, contentOfOption = []
+		, cleanupOption = False
+		, keyOptions = Nothing
+		, resolveMergeOverride = False
+		}
 
 optParser :: CmdParamsDesc -> Parser SyncOptions
 optParser desc = SyncOptions
@@ -103,6 +120,15 @@ optParser desc = SyncOptions
 		( metavar desc
 		<> completeRemotes
 		))
+	<*> switch 
+		( long "only-annex"
+		<> short 'a'
+		<> help "only sync git-annex branch and annexed file contents"
+		)
+	<*> switch 
+		( long "not-only-annex"
+		<> help "sync git branches as well as annex"
+		)
 	<*> switch
 		( long "commit"
 		<> help "commit changes to git"
@@ -123,16 +149,16 @@ optParser desc = SyncOptions
 		)
 	<*> switch 
 		( long "content"
-		<> help "transfer file contents" 
+		<> help "transfer annexed file contents" 
 		)
 	<*> switch
 		( long "no-content"
-		<> help "do not transfer file contents"
+		<> help "do not transfer annexed file contents"
 		)
 	<*> many (strOption
 		( long "content-of"
 		<> short 'C'
-		<> help "transfer file contents of files in a given location"
+		<> help "transfer contents of annexed files in a given location"
 		<> metavar paramPath
 		))
 	<*> switch
@@ -140,15 +166,17 @@ optParser desc = SyncOptions
 		<> help "remove synced/ branches from previous sync"
 		)
 	<*> optional parseAllOption
-	<*> (ResolveMergeOverride <$> invertableSwitch "resolvemerge" True
+	<*> invertableSwitch "resolvemerge" True
 		( help "do not automatically resolve merge conflicts"
-		))
+		)
 
 -- Since prepMerge changes the working directory, FilePath options
 -- have to be adjusted.
 instance DeferredParseClass SyncOptions where
 	finishParse v = SyncOptions
 		<$> pure (syncWith v)
+		<*> pure (onlyAnnexOption v)
+		<*> pure (notOnlyAnnexOption v)
 		<*> pure (commitOption v)
 		<*> pure (noCommitOption v)
 		<*> pure (messageOption v)
@@ -171,7 +199,7 @@ seek' o = do
 	let withbranch a = a =<< getCurrentBranch
 
 	remotes <- syncRemotes (syncWith o)
-	let gitremotes = filter Remote.gitSyncableRemote remotes
+	let gitremotes = filter (Remote.gitSyncableRemoteType . Remote.remotetype) remotes
 	dataremotes <- filter (\r -> Remote.uuid r /= NoUUID)
 		<$> filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) remotes
 	let (exportremotes, keyvalueremotes) = partition (exportTree . Remote.config) dataremotes
@@ -188,12 +216,12 @@ seek' o = do
 			-- These actions cannot be run concurrently.
 			mapM_ includeCommandAction $ concat
 				[ [ commit o ]
-				, [ withbranch (mergeLocal mergeConfig (resolveMergeOverride o)) ]
+				, [ withbranch (mergeLocal mergeConfig o) ]
 				, map (withbranch . pullRemote o mergeConfig) gitremotes
 				,  [ mergeAnnex ]
 				]
 				
-			whenM shouldsynccontent $ do
+			whenM (shouldSyncContent o) $ do
 				mapM_ (withbranch . importRemote o mergeConfig) importremotes
 			
 				-- Send content to any exports before other
@@ -214,13 +242,9 @@ seek' o = do
 						, [ commitAnnex, mergeAnnex ]
 						]
 	
-			void $ includeCommandAction $ withbranch pushLocal
+			void $ includeCommandAction $ withbranch $ pushLocal o
 			-- Pushes to remotes can run concurrently.
 			mapM_ (commandAction . withbranch . pushRemote o) gitremotes
-  where
-	shouldsynccontent = pure (contentOption o)
-		<||> pure (not (null (contentOfOption o)))
-		<||> (pure (not (noContentOption o)) <&&> getGitConfigVal annexSyncContent)
 
 {- Merging may delete the current directory, so go to the top
  - of the repo. This also means that sync always acts on all files in the
@@ -240,14 +264,14 @@ mergeConfig =
 	, Git.Merge.MergeUnrelatedHistories
 	]
 
-merge :: CurrBranch -> [Git.Merge.MergeConfig] -> ResolveMergeOverride -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
-merge currbranch mergeconfig resolvemergeoverride commitmode tomerge = case currbranch of
+merge :: CurrBranch -> [Git.Merge.MergeConfig] -> SyncOptions -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
+merge currbranch mergeconfig o commitmode tomerge = case currbranch of
 	(Just b, Just adj) -> mergeToAdjustedBranch tomerge (b, adj) mergeconfig canresolvemerge commitmode
 	(b, _) -> autoMergeFrom tomerge b mergeconfig canresolvemerge commitmode
   where
-	canresolvemerge = case resolvemergeoverride of
-		ResolveMergeOverride True -> getGitConfigVal annexResolveMerge
-		ResolveMergeOverride False -> return False
+	canresolvemerge = if resolveMergeOverride o
+		then getGitConfigVal annexResolveMerge
+		else return False
 
 syncBranch :: Git.Branch -> Git.Branch
 syncBranch = Git.Ref.underBase "refs/heads/synced" . fromAdjustedBranch
@@ -276,7 +300,7 @@ syncRemotes' ps available =
 	listed = concat <$> mapM Remote.byNameOrGroup ps
 	
 	good r
-		| Remote.gitSyncableRemote r =
+		| Remote.gitSyncableRemoteType (Remote.remotetype r) =
 			Remote.Git.repoAvail =<< Remote.getRepo r
 		| otherwise = return True
 	
@@ -295,8 +319,10 @@ commit o = stopUnless shouldcommit $ starting "commit" (ActionItemOther Nothing)
 			]
 		return True
   where
-	shouldcommit = pure (commitOption o)
+	shouldcommit = notOnlyAnnex o <&&>
+		( pure (commitOption o)
 		<||> (pure (not (noCommitOption o)) <&&> getGitConfigVal annexAutoCommit)
+		)
 
 commitMsg :: Annex String
 commitMsg = do
@@ -315,14 +341,18 @@ commitStaged commitmode commitmessage = do
 	void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch parents
 	return True
 
-mergeLocal :: [Git.Merge.MergeConfig] -> ResolveMergeOverride -> CurrBranch -> CommandStart
-mergeLocal mergeconfig resolvemergeoverride currbranch@(Just _, _) =
+mergeLocal :: [Git.Merge.MergeConfig] -> SyncOptions -> CurrBranch -> CommandStart
+mergeLocal mergeconfig o currbranch = stopUnless (notOnlyAnnex o) $
+	mergeLocal' mergeconfig o currbranch
+
+mergeLocal' :: [Git.Merge.MergeConfig] -> SyncOptions -> CurrBranch -> CommandStart
+mergeLocal' mergeconfig o currbranch@(Just _, _) =
 	needMerge currbranch >>= \case
 		Nothing -> stop
 		Just syncbranch ->
 			starting "merge" (ActionItemOther (Just $ Git.Ref.describe syncbranch)) $
-				next $ merge currbranch mergeconfig resolvemergeoverride Git.Branch.ManualCommit syncbranch
-mergeLocal _ _ (Nothing, madj) = do
+				next $ merge currbranch mergeconfig o Git.Branch.ManualCommit syncbranch
+mergeLocal' _ _ (Nothing, madj) = do
 	b <- inRepo Git.Branch.currentUnsafe
 	needMerge (b, madj) >>= \case
 		Nothing -> stop
@@ -347,8 +377,8 @@ needMerge (Just branch, madj) = ifM (allM id checks)
 	syncbranch = syncBranch branch
 	branch' = maybe branch (adjBranch . originalToAdjusted branch) madj
 
-pushLocal :: CurrBranch -> CommandStart
-pushLocal b = do
+pushLocal :: SyncOptions -> CurrBranch -> CommandStart
+pushLocal o b = stopUnless (notOnlyAnnex o) $ do
 	updateBranches b
 	stop
 
@@ -387,16 +417,25 @@ pullRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch ->
 pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && wantpull) $
 	starting "pull" (ActionItemOther (Just (Remote.name remote))) $ do
 		showOutput
-		ifM fetch
-			( next $ mergeRemote remote branch mergeconfig (resolveMergeOverride o)
-			, next $ return True
+		ifM (onlyAnnex o)
+			( do
+				void $ fetch $ map Git.fromRef 
+					[ Annex.Branch.name
+					, syncBranch $ Annex.Branch.name
+					]
+				next $ return True
+			, ifM (fetch [])
+				( next $ mergeRemote remote branch mergeconfig o
+				, next $ return True
+				)
 			)
   where
-	fetch = do
+	fetch bs = do
 		repo <- Remote.getRepo remote
 		inRepoWithSshOptionsTo repo (Remote.gitconfig remote) $
-			Git.Command.runBool
+			Git.Command.runBool $
 				[Param "fetch", Param $ Remote.name remote]
+					++ map Param bs
 	wantpull = remoteAnnexPull (Remote.gitconfig remote)
 
 importRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandSeek
@@ -411,8 +450,7 @@ importRemote o mergeconfig remote currbranch
 				then Nothing
 				else Just (asTopFilePath (toRawFilePath s))
 			Command.Import.seekRemote remote branch subdir
-			void $ mergeRemote remote currbranch mergeconfig
-				(resolveMergeOverride o)
+			void $ mergeRemote remote currbranch mergeconfig o
   where
 	wantpull = remoteAnnexPull (Remote.gitconfig remote)
 
@@ -421,8 +459,8 @@ importRemote o mergeconfig remote currbranch
  - were committed (or pushed changes, if this is a bare remote),
  - while the synced/master may have changes that some
  - other remote synced to this remote. So, merge them both. -}
-mergeRemote :: Remote -> CurrBranch -> [Git.Merge.MergeConfig] -> ResolveMergeOverride -> CommandCleanup
-mergeRemote remote currbranch mergeconfig resolvemergeoverride = ifM isBareRepo
+mergeRemote :: Remote -> CurrBranch -> [Git.Merge.MergeConfig] -> SyncOptions -> CommandCleanup
+mergeRemote remote currbranch mergeconfig o = ifM isBareRepo
 	( return True
 	, case currbranch of
 		(Nothing, _) -> do
@@ -434,31 +472,36 @@ mergeRemote remote currbranch mergeconfig resolvemergeoverride = ifM isBareRepo
 	)
   where
 	mergelisted getlist = and <$> 
-		(mapM (merge currbranch mergeconfig resolvemergeoverride Git.Branch.ManualCommit . remoteBranch remote) =<< getlist)
+		(mapM (merge currbranch mergeconfig o Git.Branch.ManualCommit . remoteBranch remote) =<< getlist)
 	tomerge = filterM (changed remote)
 	branchlist Nothing = []
 	branchlist (Just branch) = [fromAdjustedBranch branch, syncBranch branch]
 
 pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
 pushRemote _o _remote (Nothing, _) = stop
-pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $
-	starting "push" (ActionItemOther (Just (Remote.name remote))) $ next $ do
-		repo <- Remote.getRepo remote
-		showOutput
-		ok <- inRepoWithSshOptionsTo repo gc $
-			pushBranch remote branch
-		if ok
-			then postpushupdate repo
-			else do
-				warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
-				showLongNote "(non-fast-forward problems can be solved by setting receive.denyNonFastforwards to false in the remote's git config)"
-				return ok
+pushRemote o remote (Just branch, _) = do
+	onlyannex <- onlyAnnex o
+	let mainbranch = if onlyannex then Nothing else Just branch
+	stopUnless (pure (pushOption o) <&&> needpush mainbranch) $
+		starting "push" (ActionItemOther (Just (Remote.name remote))) $ next $ do
+			repo <- Remote.getRepo remote
+			showOutput
+			ok <- inRepoWithSshOptionsTo repo gc $
+				pushBranch remote mainbranch
+			if ok
+				then postpushupdate repo
+				else do
+					warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
+					return ok
   where
 	gc = Remote.gitconfig remote
-	needpush
+	needpush mainbranch
 		| remoteAnnexReadOnly gc = return False
 		| not (remoteAnnexPush gc) = return False
-		| otherwise = anyM (newer remote) [syncBranch branch, Annex.Branch.name]
+		| otherwise = anyM (newer remote) $ catMaybes
+			[ syncBranch <$> mainbranch
+			, Just (Annex.Branch.name)
+			]
 	-- Older remotes on crippled filesystems may not have a
 	-- post-receive hook set up, so when updateInstead emulation
 	-- is needed, run post-receive manually.
@@ -504,20 +547,18 @@ pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> need
  - But overwriting of data on synced/git-annex can happen, in a race.
  - The only difference caused by using a forced push in that case is that
  - the last repository to push wins the race, rather than the first to push.
- -
- - The sync push will fail to overwrite if receive.denyNonFastforwards is
- - set on the remote.
  -}
-pushBranch :: Remote -> Git.Branch -> Git.Repo -> IO Bool
-pushBranch remote branch g = directpush `after` annexpush `after` syncpush
+pushBranch :: Remote -> Maybe Git.Branch -> Git.Repo -> IO Bool
+pushBranch remote mbranch g = directpush `after` annexpush `after` syncpush
   where
-	syncpush = flip Git.Command.runBool g $ pushparams
-		[ Git.Branch.forcePush $ refspec Annex.Branch.name
-		, refspec $ fromAdjustedBranch branch
+	syncpush = flip Git.Command.runBool g $ pushparams $ catMaybes
+		[ Just $ Git.Branch.forcePush $ refspec Annex.Branch.name
+		, (refspec . fromAdjustedBranch) <$> mbranch
 		]
 	annexpush = void $ tryIO $ flip Git.Command.runQuiet g $ pushparams
 		[ Git.fromRef $ Git.Ref.base $ Annex.Branch.name ]
-	directpush = do
+	directpush = case mbranch of
+		Nothing -> noop
 		-- Git prints out an error message when this fails.
 		-- In the default configuration of receive.denyCurrentBranch,
 		-- the error message mentions that config setting
@@ -528,11 +569,12 @@ pushBranch remote branch g = directpush `after` annexpush `after` syncpush
 		-- including the error displayed when
 		-- receive.denyCurrentBranch=updateInstead -- the user
 		-- will want to see that one.
-		let p = flip Git.Command.gitCreateProcess g $ pushparams
-			[ Git.fromRef $ Git.Ref.base $ fromAdjustedBranch branch ]
-		(transcript, ok) <- processTranscript' p Nothing
-		when (not ok && not ("denyCurrentBranch" `isInfixOf` transcript)) $
-			hPutStr stderr transcript
+		Just branch -> do
+			let p = flip Git.Command.gitCreateProcess g $ pushparams
+				[ Git.fromRef $ Git.Ref.base $ fromAdjustedBranch branch ]
+			(transcript, ok) <- processTranscript' p Nothing
+			when (not ok && not ("denyCurrentBranch" `isInfixOf` transcript)) $
+				hPutStr stderr transcript
 	pushparams branches =
 		[ Param "push"
 		, Param $ Remote.name remote
@@ -746,7 +788,7 @@ seekExportContent o rs (currbranch, _) = or <$> forM rs go
 				]
 		_ -> noop
 	  where
-		gitconfig = show (remoteConfig r "tracking-branch")
+		gitconfig = show (remoteAnnexConfig r "tracking-branch")
 
 	fillexport _ _ [] _ = return False
 	fillexport r db (tree:[]) mtbcommitsha = do
@@ -783,3 +825,18 @@ cleanupRemote remote (Just b, _) =
 			, Param $ Git.fromRef $ syncBranch $
 				Git.Ref.base $ Annex.Branch.name
 			]
+  
+shouldSyncContent :: SyncOptions -> Annex Bool
+shouldSyncContent o
+	| noContentOption o = pure False
+	| contentOption o || not (null (contentOfOption o)) = pure True
+	| otherwise = getGitConfigVal annexSyncContent <||> onlyAnnex o
+
+notOnlyAnnex :: SyncOptions -> Annex Bool
+notOnlyAnnex o = not <$> onlyAnnex o
+
+onlyAnnex :: SyncOptions -> Annex Bool
+onlyAnnex o
+	| notOnlyAnnexOption o = pure False
+	| onlyAnnexOption o = pure True
+	| otherwise = getGitConfigVal annexSyncOnlyAnnex

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.
  -}
@@ -24,8 +24,12 @@ import Utility.DataUnits
 import Utility.CopyFile
 import Types.Messages
 import Types.Export
+import Types.Crypto
+import Types.RemoteConfig
+import Annex.SpecialRemote.Config (exportTreeField)
 import Remote.Helper.ExportImport
 import Remote.Helper.Chunked
+import Remote.Helper.Encryptable (describeEncryption, encryptionField, highRandomQualityField)
 import Git.Types
 
 import Test.Tasty
@@ -109,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", fromMaybe "none" (M.lookup "encryption" (Remote.config r'))]
+		, ["encryption", describeEncryption (Remote.config r')]
 		]
 	descexport k1 k2 = intercalate "; " $ map unwords
 		[ [ "exporttree=yes" ]
@@ -119,33 +123,35 @@ perform rs unavailrs exportr ks = do
 
 adjustChunkSize :: Remote -> Int -> Annex (Maybe Remote)
 adjustChunkSize r chunksize = adjustRemoteConfig r
-	(M.insert "chunk" (show chunksize))
+	(M.insert chunkField (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 "encryption" "none")
+	noenc <- adjustRemoteConfig r $
+		M.insert encryptionField (RemoteConfigValue NoneEncryption)
 	sharedenc <- adjustRemoteConfig r $
-		M.insert "encryption" "shared" .
-		M.insert "highRandomQuality" "false"
+		M.insert encryptionField (RemoteConfigValue SharedEncryption) .
+		M.insert highRandomQualityField (RemoteConfigValue False)
 	return $ catMaybes [noenc, sharedenc]
 
 -- Variant of a remote with exporttree disabled.
 disableExportTree :: Remote -> Annex Remote
 disableExportTree r = maybe (error "failed disabling exportree") return 
-		=<< adjustRemoteConfig r (M.delete "exporttree")
+		=<< adjustRemoteConfig r (M.delete exportTreeField)
 
 -- Variant of a remote with exporttree enabled.
 exportTreeVariant :: Remote -> Annex (Maybe Remote)
 exportTreeVariant r = ifM (Remote.isExportSupported r)
 	( adjustRemoteConfig r $
-		M.insert "encryption" "none" . M.insert "exporttree" "yes"
+		M.insert encryptionField (RemoteConfigValue NoneEncryption) . 
+		M.insert exportTreeField (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)

Command/Undo.hs

@@ -58,7 +58,7 @@ perform p = do
 	-- Take two passes through the diff, first doing any removals,
 	-- and then any adds. This order is necessary to handle eg, removing
 	-- a directory and replacing it with a file.
-	let (removals, adds) = partition (\di -> dstsha di == nullSha) diff'
+	let (removals, adds) = partition (\di -> dstsha di `elem` nullShas) diff'
 	let mkrel di = liftIO $ relPathCwdToFile $ fromRawFilePath $
 		fromTopFilePath (file di) g
 

Command/Unused.hs

@@ -267,7 +267,7 @@ withKeysReferencedDiff a getdiff extractsha = do
   where
   	go d = do
 		let sha = extractsha d
-		unless (sha == nullSha) $
+		unless (sha `elem` nullShas) $
 			catKey sha >>= maybe noop a
 
 {- Filters out keys that have an associated file that's not modified. -}

Config.hs

@@ -1,6 +1,6 @@
 {- Git configuration
  -
- - 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,9 +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 qualified Data.Map as M
 import qualified Data.ByteString as S
 
 type UnqualifiedConfigKey = S.ByteString
@@ -64,13 +62,14 @@ 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 $
-	"remote." <> encodeBS' (getRemoteName r) <> ".annex-" <> key
+	"remote." <> encodeBS' (getRemoteName r) <> "." <> key
+
+{- A per-remote config annex setting in git config. -}
+remoteAnnexConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
+remoteAnnexConfig r key = remoteConfig r ("annex-" <> key)
 
 {- A global annex setting in git config. -}
 annexConfig :: UnqualifiedConfigKey -> ConfigKey
@@ -86,22 +85,16 @@ remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
 remoteCost' = liftIO . getDynamicConfig . remoteAnnexCost
 
 setRemoteCost :: Git.Repo -> Cost -> Annex ()
-setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
+setRemoteCost r c = setConfig (remoteAnnexConfig r "cost") (show c)
 
 setRemoteAvailability :: Git.Repo -> Availability -> Annex ()
-setRemoteAvailability r c = setConfig (remoteConfig r "availability") (show c)
+setRemoteAvailability r c = setConfig (remoteAnnexConfig r "availability") (show c)
 
 setRemoteIgnore :: Git.Repo -> Bool -> Annex ()
-setRemoteIgnore r b = setConfig (remoteConfig r "ignore") (Git.Config.boolConfig b)
+setRemoteIgnore r b = setConfig (remoteAnnexConfig r "ignore") (Git.Config.boolConfig b)
 
 setRemoteBare :: Git.Repo -> Bool -> Annex ()
-setRemoteBare r b = setConfig (remoteConfig r "bare") (Git.Config.boolConfig b)
-
-exportTree :: Remote.RemoteConfig -> Bool
-exportTree c = fromMaybe False $ yesNo =<< M.lookup "exporttree" c
-
-importTree :: Remote.RemoteConfig -> Bool
-importTree c = fromMaybe False $ yesNo =<< M.lookup "importtree" c
+setRemoteBare r b = setConfig (remoteAnnexConfig r "bare") (Git.Config.boolConfig b)
 
 isBareRepo :: Annex Bool
 isBareRepo = fromRepo Git.repoIsLocalBare

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.
  -}
@@ -9,6 +9,7 @@ module Creds (
 	module Types.Creds,
 	CredPairStorage(..),
 	setRemoteCredPair,
+	setRemoteCredPair',
 	getRemoteCredPair,
 	getRemoteCredPairFor,
 	missingCredPairFor,
@@ -23,11 +24,14 @@ module Creds (
 import Annex.Common
 import qualified Annex
 import Types.Creds
+import Types.RemoteConfig
+import Annex.SpecialRemote.Config
 import Annex.Perms
 import Utility.FileMode
 import Crypto
 import Types.Remote (RemoteConfig, RemoteConfigField)
-import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher)
+import Types.ProposedAccepted
+import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher, parseEncryptionConfig)
 import Utility.Env (getEnv)
 
 import qualified Data.ByteString.Lazy.Char8 as L
@@ -53,32 +57,47 @@ data CredPairStorage = CredPairStorage
  - cipher. The EncryptionIsSetup is witness to that being the case.
  -}
 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
+setRemoteCredPair = setRemoteCredPair' id
+	(either (const mempty) id . parseEncryptionConfig)
+
+setRemoteCredPair'
+	:: (ProposedAccepted String -> a)
+	-> (M.Map RemoteConfigField a -> ParsedRemoteConfig)
+	-> EncryptionIsSetup
+	-> M.Map RemoteConfigField a
+	-> RemoteGitConfig
+	-> CredPairStorage
+	-> Maybe CredPair
+	-> Annex (M.Map RemoteConfigField a)
+setRemoteCredPair' mkval parseconfig encsetup c gc storage mcreds = case mcreds of
+	Nothing -> maybe (return c) (setRemoteCredPair' mkval parseconfig encsetup c gc storage . Just)
+		=<< getRemoteCredPair pc gc storage
 	Just creds
-		| embedCreds c ->
+		| embedCreds pc -> do
 			let key = credPairRemoteField storage
-			in storeconfig creds key =<< flip remoteCipher gc =<< localcache creds
-		| otherwise -> localcache creds
+			localcache creds
+			storeconfig creds key =<< remoteCipher pc gc
+		| otherwise -> do
+			localcache creds
+			return c
   where
-	localcache creds = do
-		writeCacheCredPair creds storage
-		return c
+	localcache creds = writeCacheCredPair creds storage
 
 	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 (toB64 s) c
+		return $ M.insert key (mkval (Accepted (toB64 s))) c
 	storeconfig creds key Nothing =
-		return $ M.insert key (toB64 $ encodeCredPair creds) c
+		return $ M.insert key (mkval (Accepted (toB64 $ encodeCredPair creds))) c
+	
+	pc = parseconfig c
 
 {- 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
@@ -86,7 +105,7 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
 	fromconfig = do
 		let key = credPairRemoteField storage
 		mcipher <- remoteCipher' c gc
-		case (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
@@ -114,7 +133,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
@@ -183,7 +202,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,7 +38,6 @@ 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 Annex.Common
@@ -232,14 +232,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 M.lookup encryptionField c of
-			Just "pubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup cipherkeysField c
-			Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup pubkeysField c
+		case getRemoteConfigValue encryptionField c of
+			Just PubKeyEncryption -> 
+				Gpg.pkEncTo $ maybe [] (splitc ',') $
+					getRemoteConfigValue cipherkeysField c
+			Just SharedPubKeyEncryption ->
+				Gpg.pkEncTo $ maybe [] (splitc ',') $
+					getRemoteConfigValue pubkeysField c
 			_ -> []
 	getGpgDecParams (_c,gc) = map Param (remoteAnnexGnupgDecryptOptions gc)
 

Database/ContentIdentifier.hs

@@ -5,11 +5,16 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts, EmptyDataDecls #-}
 {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE UndecidableInstances #-}
+#if MIN_VERSION_persistent_template(2,8,0)
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+#endif
 
 module Database.ContentIdentifier (
 	ContentIdentifierHandle,

Database/Export.hs

@@ -5,11 +5,16 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE UndecidableInstances #-}
+#if MIN_VERSION_persistent_template(2,8,0)
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+#endif
 
 module Database.Export (
 	ExportHandle,
@@ -224,7 +229,7 @@ runExportDiffUpdater updater h old new = do
 	void $ liftIO cleanup
   where
 	getek sha
-		| sha == nullSha = return Nothing
+		| sha `elem` nullShas = return Nothing
 		| otherwise = Just <$> exportKey sha
 
 {- Diff from the old to the new tree and update the ExportTree table. -}

Database/Fsck.hs

@@ -5,11 +5,16 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE UndecidableInstances #-}
+#if MIN_VERSION_persistent_template(2,8,0)
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+#endif
 
 module Database.Fsck (
 	FsckHandle,

Database/Keys.hs

@@ -260,7 +260,7 @@ reconcileStaged qh = do
 		, Param "--cached"
 		, Param "--raw"
 		, Param "-z"
-		, Param "--abbrev=40"
+		, Param "--no-abbrev"
 		-- Optimization: Only find pointer files. This is not
 		-- perfect. A file could start with this and not be a
 		-- pointer file. And a pointer file that is replaced with

Database/Keys/SQL.hs

@@ -5,11 +5,16 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
 {-# LANGUAGE UndecidableInstances #-}
+#if MIN_VERSION_persistent_template(2,8,0)
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+#endif
 
 module Database.Keys.SQL where
 

Git/CatFile.hs

@@ -148,13 +148,12 @@ parseResp object l
 	| " missing" `isSuffixOf` l -- less expensive than full check
 		&& l == fromRef object ++ " missing" = Just DNE
 	| otherwise = case words l of
-		[sha, objtype, size]
-			| length sha == shaSize ->
-				case (readObjectType (encodeBS objtype), reads size) of
-					(Just t, [(bytes, "")]) -> 
-						Just $ ParsedResp (Ref sha) bytes t
-					_ -> Nothing
-			| otherwise -> Nothing
+		[sha, objtype, size] -> case extractSha sha of
+			Just sha' -> case (readObjectType (encodeBS objtype), reads size) of
+				(Just t, [(bytes, "")]) -> 
+					Just $ ParsedResp sha' bytes t
+				_ -> Nothing
+			Nothing -> Nothing
 		_ -> Nothing
 
 querySingle :: CommandParam -> Ref -> Repo -> (Handle -> IO a) -> IO (Maybe a)

Git/Config.hs

@@ -1,6 +1,6 @@
 {- git repository configuration handling
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -14,6 +14,7 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import Data.Char
 import qualified System.FilePath.ByteString as P
+import Control.Concurrent.Async
 
 import Common
 import Git
@@ -184,19 +185,22 @@ coreBare = "core.bare"
 
 {- Runs a command to get the configuration of a repo,
  - and returns a repo populated with the configuration, as well as the raw
- - output of the command. -}
-fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString))
+ - output and any standard output of the command. -}
+fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
 fromPipe r cmd params = try $
-	withHandle StdoutHandle createProcessSuccess p $ \h -> do
-		val <- S.hGetContents h
+	withOEHandles createProcessSuccess p $ \(hout, herr) -> do
+		geterr <- async $ S.hGetContents herr
+		getval <- async $ S.hGetContents hout
+		val <- wait getval
+		err <- wait geterr
 		r' <- store val r
-		return (r', val)
+		return (r', val, err)
   where
 	p = proc cmd $ toCommand params
 
 {- Reads git config from a specified file and returns the repo populated
  - with the configuration. -}
-fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString))
+fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
 fromFile r f = fromPipe r "git"
 	[ Param "config"
 	, Param "--file"

Git/Credential.hs

@@ -1,6 +1,6 @@
 {- git credential interface
  -
- - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -22,6 +22,23 @@ credentialUsername = M.lookup "username" . fromCredential
 credentialPassword :: Credential -> Maybe String
 credentialPassword = M.lookup "password" . fromCredential
 
+credentialBasicAuth :: Credential -> Maybe BasicAuth
+credentialBasicAuth cred = BasicAuth
+	<$> credentialUsername cred
+	<*> credentialPassword cred
+
+getBasicAuthFromCredential :: Repo -> GetBasicAuth
+getBasicAuthFromCredential r u = do
+	c <- getUrlCredential u r
+	case credentialBasicAuth c of
+		Just ba -> return $ Just (ba, signalsuccess c)
+		Nothing -> do
+			signalsuccess c False
+			return Nothing
+  where
+	signalsuccess c True = approveUrlCredential c r
+	signalsuccess c False = rejectUrlCredential c r
+
 -- | This may prompt the user for login information, or get cached login
 -- information.
 getUrlCredential :: URLString -> Repo -> IO Credential

Git/DiffTree.hs

@@ -77,14 +77,14 @@ diffFiles = getdiff (Param "diff-files")
  - is adjusted to be the same as diff-tree --raw._-}
 diffLog :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 diffLog params = getdiff (Param "log")
-	(Param "-n1" : Param "--abbrev=40" : Param "--pretty=format:" : params)
+	(Param "-n1" : Param "--no-abbrev" : Param "--pretty=format:" : params)
 
 {- Uses git show to get the changes made by a commit.
  -
  - Does not support merge commits, and will fail on them. -}
 commitDiff :: Sha -> Repo -> IO ([DiffTreeItem], IO Bool)
 commitDiff ref = getdiff (Param "show")
-	[ Param "--abbrev=40", Param "--pretty=", Param "--raw", Param (fromRef ref) ]
+	[ Param "--no-abbrev", Param "--pretty=", Param "--raw", Param (fromRef ref) ]
 
 getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 getdiff command params repo = do
@@ -119,10 +119,7 @@ parseDiffRaw l = go l
 		readmode = fst . Prelude.head . readOct
 
 		-- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
-		-- All fields are fixed, so we can pull them out of
-		-- specific positions in the line.
 		(srcm, past_srcm) = splitAt 7 $ drop 1 info
 		(dstm, past_dstm) = splitAt 7 past_srcm
-		(ssha, past_ssha) = splitAt shaSize past_dstm
-		(dsha, past_dsha) = splitAt shaSize $ drop 1 past_ssha
-		s = drop 1 past_dsha
+		(ssha, past_ssha) = separate (== ' ') past_dstm
+		(dsha, s) = separate (== ' ') past_ssha

Git/DiffTreeItem.hs

@@ -17,8 +17,8 @@ import Git.Types
 data DiffTreeItem = DiffTreeItem
 	{ srcmode :: FileMode
 	, dstmode :: FileMode
-	, srcsha :: Sha -- nullSha if file was added
-	, dstsha :: Sha -- nullSha if file was deleted
+	, srcsha :: Sha -- null sha if file was added
+	, dstsha :: Sha -- null sha if file was deleted
 	, status :: String
 	, file :: TopFilePath
 	} deriving Show

Git/LsFiles.hs

@@ -162,17 +162,20 @@ stagedDetails = stagedDetails' []
 stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails' ps l repo = do
 	(ls, cleanup) <- pipeNullSplit params repo
-	return (map parse ls, cleanup)
+	return (map parseStagedDetails ls, cleanup)
   where
 	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
 		Param "--" : map (File . fromRawFilePath) l
-	parse s
-		| null file = (L.toStrict s, Nothing, Nothing)
-		| otherwise = (toRawFilePath file, extractSha $ take shaSize rest, readmode mode)
-	  where
-		(metadata, file) = separate (== '\t') (decodeBL' s)
-		(mode, rest) = separate (== ' ') metadata
-		readmode = fst <$$> headMaybe . readOct
+
+parseStagedDetails :: L.ByteString -> StagedDetails
+parseStagedDetails s
+	| null file = (L.toStrict s, Nothing, Nothing)
+	| otherwise = (toRawFilePath file, extractSha sha, readmode mode)
+  where
+	(metadata, file) = separate (== '\t') (decodeBL' s)
+	(mode, metadata') = separate (== ' ') metadata
+	(sha, _) = separate (== ' ') metadata'
+	readmode = fst <$$> headMaybe . readOct
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}

Git/LsTree.hs

@@ -21,7 +21,6 @@ module Git.LsTree (
 import Common
 import Git
 import Git.Command
-import Git.Sha
 import Git.FilePath
 import qualified Git.Filename
 import Utility.Attoparsec
@@ -94,10 +93,10 @@ parserLsTree = TreeItem
 	<$> octal
 	<* A8.char ' '
 	-- type
-	<*> A.takeTill (== 32)
+	<*> A8.takeTill (== ' ')
 	<* A8.char ' '
 	-- sha
-	<*> (Ref . decodeBS' <$> A.take shaSize)
+	<*> (Ref . decodeBS' <$> A8.takeTill (== '\t'))
 	<* A8.char '\t'
 	-- file
 	<*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString)

Git/Sha.hs

@@ -1,6 +1,6 @@
 {- git SHA stuff
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011,2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -21,8 +21,8 @@ getSha subcommand a = maybe bad return =<< extractSha <$> a
  - it, but nothing else. -}
 extractSha :: String -> Maybe Sha
 extractSha s
-	| len == shaSize = val s
-	| len == shaSize + 1 && length s' == shaSize = val s'
+	| len `elem` shaSizes = val s
+	| len - 1 `elem` shaSizes && length s' == len - 1 = val s'
 	| otherwise = Nothing
   where
 	len = length s
@@ -31,13 +31,30 @@ extractSha s
 		| all (`elem` "1234567890ABCDEFabcdef") v = Just $ Ref v
 		| otherwise = Nothing
 
-{- Size of a git sha. -}
-shaSize :: Int
-shaSize = 40
+{- Sizes of git shas. -}
+shaSizes :: [Int]
+shaSizes = 
+	[ 40 -- sha1 (must come first)
+	, 64 -- sha256
+	]
 
-nullSha :: Ref		
-nullSha = Ref $ replicate shaSize '0'
+{- Git plumbing often uses a all 0 sha to represent things like a
+ - deleted file. -}
+nullShas :: [Sha]
+nullShas = map (\n -> Ref (replicate n '0')) shaSizes
 
-{- Git's magic empty tree. -}
+{- Sha to provide to git plumbing when deleting a file.
+ -
+ - It's ok to provide a sha1; git versions that use sha256 will map the
+ - sha1 to the sha256, or probably just treat all null sha1 specially
+ - the same as all null sha256. -}
+deleteSha :: Sha
+deleteSha = Prelude.head nullShas
+
+{- Git's magic empty tree.
+ -
+ - It's ok to provide the sha1 of this to git to refer to an empty tree;
+ - git versions that use sha256 will map the sha1 to the sha256.
+ -}
 emptyTree :: Ref
 emptyTree = Ref "4b825dc642cb6eb9a060e54bf8d69288fbee4904"

Git/UnionMerge.hs

@@ -82,7 +82,7 @@ doMerge hashhandle ch differ repo streamer = do
  - a line suitable for update-index that union merges the two sides of the
  - diff. -}
 mergeFile :: String -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
-mergeFile info file hashhandle h = case filter (/= nullSha) [Ref asha, Ref bsha] of
+mergeFile info file hashhandle h = case filter (`notElem` nullShas) [Ref asha, Ref bsha] of
 	[] -> return Nothing
 	(sha:[]) -> use sha
 	shas -> use

Git/UpdateIndex.hs

@@ -108,7 +108,7 @@ unstageFile file repo = do
 unstageFile' :: TopFilePath -> Streamer
 unstageFile' p = pureStreamer $ L.fromStrict $
 	"0 "
-	<> encodeBS' (fromRef nullSha)
+	<> encodeBS' (fromRef deleteSha)
 	<> "\t"
 	<> indexPath p
 

Key.hs

@@ -1,6 +1,6 @@
 {- git-annex Keys
  -
- - 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 Key (
 	prop_isomorphic_key_encode
 ) where
 
+import Data.Char
 import qualified Data.Text as T
 import qualified Data.ByteString as S
 import qualified Data.Attoparsec.ByteString as A
@@ -79,11 +80,15 @@ instance Arbitrary KeyData where
 		<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative
 
 -- AssociatedFile cannot be empty, and cannot contain a NUL
--- (but can be Nothing)
+-- (but can be Nothing). 
 instance Arbitrary AssociatedFile where
-	arbitrary = (AssociatedFile . fmap toRawFilePath <$> arbitrary)
+  	arbitrary = (AssociatedFile . fmap conv <$> arbitrary)
 		`suchThat` (/= AssociatedFile (Just S.empty))
 		`suchThat` (\(AssociatedFile f) -> maybe True (S.notElem 0) f)
+	  where
+		-- Generating arbitrary unicode leads to encoding errors
+		-- when LANG=C, so limit to ascii.
+		conv = toRawFilePath . filter isAscii
 
 instance Arbitrary Key where
 	arbitrary = mkKey . const <$> arbitrary

Logs.hs

@@ -1,6 +1,6 @@
 {- git-annex log file names
  -
- - Copyright 2013-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -27,8 +27,8 @@ data LogVariety
 
 {- Converts a path from the git-annex branch into one of the varieties
  - of logs used by git-annex, if it's a known path. -}
-getLogVariety :: RawFilePath -> Maybe LogVariety
-getLogVariety f
+getLogVariety :: GitConfig -> RawFilePath -> Maybe LogVariety
+getLogVariety config f
 	| f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog
 	| f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog
 	| isRemoteStateLog f = Just NewUUIDBasedLog
@@ -36,7 +36,7 @@ getLogVariety f
 	| isChunkLog f = ChunkLog <$> extLogFileKey chunkLogExt f
 	| isRemoteMetaDataLog f = Just RemoteMetaDataLog
 	| isMetaDataLog f || f `elem` otherLogs = Just OtherLog
-	| otherwise = PresenceLog <$> firstJust (presenceLogs f)
+	| otherwise = PresenceLog <$> firstJust (presenceLogs config f)
 
 {- All the old-format uuid-based logs stored in the top of the git-annex branch. -}
 topLevelOldUUIDBasedLogs :: [RawFilePath]
@@ -61,10 +61,10 @@ topLevelNewUUIDBasedLogs =
 
 
 {- All the ways to get a key from a presence log file -}
-presenceLogs :: RawFilePath -> [Maybe Key]
-presenceLogs f =
+presenceLogs :: GitConfig -> RawFilePath -> [Maybe Key]
+presenceLogs config f =
 	[ urlLogFileKey f
-	, locationLogFileKey f
+	, locationLogFileKey config f
 	]
 
 {- Top-level logs that are neither UUID based nor presence logs. -}
@@ -218,8 +218,17 @@ urlLogFileKey :: RawFilePath -> Maybe Key
 urlLogFileKey = extLogFileKey urlLogExt
 
 {- Converts a pathname into a key if it's a location log. -}
-locationLogFileKey :: RawFilePath -> Maybe Key
-locationLogFileKey path
-	-- Want only xx/yy/foo.log, not .log files in other places.
-	| length (splitDirectories (fromRawFilePath path)) /= 3 = Nothing
+locationLogFileKey :: GitConfig -> RawFilePath -> Maybe Key
+locationLogFileKey config path
+	| length (splitDirectories (fromRawFilePath path)) /= locationLogFileDepth config = Nothing
 	| otherwise = extLogFileKey ".log" path
+
+{- Depth of location log files within the git-annex branch.
+ -
+ - Normally they are xx/yy/key.log so depth 3. 
+ - The same extension is also used for other logs that
+ - are not location logs. -}
+locationLogFileDepth :: GitConfig -> Int
+locationLogFileDepth config = hashlevels + 1
+  where
+        HashLevels hashlevels = branchHashLevels config

Logs/Location.hs

@@ -130,8 +130,10 @@ loggedKeys :: Annex [Unchecked Key]
 loggedKeys = loggedKeys' (not <$$> checkDead)
 
 loggedKeys' :: (Key -> Annex Bool) -> Annex [Unchecked Key]
-loggedKeys' check = mapMaybe (defercheck <$$> locationLogFileKey)
-	<$> Annex.Branch.files
+loggedKeys' check = do
+	config <- Annex.getGitConfig
+	mapMaybe (defercheck <$$> locationLogFileKey config)
+		<$> Annex.Branch.files
   where
 	defercheck k = Unchecked $ ifM (check k)
 		( return (Just k)

Logs/Remote/Pure.hs

@@ -19,6 +19,7 @@ module Logs.Remote.Pure (
 
 import Annex.Common
 import Types.Remote
+import Types.ProposedAccepted
 import Logs.UUIDBased
 import Annex.SpecialRemote.Config
 
@@ -40,24 +41,24 @@ buildRemoteConfigLog :: Log RemoteConfig -> Builder
 buildRemoteConfigLog = buildLogOld (byteString . encodeBS . showConfig)
 
 remoteConfigParser :: A.Parser RemoteConfig
-remoteConfigParser = keyValToConfig . words . decodeBS <$> A.takeByteString
+remoteConfigParser = keyValToConfig Accepted . words . decodeBS <$> A.takeByteString
 
 showConfig :: RemoteConfig -> String
 showConfig = unwords . configToKeyVal
 
 {- Given Strings like "key=value", generates a RemoteConfig. -}
-keyValToConfig :: [String] -> RemoteConfig
-keyValToConfig ws = M.fromList $ map (/=/) ws
+keyValToConfig :: (String -> ProposedAccepted String) -> [String] -> RemoteConfig
+keyValToConfig mk ws = M.fromList $ map (/=/) ws
   where
-	(/=/) s = (k, v)
+	(/=/) s = (mk k, mk v)
 	  where
 		k = takeWhile (/= '=') s
 		v = configUnEscape $ drop (1 + length k) s
 
-configToKeyVal :: M.Map String String -> [String]
+configToKeyVal :: RemoteConfig -> [String]
 configToKeyVal m = map toword $ sort $ M.toList m
   where
-	toword (k, v) = k ++ "=" ++ configEscape v
+	toword (k, v) = fromProposedAccepted k ++ "=" ++ configEscape (fromProposedAccepted v)
 
 configEscape :: String -> String
 configEscape = concatMap escape
@@ -90,9 +91,9 @@ prop_isomorphic_configEscape s = s == (configUnEscape . configEscape) s
 prop_parse_show_Config :: RemoteConfig -> Bool
 prop_parse_show_Config c
 	-- whitespace and '=' are not supported in config keys
-	| any (\k -> any isSpace k || elem '=' k) (M.keys c) = True
-	| any (any excluded) (M.keys c) = True
-	| any (any excluded) (M.elems c) = True
+	| any (\k -> any isSpace k || elem '=' k) (map fromProposedAccepted $ M.keys c) = True
+	| any (any excluded) (map fromProposedAccepted $ M.keys c) = True
+	| any (any excluded) (map fromProposedAccepted $ M.elems c) = True
 	| otherwise = A.parseOnly remoteConfigParser (encodeBS $ showConfig c) ~~ Right c
   where
 	normalize v = sort . M.toList <$> v

Makefile

@@ -84,9 +84,9 @@ install-completions: build
 	install -d $(DESTDIR)$(ZSH_COMPLETIONS_PATH)
 	./git-annex --zsh-completion-script git-annex 2>/dev/null \
 		> $(DESTDIR)$(ZSH_COMPLETIONS_PATH)/_git-annex
-	install -d $(DESTDIR)$(PREFIX)/$(SHAREDIR)/fish/completions
+	install -d $(DESTDIR)$(PREFIX)/$(SHAREDIR)/fish/vendor_completions.d
 	./git-annex --fish-completion-script git-annex 2>/dev/null \
-		> $(DESTDIR)$(PREFIX)/$(SHAREDIR)/fish/completions/git-annex.fish
+		> $(DESTDIR)$(PREFIX)/$(SHAREDIR)/fish/vendor_completions.d/git-annex.fish
 
 test: git-annex git-annex-shell
 	./git-annex test

Messages.hs

@@ -1,6 +1,6 @@
 {- git-annex output messages
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -48,6 +48,7 @@ module Messages (
 	outputMessage,
 	withMessageState,
 	prompt,
+	mkPrompter,
 ) where
 
 import System.Log.Logger
@@ -55,6 +56,7 @@ import System.Log.Formatter
 import System.Log.Handler (setFormatter)
 import System.Log.Handler.Simple
 import Control.Concurrent
+import Control.Monad.IO.Class
 import qualified Data.ByteString as S
 
 import Common
@@ -290,14 +292,21 @@ commandProgressDisabled = withMessageState $ \s -> return $
  - the user.
  -}
 prompt :: Annex a -> Annex a
-prompt a = debugLocks $ Annex.getState Annex.concurrency >>= \case
-	NonConcurrent -> a
+prompt a = do
+	p <- mkPrompter
+	p a
+
+{- Like prompt, but for a non-annex action that prompts. -}
+mkPrompter :: (MonadMask m, MonadIO m) => Annex (m a -> m a)
+mkPrompter = Annex.getState Annex.concurrency >>= \case
+	NonConcurrent -> return id
 	(Concurrent _) -> goconcurrent
 	ConcurrentPerCpu -> goconcurrent
   where
 	goconcurrent = withMessageState $ \s -> do
 		let l = promptLock s
-		bracketIO
-			(takeMVar l)
-			(putMVar l)
-			(const $ hideRegionsWhile s a)
+		return $ \a ->
+			debugLocks $ bracketIO
+				(takeMVar l)
+				(putMVar l)
+				(const $ hideRegionsWhile s a)

Messages/Concurrent.hs

@@ -18,6 +18,7 @@ import Common
 import qualified System.Console.Concurrent as Console
 import qualified System.Console.Regions as Regions
 import Control.Concurrent.STM
+import Control.Monad.IO.Class
 import qualified Data.Text as T
 #ifndef mingw32_HOST_OS
 import GHC.IO.Encoding
@@ -120,13 +121,14 @@ concurrentOutputSupported = return True -- Windows is always unicode
 
 {- Hide any currently displayed console regions while running the action,
  - so that the action can use the console itself. -}
-hideRegionsWhile :: MessageState -> Annex a -> Annex a
+hideRegionsWhile :: (MonadIO m, Monad m, MonadMask m) => MessageState -> m a -> m a
 hideRegionsWhile s a
-	| concurrentOutputEnabled s = bracketIO setup cleanup go
+	| concurrentOutputEnabled s = bracket setup cleanup go
 	| otherwise = a
   where
-	setup = Regions.waitDisplayChange $ swapTMVar Regions.regionList []
-	cleanup = void . atomically . swapTMVar Regions.regionList
+	setup = liftIO $ 
+		Regions.waitDisplayChange $ swapTMVar Regions.regionList []
+	cleanup = liftIO . void . atomically . swapTMVar Regions.regionList
 	go _ = do
 		liftIO $ hFlush stdout
 		a

Remote.hs

@@ -24,7 +24,7 @@ module Remote (
 	remoteTypes,
 	remoteList,
 	remoteList',
-	gitSyncableRemote,
+	gitSyncableRemoteType,
 	remoteMap,
 	remoteMap',
 	uuidDescriptions,
@@ -131,7 +131,7 @@ byNameWithUUID = checkuuid <=< byName
 			repo <- getRepo r
 			ifM (liftIO $ getDynamicConfig $ remoteAnnexIgnore (gitconfig r))
 				( giveup $ noRemoteUUIDMsg r ++
-					" (" ++ show (remoteConfig repo "ignore") ++
+					" (" ++ show (remoteAnnexConfig repo "ignore") ++
 					" is set)"
 				, giveup $ noRemoteUUIDMsg r
 				)

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.
  -}
@@ -19,6 +19,8 @@ import Remote.Helper.Messages
 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
@@ -31,16 +33,28 @@ 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
+			(FieldDesc "location on the Android device where the files are stored")
+		, optionalStringParser androidserialField
+			(FieldDesc "sometimes needed to specify which Android device to use")
+		]
 	, 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
@@ -109,10 +123,12 @@ adbSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration
-	adir <- maybe (giveup "Specify androiddirectory=") (pure . AndroidPath)
-		(M.lookup "androiddirectory" c)
+	adir <- maybe
+		(giveup "Specify androiddirectory=")
+		(pure . AndroidPath . fromProposedAccepted)
+		(M.lookup androiddirectoryField c)
 	serial <- getserial =<< liftIO enumerateAdbConnected
-	let c' = M.insert "androidserial" (fromAndroidSerial serial) c
+	let c' = M.insert androidserialField (Proposed (fromAndroidSerial serial)) c
 
 	(c'', _encsetup) <- encryptionSetup c' gc
 
@@ -130,7 +146,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 M.lookup "androidserial" c of
+	getserial l = case fromProposedAccepted <$> M.lookup androidserialField c of
 		Nothing -> case l of
 			(s:[]) -> return s
 			_ -> giveup $ unlines $

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

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
@@ -33,20 +34,28 @@ import Utility.UserInfo
 import Annex.UUID
 import Annex.Ssh
 import Utility.Metered
+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
+			(FieldDesc "(required) bup repository to use")
+		]
 	, 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 $
@@ -108,8 +117,8 @@ bupSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane
-	let buprepo = fromMaybe (giveup "Specify buprepo=") $
-		M.lookup "buprepo" c
+	let buprepo = maybe (giveup "Specify buprepo=") fromProposedAccepted $
+		M.lookup buprepoField c
 	(c', _encsetup) <- encryptionSetup c gc
 
 	-- bup init will create the repository.

Remote/Ddar.hs

@@ -18,11 +18,13 @@ 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
 import Annex.UUID
 import Utility.SshHost
+import Types.ProposedAccepted
 
 data DdarRepo = DdarRepo
 	{ ddarRepoConfig :: RemoteGitConfig
@@ -30,16 +32,23 @@ data DdarRepo = DdarRepo
 	}
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "ddar"
 	, enumerate = const (findSpecialRemotes "ddarrepo")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[ optionalStringParser ddarrepoField
+			(FieldDesc "(required) location of ddar archive to use")
+		]
 	, 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
@@ -98,8 +107,8 @@ ddarSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 
 	-- verify configuration is sane
-	let ddarrepo = fromMaybe (giveup "Specify ddarrepo=") $
-		M.lookup "ddarrepo" c
+	let ddarrepo = maybe (giveup "Specify ddarrepo=") fromProposedAccepted $
+		M.lookup ddarrepoField c
 	(c', _encsetup) <- encryptionSetup c gc
 
 	-- The ddarrepo is stored in git config, as well as this repo's

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
@@ -34,18 +35,26 @@ import Annex.UUID
 import Utility.Metered
 import Utility.Tmp
 import Utility.InodeCache
+import Types.ProposedAccepted
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "directory"
 	, enumerate = const (findSpecialRemotes "directory")
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[ optionalStringParser directoryField
+			(FieldDesc "(required) where the special remote stores data")
+		]
 	, 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
@@ -111,8 +120,8 @@ directorySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig ->
 directorySetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
-	let dir = fromMaybe (giveup "Specify directory=") $
-		M.lookup "directory" c
+	let dir = maybe (giveup "Specify directory=") fromProposedAccepted $
+		M.lookup directoryField c
 	absdir <- liftIO $ absPath dir
 	liftIO $ unlessM (doesDirectoryExist absdir) $
 		giveup $ "Directory does not exist: " ++ absdir
@@ -121,7 +130,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 "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/External.hs

@@ -1,6 +1,6 @@
 {- External special remote interface.
  -
- - Copyright 2013-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -16,10 +16,12 @@ import Types.Remote
 import Types.Export
 import Types.CleanupActions
 import Types.UrlContents
+import Types.ProposedAccepted
 import qualified Git
 import Config
-import Git.Config (isTrueFalse, boolConfig)
+import Git.Config (boolConfig)
 import Git.Env
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.ExportImport
 import Remote.Helper.ReadOnly
@@ -41,18 +43,26 @@ import Control.Concurrent.STM
 import Control.Concurrent.Async
 import System.Log.Logger (debugM)
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "external"
 	, enumerate = const (findSpecialRemotes "externaltype")
 	, generate = gen
+	, configParser = remoteConfigParser
 	, setup = externalSetup
 	, exportSupported = checkExportSupported
 	, importSupported = importUnsupported
 	}
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+externaltypeField :: RemoteConfigField
+externaltypeField = Accepted "externaltype"
+
+readonlyField :: RemoteConfigField
+readonlyField = Accepted "readonly"
+
+gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u c gc rs
 	-- readonly mode only downloads urls; does not use external program
 	| remoteAnnexReadOnly gc = do
@@ -69,7 +79,7 @@ gen r u c gc rs
 			exportUnsupported
 			exportUnsupported
 	| otherwise = do
-		external <- newExternal externaltype u c gc (Just rs)
+		external <- newExternal externaltype (Just u) c (Just gc) (Just rs)
 		Annex.addCleanup (RemoteCleanup u) $ stopExternal external
 		cst <- getCost external r gc
 		avail <- getAvailability external r gc
@@ -152,32 +162,43 @@ gen r u c gc rs
 externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 externalSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
+	pc <- either giveup return $ parseRemoteConfig c lenientRemoteConfigParser
 	let externaltype = fromMaybe (giveup "Specify externaltype=") $
-		M.lookup "externaltype" c
+		getRemoteConfigValue externaltypeField pc
 	(c', _encsetup) <- encryptionSetup c gc
 
-	c'' <- case M.lookup "readonly" c of
-		Just v | isTrueFalse v == Just True -> do
-			setConfig (remoteConfig (fromJust (lookupName c)) "readonly") (boolConfig True)
+	c'' <- case getRemoteConfigValue readonlyField pc of
+		Just True -> do
+			setConfig (remoteAnnexConfig (fromJust (lookupName c)) "readonly") (boolConfig True)
 			return c'
 		_ -> do
-			external <- newExternal externaltype u c' gc Nothing
+			pc' <- either giveup return $ parseRemoteConfig c' lenientRemoteConfigParser
+			external <- newExternal externaltype (Just u) pc' (Just gc) Nothing
+			-- Now that we have an external, ask it to LISTCONFIGS, 
+			-- and re-parse the RemoteConfig strictly, so we can
+			-- error out if the user provided an unexpected config.
+			_ <- either giveup return . parseRemoteConfig c' 
+				=<< strictRemoteConfigParser external
 			handleRequest external INITREMOTE Nothing $ \resp -> case resp of
 				INITREMOTE_SUCCESS -> result ()
 				INITREMOTE_FAILURE errmsg -> Just $ giveup errmsg
 				_ -> Nothing
-			withExternalState external $
-				liftIO . atomically . readTVar . externalConfig
+			-- Any config changes the external made before
+			-- responding to INITREMOTE need to be applied to
+			-- the RemoteConfig.
+			changes <- withExternalState external $
+				liftIO . atomically . readTVar . externalConfigChanges
+			return (changes c')
 
 	gitConfigSpecialRemote u c'' [("externaltype", externaltype)]
 	return (c'', u)
 
-checkExportSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool
+checkExportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool
 checkExportSupported c gc = do
 	let externaltype = fromMaybe (giveup "Specify externaltype=") $
-		remoteAnnexExternalType gc <|> M.lookup "externaltype" c
+		remoteAnnexExternalType gc <|> getRemoteConfigValue externaltypeField c
 	checkExportSupported' 
-		=<< newExternal externaltype NoUUID c gc Nothing
+		=<< newExternal externaltype Nothing c (Just gc) Nothing
 
 checkExportSupported' :: External -> Annex Bool
 checkExportSupported' external = go `catchNonAsync` (const (return False))
@@ -387,36 +408,48 @@ handleRequest' st external req mp responsehandler
 	handleRemoteRequest (DIRHASH_LOWER k) = 
 		send $ VALUE $ fromRawFilePath $ hashDirLower def k
 	handleRemoteRequest (SETCONFIG setting value) =
-		liftIO $ atomically $ modifyTVar' (externalConfig st) $
-			M.insert setting value
+		liftIO $ atomically $ do
+			modifyTVar' (externalConfig st) $
+				M.insert (Accepted setting) $
+					RemoteConfigValue (PassedThrough value)
+			modifyTVar' (externalConfigChanges st) $ \f ->
+				f . M.insert (Accepted setting) (Accepted value)
 	handleRemoteRequest (GETCONFIG setting) = do
-		value <- fromMaybe "" . M.lookup setting
+		value <- fromMaybe ""
+			. M.lookup (Accepted setting)
+			. getRemoteConfigPassedThrough
 			<$> liftIO (atomically $ readTVar $ externalConfig st)
 		send $ VALUE value
-	handleRemoteRequest (SETCREDS setting login password) = do
-		let v = externalConfig st
-		c <- liftIO $ atomically $ readTVar v
-		let gc = externalGitConfig external
-		c' <- setRemoteCredPair encryptionAlreadySetup c gc
-			(credstorage setting)
-			(Just (login, password))
-		void $ liftIO $ atomically $ swapTVar v c'
-	handleRemoteRequest (GETCREDS setting) = do
-		c <- liftIO $ atomically $ readTVar $ externalConfig st
-		let gc = externalGitConfig external
-		creds <- fromMaybe ("", "") <$> 
-			getRemoteCredPair c gc (credstorage setting)
-		send $ CREDS (fst creds) (snd creds)
-	handleRemoteRequest GETUUID = send $
-		VALUE $ fromUUID $ externalUUID external
+	handleRemoteRequest (SETCREDS setting login password) = case (externalUUID external, externalGitConfig external) of
+		(Just u, Just gc) -> do
+			let v = externalConfig st
+			c <- liftIO $ atomically $ readTVar v
+			c' <- setRemoteCredPair' RemoteConfigValue id encryptionAlreadySetup c gc
+				(credstorage setting u)
+				(Just (login, password))
+			void $ liftIO $ atomically $ swapTVar v c'
+		_ -> senderror "cannot send SETCREDS here"
+	handleRemoteRequest (GETCREDS setting) = case (externalUUID external, externalGitConfig external) of
+		(Just u, Just gc) -> do
+			c <- liftIO $ atomically $ readTVar $ externalConfig st
+			creds <- fromMaybe ("", "") <$> 
+				getRemoteCredPair c gc (credstorage setting u)
+			send $ CREDS (fst creds) (snd creds)
+		_ -> senderror "cannot send GETCREDS here"
+	handleRemoteRequest GETUUID = case externalUUID external of
+		Just u -> send $ VALUE $ fromUUID u
+		Nothing -> senderror "cannot send GETUUID here"
 	handleRemoteRequest GETGITDIR = 
 		send . VALUE . fromRawFilePath =<< fromRepo Git.localGitDir
-	handleRemoteRequest (SETWANTED expr) =
-		preferredContentSet (externalUUID external) expr
-	handleRemoteRequest GETWANTED = do
-		expr <- fromMaybe "" . M.lookup (externalUUID external)
-			<$> preferredContentMapRaw
-		send $ VALUE expr
+	handleRemoteRequest (SETWANTED expr) = case externalUUID external of
+		Just u -> preferredContentSet u expr
+		Nothing -> senderror "cannot send SETWANTED here"
+	handleRemoteRequest GETWANTED = case externalUUID external of
+		Just u -> do
+			expr <- fromMaybe "" . M.lookup u
+				<$> preferredContentMapRaw
+			send $ VALUE expr
+		Nothing -> senderror "cannot send GETWANTED here"
 	handleRemoteRequest (SETSTATE key state) =
 		case externalRemoteStateHandle external of
 			Just h -> setRemoteState h key state
@@ -448,13 +481,13 @@ handleRequest' st external req mp responsehandler
 	send = sendMessage st external
 	senderror = sendMessage st external . ERROR 
 
-	credstorage setting = CredPairStorage
+	credstorage setting u = CredPairStorage
 		{ credPairFile = base
 		, credPairEnvironment = (base ++ "login", base ++ "password")
-		, credPairRemoteField = setting
+		, credPairRemoteField = Accepted setting
 		}
 	  where
-		base = replace "/" "_" $ fromUUID (externalUUID external) ++ "-" ++ setting
+		base = replace "/" "_" $ fromUUID u ++ "-" ++ setting
 			
 	withurl mk uri = handleRemoteRequest $ mk $
 		setDownloader (show uri) OtherDownloader
@@ -579,6 +612,7 @@ startExternal external = do
 			createProcess p `catchIO` runerr cmdpath
 		stderrelay <- async $ errrelayer herr
 		cv <- newTVarIO $ externalDefaultConfig external
+		ccv <- newTVarIO id
 		pv <- newTVarIO Unprepared
 		pid <- atomically $ do
 			n <- succ <$> readTVar (externalLastPid external)
@@ -593,6 +627,7 @@ startExternal external = do
 				void $ waitForProcess ph
 			, externalPrepared = pv
 			, externalConfig = cv
+			, externalConfigChanges = ccv
 			}
 	
 	basecmd = externalRemoteProgram $ externalType external
@@ -712,7 +747,7 @@ checkUrlM external url =
 retrieveUrl :: Retriever
 retrieveUrl = fileRetriever $ \f k p -> do
 	us <- getWebUrls k
-	unlessM (downloadUrl k p us f) $
+	unlessM (withUrlOptions $ downloadUrl k p us f) $
 		giveup "failed to download content"
 
 checkKeyUrl :: Git.Repo -> CheckPresent
@@ -745,3 +780,63 @@ getInfoM external = (++)
 		INFOVALUE v -> Just $ return $
 			GetNextMessage $ collect ((f, v) : l)
 		_ -> Nothing
+
+{- All unknown configs are passed through in case the external program
+ - uses them. -}
+lenientRemoteConfigParser :: RemoteConfigParser
+lenientRemoteConfigParser =
+	addRemoteConfigParser specialRemoteConfigParsers baseRemoteConfigParser
+
+baseRemoteConfigParser :: RemoteConfigParser
+baseRemoteConfigParser = RemoteConfigParser
+	{ remoteConfigFieldParsers =
+		[ optionalStringParser externaltypeField
+			(FieldDesc "type of external special remote to use")
+		, trueFalseParser readonlyField False
+			(FieldDesc "enable readonly mode")
+		]
+	, remoteConfigRestPassthrough = Just
+		( const True
+		, [("*", FieldDesc "all other parameters are passed to external special remote program")]
+		)
+	}
+
+{- When the remote supports LISTCONFIGS, only accept the ones it listed.
+ - When it does not, accept all configs. -}
+strictRemoteConfigParser :: External -> Annex RemoteConfigParser
+strictRemoteConfigParser external = listConfigs external >>= \case
+	Nothing -> return lenientRemoteConfigParser
+	Just l -> do
+		let s = S.fromList (map fst l)
+		let listed f = S.member (fromProposedAccepted f) s
+		return $ lenientRemoteConfigParser
+			{ remoteConfigRestPassthrough = Just (listed, l) }
+
+listConfigs :: External -> Annex (Maybe [(Setting, FieldDesc)])
+listConfigs external = handleRequest external LISTCONFIGS Nothing (collect [])
+  where
+	collect l req = case req of
+		CONFIG s d -> Just $ return $
+			GetNextMessage $ collect ((s, FieldDesc d) : l)
+		CONFIGEND -> result (Just (reverse l))
+		UNSUPPORTED_REQUEST -> result Nothing
+		_ -> Nothing
+
+remoteConfigParser :: RemoteConfig -> Annex RemoteConfigParser
+remoteConfigParser c
+	-- No need to start the external when there is no config to parse,
+	-- or when everything in the config was already accepted; in those
+	-- cases the lenient parser will do the same thing as the strict
+	-- parser.
+	| M.null (M.filter isproposed c) = return lenientRemoteConfigParser
+	| otherwise = case parseRemoteConfig c baseRemoteConfigParser of
+		Left _ -> return lenientRemoteConfigParser
+		Right pc -> case (getRemoteConfigValue externaltypeField pc, getRemoteConfigValue readonlyField pc) of
+			(Nothing, _) -> return lenientRemoteConfigParser
+			(_, Just True) -> return lenientRemoteConfigParser
+			(Just externaltype, _) -> do
+				external <- newExternal externaltype Nothing pc Nothing Nothing
+				strictRemoteConfigParser external
+  where
+	isproposed (Accepted _) = False
+	isproposed (Proposed _) = True

Remote/External/Types.hs

@@ -1,6 +1,6 @@
 {- External special remote data types.
  -
- - Copyright 2013-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -28,6 +28,7 @@ module Remote.External.Types (
 	AsyncMessage(..),
 	ErrorMsg,
 	Setting,
+	Description,
 	ProtocolVersion,
 	supportedProtocolVersions,
 ) where
@@ -37,7 +38,8 @@ import Types.StandardGroups (PreferredContentExpression)
 import Utility.Metered (BytesProcessed(..))
 import Types.Transfer (Direction(..))
 import Config.Cost (Cost)
-import Types.Remote (RemoteConfig, RemoteStateHandle)
+import Types.RemoteState
+import Types.RemoteConfig
 import Types.Export
 import Types.Availability (Availability(..))
 import Types.Key
@@ -50,17 +52,17 @@ import Data.Char
 
 data External = External
 	{ externalType :: ExternalType
-	, externalUUID :: UUID
+	, externalUUID :: Maybe UUID
 	, externalState :: TVar [ExternalState]
 	-- ^ Contains states for external special remote processes
 	-- that are not currently in use.
 	, externalLastPid :: TVar PID
-	, externalDefaultConfig :: RemoteConfig
-	, externalGitConfig :: RemoteGitConfig
+	, externalDefaultConfig :: ParsedRemoteConfig
+	, externalGitConfig :: Maybe RemoteGitConfig
 	, externalRemoteStateHandle :: Maybe RemoteStateHandle
 	}
 
-newExternal :: ExternalType -> UUID -> RemoteConfig -> RemoteGitConfig -> Maybe RemoteStateHandle -> Annex External
+newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteStateHandle -> Annex External
 newExternal externaltype u c gc rs = liftIO $ External
 	<$> pure externaltype
 	<*> pure u
@@ -78,7 +80,8 @@ data ExternalState = ExternalState
 	, externalShutdown :: IO ()
 	, externalPid :: PID
 	, externalPrepared :: TVar PrepareStatus
-	, externalConfig :: TVar RemoteConfig
+	, externalConfig :: TVar ParsedRemoteConfig
+	, externalConfigChanges :: TVar (RemoteConfig -> RemoteConfig)
 	}
 
 type PID = Int
@@ -129,6 +132,7 @@ data Request
 	| CHECKPRESENT SafeKey
 	| REMOVE SafeKey
 	| WHEREIS SafeKey
+	| LISTCONFIGS
 	| GETINFO
 	| EXPORTSUPPORTED
 	| EXPORT ExportLocation
@@ -145,6 +149,7 @@ needsPREPARE PREPARE = False
 needsPREPARE (EXTENSIONS _) = False
 needsPREPARE INITREMOTE = False
 needsPREPARE EXPORTSUPPORTED = False
+needsPREPARE LISTCONFIGS = False
 needsPREPARE _ = True
 
 instance Proto.Sendable Request where
@@ -165,6 +170,7 @@ instance Proto.Sendable Request where
 		[ "CHECKPRESENT", Proto.serialize key ]
 	formatMessage (REMOVE key) = [ "REMOVE", Proto.serialize key ]
 	formatMessage (WHEREIS key) = [ "WHEREIS", Proto.serialize key ]
+	formatMessage LISTCONFIGS = [ "LISTCONFIGS" ]
 	formatMessage GETINFO = [ "GETINFO" ]
 	formatMessage EXPORTSUPPORTED = ["EXPORTSUPPORTED"]
 	formatMessage (EXPORT loc) = [ "EXPORT", Proto.serialize loc ]
@@ -209,6 +215,8 @@ data Response
 	| CHECKURL_FAILURE ErrorMsg
 	| WHEREIS_SUCCESS String
 	| WHEREIS_FAILURE
+	| CONFIG Setting Description
+	| CONFIGEND
 	| INFOFIELD String
 	| INFOVALUE String
 	| INFOEND
@@ -243,6 +251,8 @@ instance Proto.Receivable Response where
 	parseCommand "CHECKURL-FAILURE" = Proto.parse1 CHECKURL_FAILURE
 	parseCommand "WHEREIS-SUCCESS" = Just . WHEREIS_SUCCESS
 	parseCommand "WHEREIS-FAILURE" = Proto.parse0 WHEREIS_FAILURE
+	parseCommand "CONFIG" = Proto.parse2 CONFIG
+	parseCommand "CONFIGEND" = Proto.parse0 CONFIGEND
 	parseCommand "INFOFIELD" = Proto.parse1 INFOFIELD
 	parseCommand "INFOVALUE" = Proto.parse1 INFOVALUE
 	parseCommand "INFOEND" = Proto.parse0 INFOEND
@@ -330,6 +340,7 @@ instance Proto.Receivable AsyncMessage where
 -- All are serializable.
 type ErrorMsg = String
 type Setting = String
+type Description = String
 type ProtocolVersion = Int
 type Size = Maybe Integer
 

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
@@ -55,21 +56,31 @@ import Utility.Tmp
 import Logs.Remote
 import Utility.Gpg
 import Utility.SshHost
+import Utility.Tuple
 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 = mkRemoteConfigParser $
+		Remote.Rsync.rsyncRemoteConfigs ++
+		[ optionalStringParser gitRepoField
+			(FieldDesc "(required) path or url to gcrypt repository")
+		]
 	, 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
@@ -77,7 +88,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
@@ -98,15 +109,18 @@ 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
-				storeUUIDIn (remoteConfig baser "uuid") u'
+				pc <- either giveup return
+					. parseRemoteConfig c'
+					=<< configParser remote c'
+				setGcryptEncryption pc remotename
+				storeUUIDIn (remoteAnnexConfig 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
@@ -187,7 +201,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 $ M.lookup "gitrepo" c
+gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup gitRepoField c
   where
 	remotename = fromJust (lookupName c)
 	go Nothing = giveup "Specify gitrepo="
@@ -206,7 +220,9 @@ gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c
 				| 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 c'
+		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
@@ -322,7 +338,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
@@ -456,7 +472,7 @@ getGCryptId :: Bool -> Git.Repo -> RemoteGitConfig -> Annex (Maybe Git.GCrypt.GC
 getGCryptId fast r gc
 	| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
 		liftIO (catchMaybeIO $ Git.Config.read r)
-	| not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
+	| not fast = extract . liftM fst3 <$> getM (eitherToMaybe <$>)
 		[ Ssh.onRemote NoConsumeStdin r (\f p -> liftIO (Git.Config.fromPipe r f p), return (Left $ error "configlist failed")) "configlist" [] []
 		, getConfigViaRsync r gc
 		]
@@ -465,7 +481,7 @@ getGCryptId fast r gc
 	extract Nothing = (Nothing, r)
 	extract (Just r') = (fromConfigValue <$> Git.Config.getMaybe coreGCryptId r', r')
 
-getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString))
+getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString, S.ByteString))
 getConfigViaRsync r gc = do
 	(rsynctransport, rsyncurl, _) <- rsyncTransport r gc
 	opts <- rsynctransport

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
@@ -59,11 +60,12 @@ import P2P.Address
 import Annex.Path
 import Creds
 import Types.NumCopies
+import Types.ProposedAccepted
 import Annex.Action
 import Messages.Progress
-import qualified Utility.RawFilePath as R
 
 #ifndef mingw32_HOST_OS
+import qualified Utility.RawFilePath as R
 import Utility.FileMode
 #endif
 
@@ -78,21 +80,28 @@ remote = RemoteType
 	{ typename = "git"
 	, enumerate = list
 	, generate = gen
+	, configParser = mkRemoteConfigParser
+		[ optionalStringParser locationField
+			(FieldDesc "url of git remote to remember with special remote")
+		]
 	, setup = gitSetup
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	}
 
+locationField :: RemoteConfigField
+locationField = Accepted "location"
+
 list :: Bool -> Annex [Git.Repo]
 list autoinit = do
 	c <- fromRepo Git.config
 	rs <- mapM (tweakurl c) =<< Annex.getGitRemotes
 	mapM (configRead autoinit) rs
   where
-	annexurl n = Git.ConfigKey ("remote." <> encodeBS' n <> ".annexurl")
+	annexurl r = remoteConfig r "annexurl"
 	tweakurl c r = do
 		let n = fromJust $ Git.remoteName r
-		case M.lookup (annexurl n) c of
+		case M.lookup (annexurl r) c of
 			Nothing -> return r
 			Just url -> inRepo $ \g ->
 				Git.Construct.remoteNamed n $
@@ -111,7 +120,8 @@ list autoinit = do
 gitSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 gitSetup Init mu _ c _ = do
 	let location = fromMaybe (giveup "Specify location=url") $
-		Url.parseURIRelaxed =<< M.lookup "location" c
+		Url.parseURIRelaxed . fromProposedAccepted
+			=<< M.lookup locationField c
 	rs <- Annex.getGitRemotes
 	u <- case filter (\r -> Git.location r == Git.Url location) rs of
 		[r] -> getRepoUUID r
@@ -125,7 +135,7 @@ gitSetup (Enable _) (Just u) _ c _ = do
 		[ Param "remote"
 		, Param "add"
 		, Param $ fromMaybe (giveup "no name") (SpecialRemote.lookupName c)
-		, Param $ fromMaybe (giveup "no location") (M.lookup "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"
@@ -151,7 +161,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.
@@ -202,7 +212,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
@@ -238,7 +248,7 @@ tryGitConfigRead autoinit r
 	| haveconfig r = return r -- already read
 	| Git.repoIsSsh r = storeUpdatedRemote $ do
 		v <- Ssh.onRemote NoConsumeStdin r
-			(pipedconfig, return (Left $ giveup "configlist failed"))
+			(pipedconfig autoinit (Git.repoDescribe r), return (Left $ giveup "configlist failed"))
 			"configlist" [] configlistfields
 		case v of
 			Right r'
@@ -246,30 +256,32 @@ tryGitConfigRead autoinit r
 				| otherwise -> configlist_failed
 			Left _ -> configlist_failed
 	| Git.repoIsHttp r = storeUpdatedRemote geturlconfig
-	| Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteConfig r "uuid")
+	| Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteAnnexConfig r "uuid")
 	| Git.repoIsUrl r = return r
 	| otherwise = storeUpdatedRemote $ liftIO $ 
 		readlocalannexconfig `catchNonAsync` (const $ return r)
   where
 	haveconfig = not . M.null . Git.config
 
-	pipedconfig cmd params = do
+	pipedconfig mustincludeuuuid configloc cmd params = do
 		v <- liftIO $ Git.Config.fromPipe r cmd params
 		case v of
-			Right (r', val) -> do
-				unless (isUUIDConfigured r' || S.null val) $ do
+			Right (r', val, _err) -> do
+				unless (isUUIDConfigured r' || S.null val || not mustincludeuuuid) $ do
 					warning $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
 					warning $ "Instead, got: " ++ show val
 					warning $ "This is unexpected; please check the network transport!"
 				return $ Right r'
-			Left l -> return $ Left l
+			Left l -> do
+				warning $ "Unable to parse git config from " ++ configloc
+				return $ Left l
 
-	geturlconfig = Url.withUrlOptions $ \uo -> do
+	geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do
 		v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do
 			liftIO $ hClose h
 			let url = Git.repoLocation r ++ "/config"
 			ifM (liftIO $ Url.downloadQuiet nullMeterUpdate url tmpfile uo)
-				( Just <$> pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
+				( Just <$> pipedconfig False url "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
 				, return Nothing
 				)
 		case v of
@@ -370,7 +382,7 @@ inAnnex' repo rmt (State connpool duc _ _) key
 	checkhttp = do
 		showChecking repo
 		gc <- Annex.getGitConfig
-		ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key))
+		ifM (Url.withUrlOptionsPromptingCreds $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key))
 			( return True
 			, giveup "not found"
 			)
@@ -420,7 +432,9 @@ dropKey' repo r (State connpool duc _ _) key
 				return True
 		, return False
 		)
-	| Git.repoIsHttp repo = giveup "dropping from http remote not supported"
+	| Git.repoIsHttp repo = do
+		warning "dropping from http remote not supported"
+		return False
 	| otherwise = commitOnCleanup repo r $ do
 		let fallback = Ssh.dropKey repo key
 		P2PHelper.remove (Ssh.runProto r connpool (return False) fallback) key
@@ -502,7 +516,8 @@ copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile
 copyFromRemote'' repo forcersync r st@(State connpool _ _ _) key file dest meterupdate
 	| Git.repoIsHttp repo = unVerified $ do
 		gc <- Annex.getGitConfig
-		Annex.Content.downloadUrl key meterupdate (keyUrls gc repo r key) dest
+		Url.withUrlOptionsPromptingCreds $
+			Annex.Content.downloadUrl key meterupdate (keyUrls gc repo r key) dest
 	| not $ Git.repoIsUrl repo = guardUsable repo (unVerified (return False)) $ do
 		params <- Ssh.rsyncParams r Download
 		u <- getUUID
@@ -523,7 +538,9 @@ copyFromRemote'' repo forcersync r st@(State connpool _ _ _) key file dest meter
 		else P2PHelper.retrieve
 			(\p -> Ssh.runProto r connpool (return (False, UnVerified)) (fallback p))
 			key file dest meterupdate
-	| otherwise = giveup "copying from non-ssh, non-http remote not supported"
+	| otherwise = do
+		warning "copying from non-ssh, non-http remote not supported"
+		unVerified (return False)
   where
 	fallback p = unVerified $ feedprogressback $ \p' -> do
 		oh <- mkOutputHandlerQuiet
@@ -636,7 +653,9 @@ copyToRemote' repo r st@(State connpool duc _ _) key file meterupdate
 			(\p -> Ssh.runProto r connpool (return False) (copyremotefallback p))
 			key file meterupdate
 		
-	| otherwise = giveup "copying to non-ssh repo not supported"
+	| otherwise = do
+		warning "copying to non-ssh repo not supported"
+		return False
   where
 	copylocal Nothing = return False
 	copylocal (Just (object, checksuccess)) = do

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.
  -}
@@ -14,6 +14,7 @@ import Types.Remote
 import Annex.Url
 import Types.Key
 import Types.Creds
+import Types.ProposedAccepted
 import qualified Annex
 import qualified Annex.SpecialRemote.Config
 import qualified Git
@@ -24,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
@@ -35,6 +37,7 @@ import Crypto
 import Backend.Hash
 import Utility.Hash
 import Utility.SshHost
+import Utility.Url
 import Logs.Remote
 import Logs.RemoteState
 import qualified Utility.GitLFS as LFS
@@ -52,18 +55,25 @@ 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 = mkRemoteConfigParser
+		[ optionalStringParser urlField
+			(FieldDesc "url of git-lfs repository")
+		]
 	, 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.
@@ -127,9 +137,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 c'
+	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,"
@@ -155,10 +166,11 @@ mySetup _ mu _ c gc = do
 	-- (so it's also usable by git as a non-special remote),
 	-- and set remote.name.annex-git-lfs = true
 	gitConfigSpecialRemote u c' [("git-lfs", "true")]
-	setConfig (Git.ConfigKey ("remote." <> encodeBS' (getRemoteName c) <> ".url")) url
+	setConfig (remoteConfig (getRemoteName c) "url") url
 	return (c', u)
   where
-	url = fromMaybe (giveup "Specify url=") (M.lookup "url" c)
+	url = maybe (giveup "Specify url=") fromProposedAccepted 
+		(M.lookup urlField c)
 	remotename = fromJust (lookupName c)
 
 {- Check if a remote's url is one known to belong to a git-lfs repository.
@@ -175,8 +187,10 @@ configKnownUrl r
 	| otherwise = return Nothing
   where
 	match g c = fromMaybe False $ do
-		t <- M.lookup Annex.SpecialRemote.Config.typeField c
-		u <- M.lookup "url" c
+		t <- fromProposedAccepted
+			<$> M.lookup Annex.SpecialRemote.Config.typeField c
+		u <- fromProposedAccepted
+			<$> M.lookup urlField c
 		let u' = Git.Remote.parseRemoteLocation u g
 		return $ Git.Remote.RemoteUrl (Git.repoLocation r) == u' 
 			&& t == typename remote
@@ -187,7 +201,7 @@ configKnownUrl r
 				set "config-uuid" (fromUUID cu) r'
 			Nothing -> return r'
 	set k v r' = do
-		let k' = remoteConfig r' k
+		let k' = remoteAnnexConfig r' k
 		setConfig k' v
 		return $ Git.Config.store' k' (Git.ConfigValue (encodeBS' v)) r'
 
@@ -270,7 +284,7 @@ discoverLFSEndpoint tro h
 				if needauth (responseStatus resp)
 					then do
 						cred <- prompt $ inRepo $ Git.getUrlCredential (show lfsrepouri)
-						let endpoint' = addbasicauth cred endpoint
+						let endpoint' = addbasicauth (Git.credentialBasicAuth cred) endpoint
 						let testreq' = LFS.startTransferRequest endpoint' transfernothing
 						flip catchNonAsync (const (returnendpoint endpoint')) $ do
 						resp' <- makeSmallAPIRequest testreq'
@@ -290,12 +304,10 @@ discoverLFSEndpoint tro h
 
 		needauth status = status == unauthorized401
 
-		addbasicauth cred endpoint =
-			case (Git.credentialUsername cred, Git.credentialPassword cred) of
-				(Just u, Just p) ->
-					LFS.modifyEndpointRequest endpoint $
-						applyBasicAuth (encodeBS u) (encodeBS p)
-				_ -> endpoint
+		addbasicauth (Just ba) endpoint =
+			LFS.modifyEndpointRequest endpoint $
+				applyBasicAuth' ba
+		addbasicauth Nothing endpoint = endpoint
 
 -- The endpoint is cached for later use.
 getLFSEndpoint :: LFS.TransferRequestOperation -> TVar LFSHandle -> Annex (Maybe LFS.Endpoint)

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
@@ -25,21 +26,40 @@ import Utility.Metered
 import qualified Annex
 import Annex.UUID
 import Utility.Env
+import Types.ProposedAccepted
 
 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
+			(FieldDesc "S3 datacenter to use")
+		, optionalStringParser vaultField
+			(FieldDesc "name to use for vault")
+		, optionalStringParser fileprefixField
+			(FieldDesc "prefix to add to filenames in the vault")
+		, optionalStringParser AWS.s3credsField HiddenField
+		]
 	, 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
@@ -99,8 +119,10 @@ 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 fullconfig
 	case ss of
-		Init -> genVault fullconfig gc u
+		Init -> genVault pc gc u
 		_ -> return ()
 	gitConfigSpecialRemote u fullconfig [("glacier", "true")]
 	return (fullconfig, u)
@@ -108,8 +130,8 @@ glacierSetup' ss u mcreds c gc = do
 	remotename = fromJust (lookupName c)
 	defvault = remotename ++ "-" ++ fromUUID u
 	defaults = M.fromList
-		[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.Glacier)
-		, ("vault", defvault)
+		[ (datacenterField, Proposed $ T.unpack $ AWS.defaultRegion AWS.Glacier)
+		, (vaultField, Proposed defvault)
 		]
 
 prepareStore :: Remote -> Preparer Storer
@@ -224,21 +246,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=" ++
 		fromMaybe (giveup "Missing datacenter configuration")
-			(M.lookup "datacenter" c)
+			(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
@@ -251,16 +273,17 @@ glacierEnv c gc u = do
 	creds = AWS.creds u
 	(uk, pk) = credPairEnvironment creds
 
-getVault :: RemoteConfig -> Vault
+getVault :: ParsedRemoteConfig -> Vault
 getVault = fromMaybe (giveup "Missing vault configuration") 
-	. M.lookup "vault"
+	. getRemoteConfigValue vaultField
 
 archive :: Remote -> Key -> Archive
 archive r k = fileprefix ++ serializeKey k
   where
-	fileprefix = M.findWithDefault "" "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

Remote/Helper/AWS.hs

@@ -12,6 +12,8 @@ module Remote.Helper.AWS where
 
 import Annex.Common
 import Creds
+import Types.ProposedAccepted
+import Types.RemoteConfig
 
 import qualified Data.Map as M
 import qualified Data.ByteString as B
@@ -23,9 +25,12 @@ creds :: UUID -> CredPairStorage
 creds u = CredPairStorage
 	{ credPairFile = fromUUID u
 	, credPairEnvironment = ("AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY")
-	, credPairRemoteField = "s3creds"
+	, credPairRemoteField = s3credsField
 	}
 
+s3credsField :: RemoteConfigField
+s3credsField = Accepted "s3creds"
+
 data Service = S3 | Glacier
 	deriving (Eq)
 

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,17 +10,20 @@ module Remote.Helper.Chunked (
 	ChunkConfig(..),
 	noChunks,
 	describeChunkConfig,
+	chunkConfigParsers,
 	getChunkConfig,
 	storeChunks,
 	removeChunks,
 	retrieveChunks,
 	checkPresentChunks,
+	chunkField,
 ) where
 
 import Annex.Common
 import Utility.DataUnits
 import Types.StoreRetrieve
 import Types.Remote
+import Types.ProposedAccepted
 import Logs.Chunk
 import Utility.Metered
 import Crypto (EncKey)
@@ -28,7 +31,6 @@ import Backend (isStableKey)
 import Annex.SpecialRemote.Config
 
 import qualified Data.ByteString.Lazy as L
-import qualified Data.Map as M
 
 data ChunkConfig
 	= NoChunks
@@ -48,19 +50,26 @@ noChunks :: ChunkConfig -> Bool
 noChunks NoChunks = True
 noChunks _ = False
 
-getChunkConfig :: RemoteConfig -> ChunkConfig
-getChunkConfig m =
-	case M.lookup chunksizeField m of
-		Nothing -> case M.lookup "chunk" m of
+chunkConfigParsers :: [RemoteConfigFieldParser]
+chunkConfigParsers =
+	[ optionalStringParser chunksizeField HiddenField -- deprecated
+	, optionalStringParser chunkField
+		(FieldDesc "size of chunks (eg, 1MiB)")
+	]
+
+getChunkConfig :: ParsedRemoteConfig -> ChunkConfig
+getChunkConfig c =
+	case getRemoteConfigValue chunksizeField c of
+		Nothing -> case getRemoteConfigValue chunkField c of
 			Nothing -> NoChunks
-			Just v -> readsz UnpaddedChunks v "chunk"
+			Just v -> readsz UnpaddedChunks v chunkField
 		Just v -> readsz LegacyChunks 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)
-		_ -> giveup $ "bad configuration " ++ f ++ "=" ++ v
+			| size > 0 -> mk (fromInteger size)
+		_ -> giveup $ "bad configuration " ++ fromProposedAccepted f ++ "=" ++ v
 
 -- An infinite stream of chunk keys, starting from chunk 1.
 newtype ChunkKeyStream = ChunkKeyStream [Key]

Remote/Helper/Encryptable.hs

@@ -1,15 +1,19 @@
 {- 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,
+	encryptionConfigParsers,
+	parseEncryptionConfig,
 	remoteCipher,
 	remoteCipher',
 	embedCreds,
@@ -17,17 +21,20 @@ module Remote.Helper.Encryptable (
 	extractCipher,
 	isEncrypted,
 	describeEncryption,
+	encryptionField,
+	highRandomQualityField
 ) 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
 import Crypto
 import Types.Crypto
+import Types.ProposedAccepted
 import qualified Annex
 import Annex.SpecialRemote.Config
 
@@ -46,67 +53,170 @@ noEncryptionUsed = NoEncryption
 encryptionAlreadySetup :: EncryptionIsSetup
 encryptionAlreadySetup = EncryptionIsSetup
 
+encryptionConfigParsers :: [RemoteConfigFieldParser]
+encryptionConfigParsers =
+	[ encryptionFieldParser
+	, optionalStringParser cipherField HiddenField
+	, optionalStringParser cipherkeysField HiddenField
+	, optionalStringParser pubkeysField HiddenField
+	, yesNoParser embedCredsField False
+		(FieldDesc "embed credentials into git repository")
+	, macFieldParser
+	, optionalStringParser (Accepted "keyid")
+		(FieldDesc "gpg key id")
+	, optionalStringParser (Accepted "keyid+")
+		(FieldDesc "add additional gpg key")
+	, optionalStringParser (Accepted "keyid-")
+		(FieldDesc "remove gpg key")
+	, highRandomQualityFieldParser
+	]
+
+encryptionConfigs :: S.Set RemoteConfigField
+encryptionConfigs = S.fromList (map parserForField encryptionConfigParsers)
+
+-- Parse only encryption fields, ignoring all others.
+parseEncryptionConfig :: RemoteConfig -> Either String ParsedRemoteConfig
+parseEncryptionConfig c = parseRemoteConfig
+	(M.restrictKeys c encryptionConfigs)
+	(RemoteConfigParser encryptionConfigParsers Nothing)
+
+encryptionFieldParser :: RemoteConfigFieldParser
+encryptionFieldParser = RemoteConfigFieldParser
+	{ parserForField = encryptionField
+	, valueParser = \v c -> Just . RemoteConfigValue
+		<$> parseEncryptionMethod (fmap fromProposedAccepted v) c
+	, fieldDesc = FieldDesc "how to encrypt data stored in the special remote"
+	, valueDesc = Just $ ValueDesc $
+		intercalate " or " (M.keys encryptionMethods)
+	}
+
+encryptionMethods :: M.Map String EncryptionMethod
+encryptionMethods = M.fromList
+	[ ("none", NoneEncryption)
+	, ("shared", SharedEncryption)
+	, ("hybrid", HybridEncryption)
+	, ("pubkey", PubKeyEncryption)
+	, ("sharedpubkey", SharedPubKeyEncryption)
+	]
+
+parseEncryptionMethod :: Maybe String -> RemoteConfig -> Either String EncryptionMethod
+parseEncryptionMethod (Just s) _ = case M.lookup s encryptionMethods of
+	Just em -> Right em
+	Nothing -> Left badEncryptionMethod
+-- 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
+	| otherwise = Left badEncryptionMethod
+
+badEncryptionMethod :: String
+badEncryptionMethod = "Specify " ++ intercalate " or "
+	(map ((fromProposedAccepted encryptionField ++ "=") ++)
+		(M.keys encryptionMethods))
+	++ "."
+
+highRandomQualityField :: RemoteConfigField
+highRandomQualityField = Accepted "highRandomQuality"
+
+highRandomQualityFieldParser :: RemoteConfigFieldParser
+highRandomQualityFieldParser = RemoteConfigFieldParser
+	{ parserForField = highRandomQualityField
+	, valueParser = \v _c -> Just . RemoteConfigValue
+		<$> parseHighRandomQuality (fmap fromProposedAccepted v)
+	, fieldDesc = HiddenField
+	, valueDesc = Nothing
+	}
+ 
+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"
+	
+macFieldParser :: RemoteConfigFieldParser
+macFieldParser = RemoteConfigFieldParser
+	{ parserForField = macField
+	, valueParser = \v _c -> Just . RemoteConfigValue <$> parseMac v
+	, fieldDesc = FieldDesc "how to encrypt filenames used on the remote"
+	, valueDesc = Just $ ValueDesc $
+		intercalate " or " (M.keys macMap)
+	}
+
+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 $ parseEncryptionConfig c
 	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 = 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
-		_ | hasEncryptionConfig c -> cannotchange
-		Just "none" -> return (c, NoEncryption)
-		Just "shared" -> encsetup $ genSharedCipher cmd
-		-- hybrid encryption is the default when a keyid is
-		-- specified but no encryption
-		_ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
-			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 ((encryptionField ++ "=") ++)
-				["none","shared","hybrid","pubkey", "sharedpubkey"])
-			++ "."
-	key = fromMaybe (giveup "Specify keyid=...") $ M.lookup "keyid" c
-	newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++
-		maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c)
+	genCipher pc cmd = case encryption of
+		Right NoneEncryption -> return (c, NoEncryption)
+		Right SharedEncryption -> encsetup $ genSharedCipher cmd
+		Right HybridEncryption -> encsetup $ genEncryptedCipher cmd (pc, gc) key Hybrid
+		Right PubKeyEncryption -> encsetup $ genEncryptedCipher cmd (pc, gc) key PubKey
+		Right SharedPubKeyEncryption -> encsetup $ genSharedPubKeyCipher cmd key
+		Left err -> giveup err
+	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
-		SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
-		EncryptedCipher _ variant _
-			| maybe True (== if variant == Hybrid then "hybrid" else "pubkey") encryption -> do
-				use "encryption update" $ updateCipherKeyIds cmd (c, gc) newkeys v
+	updateCipher pc cmd v = case v of
+		SharedCipher _ | encryption == Right SharedEncryption ->
+			return (c', EncryptionIsSetup)
+		EncryptedCipher _ variant _ | sameasencryption variant ->
+			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 = 
-		(&&) (maybe True ( /= "false") $ M.lookup "highRandomQuality" c)
-			<$> fmap not (Annex.getState Annex.fast)
+	highRandomQuality = ifM (Annex.getState Annex.fast)
+		( return False
+		, case parseHighRandomQuality (fromProposedAccepted <$> M.lookup highRandomQualityField 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).
-		[ "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
@@ -128,17 +238,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 c = case yesNo =<< M.lookup "embedcreds" c of
+embedCreds :: ParsedRemoteConfig -> Bool
+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 $ M.lookup macField c >>= readMac
+	mac = fromMaybe defaultMac $ getRemoteConfigValue macField c
 
 {- Stores an StorableCipher in a remote's configuration. -}
 storeCipher :: StorableCipher -> RemoteConfig -> RemoteConfig
@@ -147,40 +259,32 @@ storeCipher cip = case cip of
 	(EncryptedCipher t _ ks) -> addcipher t . storekeys ks cipherkeysField
 	(SharedPubKeyCipher t ks) -> addcipher t . storekeys ks pubkeysField
   where
-	addcipher t = M.insert cipherField (toB64bs t)
-	storekeys (KeyIds l) n = M.insert n (intercalate "," l)
+	addcipher t = M.insert cipherField (Accepted (toB64bs t))
+	storekeys (KeyIds l) n = M.insert n (Accepted (intercalate "," l))
 
 {- Extracts an StorableCipher from a remote's configuration. -}
-extractCipher :: RemoteConfig -> Maybe StorableCipher
-extractCipher c = case (M.lookup cipherField c,
-			M.lookup cipherkeysField c <|> M.lookup pubkeysField c,
-			M.lookup encryptionField c) of
-	(Just t, Just ks, encryption) | maybe True (== "hybrid") encryption ->
+extractCipher :: ParsedRemoteConfig -> Maybe StorableCipher
+extractCipher c = case (getRemoteConfigValue cipherField c,
+			(getRemoteConfigValue cipherkeysField c <|> getRemoteConfigValue pubkeysField c),
+			getRemoteConfigValue encryptionField c) of
+	(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 c = case M.lookup encryptionField c of
-	Just "none" -> False
-	Just _ -> True
-	Nothing -> hasEncryptionConfig c
+isEncrypted :: ParsedRemoteConfig -> Bool
+isEncrypted = isJust . extractCipher
 
-hasEncryptionConfig :: RemoteConfig -> Bool
-hasEncryptionConfig c = M.member cipherField c
-	|| M.member cipherkeysField c
-	|| M.member pubkeysField c
-
-describeEncryption :: RemoteConfig -> String
+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

@@ -13,25 +13,25 @@ import Annex.Common
 import Types.Remote
 import Types.Backend
 import Types.Key
+import Types.ProposedAccepted
 import Backend
 import Remote.Helper.Encryptable (isEncrypted)
 import qualified Database.Export as Export
 import qualified Database.ContentIdentifier as ContentIdentifier
 import Annex.Export
 import Annex.LockFile
-import Config
+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
@@ -50,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
@@ -63,59 +63,70 @@ 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 setting cont =
-			ifM (supported rt c gc)
+	configparser c = addRemoteConfigParser exportImportConfigParsers 
+		<$> configParser rt c
+	setup' st mu cp c gc = do
+		pc <- either giveup return . parseRemoteConfig c =<< configparser c
+		let checkconfig supported configured configfield cont =
+			ifM (supported rt pc gc)
 				( case st of
 					Init
-						| configured c && isEncrypted c ->
-							giveup $ "cannot enable both encryption and " ++ setting
+						| configured pc && isEncrypted pc ->
+							giveup $ "cannot enable both encryption and " ++ fromProposedAccepted configfield
 						| otherwise -> cont
-					Enable oldc
-						| configured c /= configured oldc ->
-							giveup $ "cannot change " ++ setting ++ " of existing special remote"
-						| otherwise -> cont
-				, if configured c
-					then giveup $ setting ++ " is not supported by this special remote"
+					Enable oldc -> do
+						oldpc <- either mempty id . parseRemoteConfig oldc <$> configparser oldc
+						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 "exporttree" $
-			checkconfig importSupported importTree "importtree" $
-				if importTree c && not (exportTree c)
+		checkconfig exportSupported exportTree exportTreeField $
+			checkconfig importSupported importTree importTreeField $
+				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
 
+exportImportConfigParsers :: [RemoteConfigFieldParser]
+exportImportConfigParsers =
+	[ yesNoParser exportTreeField False
+		(FieldDesc "export trees of files to this remote")
+	, yesNoParser importTreeField False
+		(FieldDesc "import trees of files from this remote")
+	]
+
 -- | 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 "exporttree" (config r) of
+adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) of
 	Nothing -> return $ notexport r
-	Just c -> case yesNo 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

@@ -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.
  -}
@@ -30,6 +30,8 @@ module Remote.Helper.Special (
 	checkPresentDummy,
 	SpecialRemoteCfg(..),
 	specialRemoteCfg,
+	specialRemoteConfigParsers,
+	specialRemoteType,
 	specialRemote,
 	specialRemote',
 	lookupName,
@@ -79,8 +81,8 @@ findSpecialRemotes s = do
 gitConfigSpecialRemote :: UUID -> RemoteConfig -> [(String, String)] -> Annex ()
 gitConfigSpecialRemote u c cfgs = do
 	forM_ cfgs $ \(k, v) -> 
-		setConfig (remoteConfig c (encodeBS' k)) v
-	storeUUIDIn (remoteConfig c "uuid") u
+		setConfig (remoteAnnexConfig c (encodeBS' k)) v
+	storeUUIDIn (remoteAnnexConfig c "uuid") u
 
 -- RetrievalVerifiableKeysSecure unless overridden by git config.
 --
@@ -149,7 +151,7 @@ checkPresentDummy :: Key -> Annex Bool
 checkPresentDummy _ = error "missing checkPresent implementation"
 
 type RemoteModifier
-	= RemoteConfig
+	= ParsedRemoteConfig
 	-> Preparer Storer
 	-> Preparer Retriever
 	-> Preparer Remover
@@ -162,9 +164,19 @@ data SpecialRemoteCfg = SpecialRemoteCfg
 	, displayProgress :: Bool
 	}
 
-specialRemoteCfg :: RemoteConfig -> 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 = \c -> addRemoteConfigParser specialRemoteConfigParsers
+		<$> configParser r c
+	}
+
+specialRemoteConfigParsers :: [RemoteConfigFieldParser]
+specialRemoteConfigParsers = chunkConfigParsers ++ encryptionConfigParsers
+
 -- Modifies a base Remote to support both chunking and encryption,
 -- which special remotes typically should support.
 -- 
@@ -212,7 +224,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)
 

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,11 +15,13 @@ 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
 import Utility.Env
 import Messages.Progress
+import Types.ProposedAccepted
 
 import qualified Data.Map as M
 
@@ -27,16 +29,23 @@ 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
+			(FieldDesc "(required) specify collection of hooks to use")
+		]
 	, 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
@@ -85,8 +94,8 @@ gen r u c gc rs = do
 hookSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 hookSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	let hooktype = fromMaybe (giveup "Specify hooktype=") $
-		M.lookup "hooktype" c
+	let hooktype = maybe (giveup "Specify hooktype=") fromProposedAccepted $
+		M.lookup hooktypeField c
 	(c', _encsetup) <- encryptionSetup c gc
 	gitConfigSpecialRemote u c' [("hooktype", hooktype)]
 	return (c', u)

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,6 +20,7 @@ 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
 
@@ -109,7 +110,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
+	pc <- either (const mempty) id . parseRemoteConfig c <$> configParser t c
+	generate t g u pc gc rs >>= \case
 		Nothing -> return Nothing
 		Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r)) rs
 
@@ -126,8 +128,8 @@ updateRemote remote = do
 		| otherwise = return r
 
 {- Checks if a remote is syncable using git. -}
-gitSyncableRemote :: Remote -> Bool
-gitSyncableRemote r = remotetype r `elem`
+gitSyncableRemoteType :: RemoteType -> Bool
+gitSyncableRemoteType t = t `elem`
 	[ Remote.Git.remote
 	, Remote.GCrypt.remote
 	, Remote.P2P.remote

Remote/P2P.hs

@@ -36,12 +36,13 @@ remote = RemoteType
 	-- and will call chainGen on them.
 	, enumerate = const (return [])
 	, generate = \_ _ _ _ _ -> return Nothing
+	, configParser = mkRemoteConfigParser []
 	, 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.
  -}
@@ -14,6 +14,7 @@ module Remote.Rsync (
 	remove,
 	checkKey,
 	withRsyncScratchDir,
+	rsyncRemoteConfigs,
 	genRsyncOpts,
 	RsyncOpts
 ) where
@@ -30,6 +31,7 @@ import Remote.Helper.Special
 import Remote.Helper.Messages
 import Remote.Helper.ExportImport
 import Types.Export
+import Types.ProposedAccepted
 import Remote.Rsync.RsyncUrl
 import Crypto
 import Utility.Rsync
@@ -41,20 +43,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 = mkRemoteConfigParser $ rsyncRemoteConfigs ++
+		[ optionalStringParser rsyncUrlField
+			(FieldDesc "(required) url or hostname:/directory for rsync to use")
+		]
 	, 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 $
@@ -111,7 +124,14 @@ gen r u c gc rs = do
 		-- Rsync displays its own progress.
 		{ displayProgress = False }
 
-genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> Annex [CommandParam] -> RsyncUrl -> RsyncOpts
+-- Things used by genRsyncOpts
+rsyncRemoteConfigs :: [RemoteConfigFieldParser]
+rsyncRemoteConfigs = 
+	[ yesNoParser shellEscapeField True
+		(FieldDesc "avoid usual shell escaping (not recommended)")
+	]
+
+genRsyncOpts :: ParsedRemoteConfig -> RemoteGitConfig -> Annex [CommandParam] -> RsyncUrl -> RsyncOpts
 genRsyncOpts c gc transport url = RsyncOpts
 	{ rsyncUrl = url
 	, rsyncOptions = appendtransport $ opts []
@@ -119,7 +139,7 @@ genRsyncOpts c gc transport url = RsyncOpts
 		opts (remoteAnnexRsyncUploadOptions gc)
 	, rsyncDownloadOptions = appendtransport $
 		opts (remoteAnnexRsyncDownloadOptions gc)
-	, rsyncShellEscape = (yesNo =<< M.lookup "shellescape" c) /= Just False
+	, rsyncShellEscape = fromMaybe True (getRemoteConfigValue shellEscapeField c)
 	}
   where
 	appendtransport l = (++ l) <$> transport
@@ -161,8 +181,8 @@ rsyncSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> Remo
 rsyncSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
-	let url = fromMaybe (giveup "Specify rsyncurl=") $
-		M.lookup "rsyncurl" c
+	let url = maybe (giveup "Specify rsyncurl=") fromProposedAccepted $
+		M.lookup rsyncUrlField c
 	(c', _encsetup) <- encryptionSetup c gc
 
 	-- The rsyncurl is stored in git config, not only in this remote's

Remote/Rsync/RsyncUrl.hs

@@ -43,10 +43,10 @@ mkRsyncUrl o f = rsyncUrl o </> rsyncEscape o f
 rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl]
 rsyncUrls o k = map use dirHashes
   where
-	use h = rsyncUrl o </> fromRawFilePath (hash h) </> rsyncEscape o (f </> f)
+	use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f)
 	f = fromRawFilePath (keyFile k)
 #ifndef mingw32_HOST_OS
-	hash h = h def k
+	hash h = fromRawFilePath $ h def k
 #else
-	hash h = replace "\\" "/" (h def k)
+	hash h = replace "\\" "/" $ fromRawFilePath $ h def k
 #endif

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.
  -}
@@ -57,6 +57,7 @@ import Annex.Magic
 import Logs.Web
 import Logs.MetaData
 import Types.MetaData
+import Types.ProposedAccepted
 import Utility.Metered
 import Utility.DataUnits
 import Annex.Content
@@ -68,16 +69,92 @@ type BucketName = String
 type BucketObject = String
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "S3"
 	, enumerate = const (findSpecialRemotes "s3")
 	, generate = gen
+	, configParser = const $ pure $ RemoteConfigParser
+		{ remoteConfigFieldParsers = 
+			[ optionalStringParser bucketField
+				(FieldDesc "name of bucket to store content in")
+			, optionalStringParser hostField
+				(FieldDesc "S3 server hostname (default is Amazon S3)")
+			, optionalStringParser datacenterField
+				(FieldDesc "S3 datacenter to use (US, EU, us-west-1, ..)")
+			, optionalStringParser partsizeField
+				(FieldDesc "part size for multipart upload (eg 1GiB)")
+			, optionalStringParser storageclassField
+				(FieldDesc "storage class, eg STANDARD or REDUCED_REDUNDANCY")
+			, optionalStringParser fileprefixField
+				(FieldDesc "prefix to add to filenames in the bucket")
+			, yesNoParser versioningField False
+				(FieldDesc "enable versioning of bucket content")
+			, yesNoParser publicField False
+				(FieldDesc "allow public read access to the buckey")
+			, optionalStringParser publicurlField
+				(FieldDesc "url that can be used by public to download files")
+			, optionalStringParser protocolField
+				(FieldDesc "http or https")
+			, optionalStringParser portField
+				(FieldDesc "port to connect to")
+			, optionalStringParser requeststyleField
+				(FieldDesc "for path-style requests, set to \"path\"")
+			, optionalStringParser mungekeysField HiddenField
+			, optionalStringParser AWS.s3credsField HiddenField
+			]
+		, remoteConfigRestPassthrough = Just
+			( \f -> isMetaHeader f || isArchiveMetaHeader f
+			,
+				[ ("x-amz-meta-*", FieldDesc "http headers to add when storing on S3")
+				, ("x-archive-meta-*", FieldDesc "http headers to add when storing on Internet Archive")
+			  	]
+			)
+		}
 	, 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
@@ -134,7 +211,7 @@ gen r u c gc rs = do
 			, appendonly = versioning info
 			, availability = GloballyAvailable
 			, remotetype = remote
-			, mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc rs
+			, mkUnavailable = gen r u (M.insert hostField (RemoteConfigValue ("!dne!" :: String)) c) gc rs
 			, getInfo = includeCredsInfo c (AWS.creds u) (s3Info c info)
 			, claimUrl = Nothing
 			, checkUrl = Nothing
@@ -148,21 +225,21 @@ s3Setup ss mu mcreds c gc = do
 
 s3Setup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 s3Setup' ss u mcreds c gc
-	| configIA c = archiveorg
+	| maybe False (isIAHost . fromProposedAccepted) (M.lookup hostField c) = archiveorg
 	| otherwise = defaulthost
   where
 	remotename = fromJust (lookupName c)
 	defbucket = remotename ++ "-" ++ fromUUID u
 	defaults = M.fromList
-		[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.S3)
-		, ("storageclass", "STANDARD")
-		, ("host", AWS.s3DefaultHost)
-		, ("port", "80")
-		, ("bucket", defbucket)
+		[ (datacenterField, Proposed $ T.unpack $ AWS.defaultRegion AWS.S3)
+		, (storageclassField, Proposed "STANDARD")
+		, (hostField, Proposed AWS.s3DefaultHost)
+		, (portField, Proposed "80")
+		, (bucketField, Proposed defbucket)
 		]
 
-	use fullconfig info = do
-		enableBucketVersioning ss info fullconfig gc u
+	use fullconfig pc info = do
+		enableBucketVersioning ss info pc gc u
 		gitConfigSpecialRemote u fullconfig [("s3", "true")]
 		return (fullconfig, u)
 
@@ -170,36 +247,40 @@ s3Setup' ss u mcreds c gc
 		(c', encsetup) <- encryptionSetup c gc
 		c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 		let fullconfig = c'' `M.union` defaults
-		info <- extractS3Info fullconfig
-		checkexportimportsafe fullconfig info
+		pc <- either giveup return . parseRemoteConfig fullconfig
+			=<< configParser remote fullconfig
+		info <- extractS3Info pc
+		checkexportimportsafe pc info
 		case ss of
-			Init -> genBucket fullconfig gc u
+			Init -> genBucket pc gc u
 			_ -> return ()
-		use fullconfig info
+		use fullconfig pc info
 
 	archiveorg = do
 		showNote "Internet Archive mode"
 		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.
-		let validbucket = replace " " "-" $
-			fromMaybe (giveup "specify bucket=") $
-				getBucketName c'
+		let validbucket = replace " " "-" $ map toLower $
+			maybe (giveup "specify bucket=") fromProposedAccepted
+				(M.lookup bucketField c')
 		let archiveconfig = 
 			-- IA acdepts x-amz-* as an alias for x-archive-*
-			M.mapKeys (replace "x-archive-" "x-amz-") $
+			M.mapKeys (Proposed . replace "x-archive-" "x-amz-" . fromProposedAccepted) $
 			-- encryption does not make sense here
-			M.insert encryptionField "none" $
-			M.insert "bucket" validbucket $
+			M.insert encryptionField (Proposed "none") $
+			M.insert bucketField (Proposed validbucket) $
 			M.union c' $
 			-- special constraints on key names
-			M.insert "mungekeys" "ia" defaults
-		info <- extractS3Info archiveconfig
-		checkexportimportsafe archiveconfig info
-		hdl <- mkS3HandleVar archiveconfig gc u
+			M.insert mungekeysField (Proposed "ia") defaults
+		pc <- either giveup return . parseRemoteConfig archiveconfig
+			=<< configParser remote archiveconfig
+		info <- extractS3Info pc
+		checkexportimportsafe pc info
+		hdl <- mkS3HandleVar pc gc u
 		withS3HandleOrFail u hdl $
-			writeUUIDFile archiveconfig u info
-		use archiveconfig info
+			writeUUIDFile pc u info
+		use archiveconfig pc info
 	
 	checkexportimportsafe c' info =
 		unlessM (Annex.getState Annex.force) $
@@ -293,7 +374,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
@@ -306,7 +387,7 @@ retrieve hv r rs c info = fileRetriever $ \f k p -> withS3Handle hv $ \case
 			Left failreason -> do
 				warning failreason
 				giveup "cannot download content"
-			Right us -> unlessM (downloadUrl k p us f) $
+			Right us -> unlessM (withUrlOptions $ downloadUrl k p us f) $
 				giveup "failed to download content"
 
 retrieveHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> FilePath -> MeterUpdate -> Annex ()
@@ -330,7 +411,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
@@ -627,7 +708,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
@@ -652,7 +733,7 @@ genBucket c gc u = do
 		writeUUIDFile c u info h
 	
 	locconstraint = mkLocationConstraint $ T.pack datacenter
-	datacenter = fromJust $ M.lookup "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
@@ -667,7 +748,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
@@ -684,7 +765,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
@@ -700,7 +781,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)
@@ -724,7 +805,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
@@ -755,24 +836,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 M.lookup "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 = fromJust $ M.lookup "host" c
-	datacenter = fromJust $ M.lookup "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 M.lookup "port" c of
+	port = case getRemoteConfigValue portField c of
 		Just s -> 
 			case reads s of
 				[(p, _)]
@@ -787,7 +868,7 @@ s3Configuration c = cfg
 			Just AWS.HTTPS -> 443
 			Just AWS.HTTP -> 80
 			Nothing -> 80
-	cfgproto = case M.lookup "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
@@ -814,7 +895,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")
@@ -829,13 +910,13 @@ extractS3Info c = do
 		, metaHeaders = getMetaHeaders c
 		, partSize = getPartSize c
 		, isIA = configIA c
-		, versioning = boolcfg "versioning"
-		, public = boolcfg "public"
-		, publicurl = M.lookup "publicurl" c
-		, host = M.lookup "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 =<< M.lookup k c
 
 putObject :: S3Info -> T.Text -> RequestBody -> S3.PutObject
 putObject info file rbody = (S3.putObject (bucket info) file rbody)
@@ -850,41 +931,51 @@ acl info
 	| public info = Just S3.AclPublicRead
 	| otherwise = Nothing
 
-getBucketName :: RemoteConfig -> Maybe BucketName
-getBucketName = map toLower <$$> M.lookup "bucket"
+getBucketName :: ParsedRemoteConfig -> Maybe BucketName
+getBucketName = map toLower <$$> getRemoteConfigValue bucketField
 
-getStorageClass :: RemoteConfig -> S3.StorageClass
-getStorageClass c = case M.lookup "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 =<< M.lookup "partsize" c
+getPartSize :: ParsedRemoteConfig -> Maybe Integer
+getPartSize c = readSize dataUnits =<< getRemoteConfigValue partsizeField c
 
-getMetaHeaders :: RemoteConfig -> [(T.Text, T.Text)]
-getMetaHeaders = map munge . filter ismetaheader . M.assocs
+getMetaHeaders :: ParsedRemoteConfig -> [(T.Text, T.Text)]
+getMetaHeaders = map munge
+	. filter (isMetaHeader . fst)
+	. M.assocs
+	. getRemoteConfigPassedThrough
   where
-	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 = M.findWithDefault "" "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 M.lookup "mungekeys" c of
+	munge s = case getRemoteConfigValue mungekeysField c :: Maybe String 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
@@ -910,8 +1001,8 @@ iaMunge = (>>= munge)
 		| isSpace c = []
 		| otherwise = "&" ++ show (ord c) ++ ";"
 
-configIA :: RemoteConfig -> Bool
-configIA = maybe False isIAHost . M.lookup "host"
+configIA :: ParsedRemoteConfig -> Bool
+configIA = maybe False isIAHost . getRemoteConfigValue hostField
 
 {- Hostname to use for archive.org S3. -}
 iaHost :: HostName
@@ -963,7 +1054,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)))
@@ -982,10 +1073,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
@@ -1125,7 +1216,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
@@ -1150,7 +1241,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
@@ -1160,7 +1251,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 oldc
+			oldinfo <- extractS3Info oldpc
 			when (versioning info /= versioning oldinfo) $
 				giveup "Cannot change versioning= of existing S3 remote."
   where

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.
  -}
@@ -30,9 +30,11 @@ import Control.Concurrent.STM
 import Annex.Common
 import Types.Remote
 import Types.Creds
+import Types.ProposedAccepted
 import qualified Git
 import Config
 import Config.Cost
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.ExportImport
 import Annex.UUID
@@ -52,16 +54,27 @@ 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
+			(FieldDesc "optional, normally a unique one is generated")
+		, optionalStringParser furlField HiddenField
+		]
 	, 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
@@ -102,22 +115,23 @@ gen r u c gc rs = do
 
 tahoeSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 tahoeSetup _ mu _ c _ = do
-	furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c)
+	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 furl (M.lookup scsk c)
-	let c' = if (yesNo =<< M.lookup "embedcreds" c) == Just True
+	scs <- liftIO $ tahoeConfigure configdir
+		(fromProposedAccepted furl)
+		(fromProposedAccepted <$> (M.lookup scsField c))
+	pc <- either giveup return . parseRemoteConfig c =<< configParser remote c
+	let c' = if embedCreds pc
 		then flip M.union c $ M.fromList
-			[ (furlk, furl)
-			, (scsk, scs)
+			[ (furlField, furl)
+			, (scsField, Proposed scs)
 			]
 		else c
 	gitConfigSpecialRemote u c' [("tahoe", configdir)]
 	return (c', u)
   where
-	scsk = "shared-convergence-secret"
-	furlk = "introducer-furl"
 	missingfurl = giveup "Set TAHOE_FURL to the introducer furl to use."
 
 store :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool

Remote/Web.hs

@@ -27,6 +27,7 @@ remote = RemoteType
 	{ typename = "web"
 	, enumerate = list
 	, generate = gen
+	, configParser = mkRemoteConfigParser []
 	, 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
@@ -89,7 +90,7 @@ downloadKey key _af dest p = unVerified $ get =<< getWebUrls key
 			YoutubeDownloader -> do
 				showOutput
 				youtubeDlTo key u' dest
-			_ -> downloadUrl key p [u'] dest
+			_ -> Url.withUrlOptions $ downloadUrl key p [u'] dest
 
 downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
 downloadKeyCheap _ _ _ = return False

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
@@ -39,18 +40,30 @@ import Utility.Metered
 import Utility.Url (URLString, matchStatusCodeException, matchHttpExceptionContent)
 import Annex.UUID
 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
+			(FieldDesc "(required) url to the WebDAV directory")
+		, optionalStringParser davcredsField HiddenField
+		]
 	, setup = webdavSetup
 	, exportSupported = exportIsSupported
 	, importSupported = importUnsupported
 	}
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
+urlField :: RemoteConfigField
+urlField = Accepted "url"
+
+davcredsField :: RemoteConfigField
+davcredsField = Accepted "davcreds"
+
+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
@@ -95,9 +108,9 @@ gen r u c gc rs = new <$> remoteCost gc expensiveRemoteCost
 			, appendonly = False
 			, availability = GloballyAvailable
 			, remotetype = remote
-			, mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc rs
+			, mkUnavailable = gen r u (M.insert urlField (RemoteConfigValue "http://!dne!/") c) gc rs
 			, getInfo = includeCredsInfo c (davCreds u) $
-				[("url", fromMaybe "unknown" (M.lookup "url" c))]
+				[("url", fromMaybe "unknown" $ getRemoteConfigValue urlField c)]
 			, claimUrl = Nothing
 			, checkUrl = Nothing
 			, remoteStateHandle = rs
@@ -107,11 +120,12 @@ gen r u c gc rs = new <$> remoteCost gc expensiveRemoteCost
 webdavSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 webdavSetup _ mu mcreds c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	url <- case M.lookup "url" c of
-		Nothing -> giveup "Specify url="
-		Just url -> return url
+	url <- maybe (giveup "Specify url=")
+		(return . fromProposedAccepted)
+		(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 c'
+	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
@@ -255,7 +269,7 @@ runExport Nothing _ = return False
 runExport (Just h) a = fromMaybe False <$> liftIO (goDAV h $ safely (a h))
 
 configUrl :: Remote -> Maybe URLString
-configUrl r = fixup <$> M.lookup "url" (config r)
+configUrl r = fixup <$> getRemoteConfigValue urlField (config r)
   where
 	-- box.com DAV url changed
 	fixup = replace "https://www.box.com/dav/" boxComUrl
@@ -335,14 +349,14 @@ 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
 davCreds u = CredPairStorage
 	{ credPairFile = fromUUID u
 	, credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD")
-	, credPairRemoteField = "davcreds"
+	, credPairRemoteField = davcredsField
 	}
 
 {- Content-Type to use for files uploaded to WebDAV. -}

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(..),
@@ -14,6 +15,7 @@ module Types.Crypto (
 	Mac(..),
 	readMac,
 	showMac,
+	macMap,
 	defaultMac,
 	calcMac,
 ) where
@@ -21,6 +23,17 @@ module Types.Crypto (
 import Utility.Hash
 import Utility.Gpg (KeyIds(..))
 
+import Data.Typeable
+import qualified Data.Map as M
+
+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
 
@@ -50,9 +63,13 @@ showMac HmacSha512 = "HMACSHA512"
 
 -- Read the MAC algorithm from the remote config.
 readMac :: String -> Maybe Mac
-readMac "HMACSHA1"   = Just HmacSha1
-readMac "HMACSHA224" = Just HmacSha224
-readMac "HMACSHA256" = Just HmacSha256
-readMac "HMACSHA384" = Just HmacSha384
-readMac "HMACSHA512" = Just HmacSha512
-readMac _ = Nothing
+readMac n = M.lookup n macMap
+
+macMap :: M.Map String Mac
+macMap = M.fromList
+	[ ("HMACSHA1", HmacSha1)
+	, ("HMACSHA224", HmacSha224)
+	, ("HMACSHA256", HmacSha256)
+	, ("HMACSHA384", HmacSha384)
+	, ("HMACSHA512", HmacSha512)
+	]

Types/GitConfig.hs

@@ -80,6 +80,7 @@ data GitConfig = GitConfig
 	, annexAutoCommit :: Configurable Bool
 	, annexResolveMerge :: Configurable Bool
 	, annexSyncContent :: Configurable Bool
+	, annexSyncOnlyAnnex :: Configurable Bool
 	, annexDebug :: Bool
 	, annexWebOptions :: [String]
 	, annexYoutubeDlOptions :: [String]
@@ -152,6 +153,8 @@ extractGitConfig configsource r = GitConfig
 		getmaybebool (annex "resolvemerge")
 	, annexSyncContent = configurable False $ 
 		getmaybebool (annex "synccontent")
+	, annexSyncOnlyAnnex = configurable False $ 
+		getmaybebool (annex "synconlyannex")
 	, annexDebug = getbool (annex "debug") False
 	, annexWebOptions = getwords (annex "web-options")
 	, annexYoutubeDlOptions = getwords (annex "youtube-dl-options")
@@ -232,6 +235,7 @@ mergeGitConfig :: GitConfig -> GitConfig -> GitConfig
 mergeGitConfig gitconfig repoglobals = gitconfig
 	{ annexAutoCommit = merge annexAutoCommit
 	, annexSyncContent = merge annexSyncContent
+	, annexSyncOnlyAnnex = merge annexSyncOnlyAnnex
 	, annexResolveMerge = merge annexResolveMerge
 	, annexLargeFiles = merge annexLargeFiles
 	, annexDotFiles = merge annexDotFiles

Types/ProposedAccepted.hs

@@ -0,0 +1,38 @@
+{- proposed and accepted values
+ -
+ - Copyright 2020 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Types.ProposedAccepted where
+
+import Test.QuickCheck
+
+-- | A value that may be proposed, or accepted.
+--
+-- When parsing/validating the value, may want to error out on invalid
+-- input. But if a previous version of git-annex accepted an invalid value,
+-- it's too late to error out, and instead the bad value may be ignored.
+data ProposedAccepted t = Proposed t | Accepted t
+	deriving (Show)
+
+fromProposedAccepted :: ProposedAccepted t -> t
+fromProposedAccepted (Proposed t) = t
+fromProposedAccepted (Accepted t) = t
+
+-- | Whether a value is proposed or accepted does not matter when checking
+-- equality.
+instance Eq t => Eq (ProposedAccepted t) where
+	a == b = fromProposedAccepted a == fromProposedAccepted b
+
+-- | Order by the contained value, not by whether it's proposed or
+-- accepted.
+instance Ord t => Ord (ProposedAccepted t) where
+	compare a b = compare (fromProposedAccepted a) (fromProposedAccepted b)
+
+instance Arbitrary t => Arbitrary (ProposedAccepted t) where
+	arbitrary = oneof
+		[ Proposed <$> arbitrary
+		, Accepted <$> arbitrary
+		]

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
-	, RemoteConfig
+	( module Types.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,6 +40,7 @@ import Types.UrlContents
 import Types.NumCopies
 import Types.Export
 import Types.Import
+import Types.RemoteConfig
 import Config.Cost
 import Utility.Metered
 import Git.Types (RemoteName)
@@ -49,10 +48,6 @@ import Utility.SafeCommand
 import Utility.Url
 import Utility.DataUnits
 
-type RemoteConfigField = String
-
-type RemoteConfig = M.Map RemoteConfigField String
-
 data SetupStage = Init | Enable RemoteConfig
 
 {- There are different types of remotes. -}
@@ -63,13 +58,15 @@ data RemoteTypeA a = RemoteType
 	-- 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 -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> a (Maybe (RemoteA a))
+	, generate :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> a (Maybe (RemoteA a))
+	-- parse configs of remotes of this type
+	, configParser :: RemoteConfig -> 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
-	, 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
@@ -124,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,69 @@
+{- 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 qualified Data.Set as S
+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
+
+{- 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.
+ -}
+data RemoteConfigFieldParser = RemoteConfigFieldParser
+	{ parserForField :: RemoteConfigField
+	, valueParser :: Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue)
+	, fieldDesc :: FieldDesc
+	, valueDesc :: Maybe ValueDesc
+	}
+
+data FieldDesc
+	= FieldDesc String
+	| HiddenField
+
+newtype ValueDesc = ValueDesc String
+
+data RemoteConfigParser = RemoteConfigParser
+	{ remoteConfigFieldParsers :: [RemoteConfigFieldParser]
+	, remoteConfigRestPassthrough :: Maybe (RemoteConfigField -> Bool, [(String, FieldDesc)])
+	}
+
+mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> RemoteConfig -> m RemoteConfigParser
+mkRemoteConfigParser l _ = pure (RemoteConfigParser l Nothing)
+
+addRemoteConfigParser :: [RemoteConfigFieldParser] -> RemoteConfigParser -> RemoteConfigParser
+addRemoteConfigParser l rpc = rpc
+	{ remoteConfigFieldParsers = 
+		remoteConfigFieldParsers rpc ++ filter isnew l
+	}
+  where
+	s = S.fromList (map parserForField (remoteConfigFieldParsers rpc))
+	isnew p = not (S.member (parserForField p) s)