sameas RemoteConfig inheritance

I found a way to avoid inheritance complicating anything outside of
Logs.Remote. It seems fine to require all inherited values to be
inherited and not set in the sameas remote's config. Since inherited
values will be used for stuff like encryption and perhaps chunking, which
control the actual content stored on the remote, it seems likely that
there will not be any reason to need them to vary between two remotes
that access the same underlying data store.

The newer version of containers is free; the minimum ghc version is
bundled with a newer version than that.

Annex/SpecialRemote/Config.hs

@@ -11,6 +11,7 @@ import Common
 import Types.Remote (RemoteConfigField, RemoteConfig)
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 {- The name of a configured remote is stored in its config using this key. -}
 nameField :: RemoteConfigField
@@ -35,3 +36,13 @@ typeField = "type"
 autoEnableField :: RemoteConfigField
 autoEnableField = "autoenable"
 
+encryptionField :: RemoteConfigField
+encryptionField = "encryption"
+
+{- A remote with sameas-uuid set will inherit these values from the config
+ - of that uuid. These values cannot be overridden. -}
+sameasInherits :: S.Set RemoteConfigField
+sameasInherits = S.fromList
+	[ encryptionField
+	-- TODO more encryption related fields
+	]

Assistant/Gpg.hs

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

Assistant/MakeRemote.hs

@@ -18,6 +18,7 @@ import qualified Git
 import qualified Git.Command
 import qualified Annex
 import qualified Annex.SpecialRemote
+import Annex.SpecialRemote.Config
 import Logs.UUID
 import Logs.Remote
 import Git.Remote
@@ -55,7 +56,7 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
 	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing
 		(Just u, R.Enable c, c)
 	config = M.fromList
-		[ ("encryption", "shared")
+		[ (encryptionField, "shared")
 		, ("rsyncurl", location)
 		, ("type", "rsync")
 		]

Crypto.hs

@@ -45,6 +45,7 @@ import qualified Utility.Gpg as Gpg
 import Types.Crypto
 import Types.Remote
 import Types.Key
+import Annex.SpecialRemote.Config
 
 {- The beginning of a Cipher is used for MAC'ing; the remainder is used
  - as the GPG symmetric encryption passphrase when using the hybrid
@@ -236,7 +237,7 @@ instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where
 	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 "encryption" c of
+		case M.lookup encryptionField c of
 			Just "pubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup "cipherkeys" c
 			Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup "pubkeys" c
 			_ -> []

Logs/Remote.hs

@@ -1,6 +1,6 @@
 {- git-annex remote log
  - 
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
  - 
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -22,6 +22,7 @@ import qualified Annex.Branch
 import Types.Remote
 import Logs
 import Logs.UUIDBased
+import Annex.SpecialRemote.Config
 
 import qualified Data.Map as M
 import Data.Char
@@ -34,14 +35,37 @@ configSet u cfg = do
 	c <- liftIO currentVectorClock
 	Annex.Branch.change remoteLog $
 		buildLogOld (byteString . encodeBS . showConfig)
-			. changeLog c u cfg
+			. changeLog c u (removeSameasInherited cfg)
 			. parseLogOld remoteConfigParser
 
 {- Map of remotes by uuid containing key/value config maps. -}
 readRemoteLog :: Annex (M.Map UUID RemoteConfig)
-readRemoteLog = simpleMap . parseLogOld remoteConfigParser
+readRemoteLog = addSameasInherited 
+	. simpleMap
+	. parseLogOld remoteConfigParser
 	<$> Annex.Branch.get remoteLog
 
+{- Each RemoteConfig that has a sameas-uuid inherits some fields
+ - from it. Such fields can only be set by inheritance; the RemoteConfig
+ - cannot provide values from them. -}
+addSameasInherited :: M.Map UUID RemoteConfig -> M.Map UUID RemoteConfig
+addSameasInherited m = M.map go m
+  where
+	go c = case toUUID <$> M.lookup sameasUUIDField c of
+		Nothing -> c
+		Just sameasuuid -> case M.lookup sameasuuid m of
+			Nothing -> c
+			Just parentc -> 
+				M.withoutKeys c sameasInherits			
+					`M.union`
+				M.restrictKeys parentc sameasInherits
+
+{- Remove any fields inherited from a sameas-uuid. -}
+removeSameasInherited :: RemoteConfig -> RemoteConfig
+removeSameasInherited c = case M.lookup sameasUUIDField c of
+	Nothing -> c
+	Just _ -> M.restrictKeys c sameasInherits
+
 remoteConfigParser :: A.Parser RemoteConfig
 remoteConfigParser = keyValToConfig . words . decodeBS <$> A.takeByteString
 

Remote/Helper/Encryptable.hs

@@ -29,6 +29,7 @@ import Config
 import Crypto
 import Types.Crypto
 import qualified Annex
+import Annex.SpecialRemote.Config
 
 -- Used to ensure that encryption has been set up before trying to
 -- eg, store creds in the remote config that would need to use the
@@ -55,7 +56,7 @@ encryptionSetup c gc = do
 	maybe (genCipher cmd) (updateCipher cmd) (extractCipher c)
   where
 	-- The type of encryption
-	encryption = M.lookup "encryption" c
+	encryption = M.lookup encryptionField c
 	-- Generate a new cipher, depending on the chosen encryption scheme
 	genCipher cmd = case encryption of
 		_ | hasEncryptionConfig c -> cannotchange
@@ -68,7 +69,7 @@ encryptionSetup c gc = do
 		Just "pubkey" -> encsetup $ genEncryptedCipher cmd (c, gc) key PubKey
 		Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key
 		_ -> giveup $ "Specify " ++ intercalate " or "
-			(map ("encryption=" ++)
+			(map ((encryptionField ++ "=") ++)
 				["none","shared","hybrid","pubkey", "sharedpubkey"])
 			++ "."
 	key = fromMaybe (giveup "Specify keyid=...") $ M.lookup "keyid" c
@@ -153,7 +154,7 @@ storeCipher cip = case cip of
 extractCipher :: RemoteConfig -> Maybe StorableCipher
 extractCipher c = case (M.lookup "cipher" c,
 			M.lookup "cipherkeys" c <|> M.lookup "pubkeys" c,
-			M.lookup "encryption" c) of
+			M.lookup encryptionField c) of
 	(Just t, Just ks, encryption) | maybe True (== "hybrid") encryption ->
 		Just $ EncryptedCipher (fromB64bs t) Hybrid (readkeys ks)
 	(Just t, Just ks, Just "pubkey") ->
@@ -167,7 +168,7 @@ extractCipher c = case (M.lookup "cipher" c,
 	readkeys = KeyIds . splitc ','
 
 isEncrypted :: RemoteConfig -> Bool
-isEncrypted c = case M.lookup "encryption" c of
+isEncrypted c = case M.lookup encryptionField c of
 	Just "none" -> False
 	Just _ -> True
 	Nothing -> hasEncryptionConfig c

Remote/S3.hs

@@ -44,6 +44,7 @@ import qualified Git
 import qualified Annex
 import Config
 import Config.Cost
+import Annex.SpecialRemote.Config
 import Remote.Helper.Special
 import Remote.Helper.Http
 import Remote.Helper.Messages
@@ -188,7 +189,7 @@ s3Setup' ss u mcreds c gc
 			-- IA acdepts x-amz-* as an alias for x-archive-*
 			M.mapKeys (replace "x-archive-" "x-amz-") $
 			-- encryption does not make sense here
-			M.insert "encryption" "none" $
+			M.insert encryptionField "none" $
 			M.insert "bucket" validbucket $
 			M.union c' $
 			-- special constraints on key names

git-annex.cabal

@@ -304,7 +304,7 @@ Executable git-annex
    base (>= 4.11.1.0 && < 5.0),
    network-uri (>= 2.6),
    optparse-applicative (>= 0.14.1),
-   containers (>= 0.5.7.1),
+   containers (>= 0.5.8),
    exceptions (>= 0.6),
    stm (>= 2.3),
    mtl (>= 2),