split off versionedExport from appendonly

S3 uses versionedExport, while GitLFS uses appendonly.

This is groundwork for later changes.

Annex/Drop.hs

@@ -31,7 +31,8 @@ type Reason = String
  -
  - Skips trying to drop from remotes that are appendonly, since those drops
  - would presumably fail. Also skips dropping from exporttree/importtree remotes,
- - which don't allow dropping individual keys.
+ - which don't allow dropping individual keys, and from thirdPartyPopulated
+ - remotes.
  -
  - The UUIDs are ones where the content is believed to be present.
  - The Remote list can include other remotes that do not have the content;

Command/Export.hs

@@ -362,10 +362,10 @@ cleanupUnexport r db eks loc = do
 			removeExportedLocation db (asKey ek) loc
 		flushDbQueue db
 
-	-- An appendonly remote can support removeExportLocation to remove
+	-- An versionedExport remote supports removeExportLocation to remove
-	-- the file from the exported tree, but still retain the content
+	-- the file from the exported tree, but still retains the content
-	-- and allow retrieving it.
+	-- and allows retrieving it.
-	unless (appendonly r) $ do
+	unless (versionedExport (exportActions r)) $ do
 		remaininglocs <- liftIO $ 
 			concat <$> forM eks (\ek -> getExportedLocation db (asKey ek))
 		when (null remaininglocs) $

Logs/Trust.hs

@@ -1,6 +1,6 @@
 {- git-annex trust log
  -
- - Copyright 2010-2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -66,18 +66,19 @@ trustMapLoad :: Annex TrustMap
 trustMapLoad = do
 	overrides <- Annex.getState Annex.forcetrust
 	l <- remoteList
-	-- Export/import remotes are not trusted, since they are not
+	-- Export/import remotes are normally untrusted, because they are
-	-- key/value stores. (Unless they are appendonly remotes.)
+	-- not key/value stores and there are many ways that content stored
+	-- on them can be lost. An exception is ones with versionedExport set.
 	let isexportimport r = Types.Remote.isExportSupported r
 		<||> Types.Remote.isImportSupported r
-	let untrustworthy r = pure (not (Types.Remote.appendonly r)) 
+	let isuntrustworthy r = isexportimport r
-		<&&> isexportimport r
+		<&&> pure (not (Types.Remote.versionedExport (Types.Remote.exportActions r)))
-	exports <- filterM untrustworthy l
+	untrustworthy <- filterM isuntrustworthy l
-	let exportoverrides = M.fromList $
+	let trustoverrides = M.fromList $
-		map (\r -> (Types.Remote.uuid r, UnTrusted)) exports
+		map (\r -> (Types.Remote.uuid r, UnTrusted)) untrustworthy
 	logged <- trustMapRaw
 	let configured = M.fromList $ mapMaybe configuredtrust l
-	let m = M.unionWith min exportoverrides $
+	let m = M.unionWith min trustoverrides $
 		M.union overrides $
 		M.union configured logged
 	Annex.changeState $ \s -> s { Annex.trustmap = Just m }

Remote/Adb.hs

@@ -76,6 +76,7 @@ gen r u rc gc rs = do
 			{ storeExport = storeExportM serial adir
 			, retrieveExport = retrieveExportM serial adir
 			, removeExport = removeExportM serial adir
+			, versionedExport = False
 			, checkPresentExport = checkPresentExportM this serial adir
 			, removeExportDirectory = Just $ removeExportDirectoryM serial adir
 			, renameExport = renameExportM serial adir

Remote/Directory.hs

@@ -88,6 +88,7 @@ gen r u rc gc rs = do
 				{ storeExport = storeExportM dir
 				, retrieveExport = retrieveExportM dir
 				, removeExport = removeExportM dir
+				, versionedExport = False
 				, checkPresentExport = checkPresentExportM dir
 				-- Not needed because removeExportLocation
 				-- auto-removes empty directories.

Remote/External.hs

@@ -93,6 +93,7 @@ gen r u rc gc rs
 				{ storeExport = storeExportM external
 				, retrieveExport = retrieveExportM external
 				, removeExport = removeExportM external
+				, versionedExport = False
 				, checkPresentExport = checkPresentExportM external
 				, removeExportDirectory = Just $ removeExportDirectoryM external
 				, renameExport = renameExportM external

Remote/Helper/ExportImport.hs

@@ -39,6 +39,7 @@ instance HasExportUnsupported (ExportActions Annex) where
 		, retrieveExport = nope
 		, checkPresentExport = \_ _ -> return False
 		, removeExport = nope
+		, versionedExport = False
 		, removeExportDirectory = nope
 		, renameExport = \_ _ _ -> return Nothing
 		}
@@ -128,7 +129,8 @@ adjustExportImport' isexport isimport r rs = do
 	dbv <- prepdbv
 	ciddbv <- prepciddb
 	let normal = not isexport && not isimport
-	let iskeyvaluestore = normal || appendonly r
+	let versioned = versionedExport (exportActions r)
+	let iskeyvaluestore = normal || versioned
 	return $ r
 		{ exportActions = if isexport
 			then if isimport
@@ -170,16 +172,16 @@ adjustExportImport' isexport isimport r rs = do
 			else Nothing
 		, retrieveKeyFile = \k af dest p ->
 			if isimport
-				then supportappendonlyretrieve k af dest p $
+				then supportversionedretrieve k af dest p $
 					retrieveKeyFileFromImport dbv ciddbv k af dest p
 				else if isexport
-					then supportappendonlyretrieve k af dest p $
+					then supportversionedretrieve k af dest p $
 						retrieveKeyFileFromExport dbv k af dest p
 					else retrieveKeyFile r k af dest p
 		, retrieveKeyFileCheap = if iskeyvaluestore
 			then retrieveKeyFileCheap r
 			else Nothing
-		, checkPresent = \k -> if appendonly r
+		, checkPresent = \k -> if versioned
 			then checkPresent r k
 			else if isimport
 				then anyM (checkPresentImport ciddbv k)
@@ -356,11 +358,11 @@ adjustExportImport' isexport isimport r rs = do
 				then retrieveKeyFileFromExport dbv k af dest p
 				else giveup "no content identifier is recorded, unable to retrieve"
 	
-	-- appendonly remotes have a key/value store, so can use
+	-- versionedExport remotes have a key/value store, so can use
 	-- the usual retrieveKeyFile, rather than an import/export
 	-- variant. However, fall back to that if retrieveKeyFile fails.
-	supportappendonlyretrieve k af dest p a
+	supportversionedretrieve k af dest p a
-		| appendonly r =
+		| versionedExport (exportActions r) =
 			retrieveKeyFile r k af dest p
 				`catchNonAsync` const a
 		| otherwise = a

Remote/HttpAlso.hs

@@ -73,6 +73,7 @@ gen r u rc gc rs = do
 			{ storeExport = cannotModify
 			, retrieveExport = retriveExportHttpAlso url
 			, removeExport = cannotModify
+			, versionedExport = False
 			, checkPresentExport = checkPresentExportHttpAlso url
 			, removeExportDirectory = Nothing
 			, renameExport = cannotModify

Remote/Rsync.hs

@@ -101,6 +101,7 @@ gen r u rc gc rs = do
 				{ storeExport = storeExportM o
 				, retrieveExport = retrieveExportM o
 				, removeExport = removeExportM o
+				, versionedExport = False
 				, checkPresentExport = checkPresentExportM o
 				, removeExportDirectory = Just (removeExportDirectoryM o)
 				, renameExport = renameExportM o

Remote/S3.hs

@@ -210,6 +210,7 @@ gen r u rc gc rs = do
 				{ storeExport = storeExportS3 hdl this rs info magic
 				, retrieveExport = retrieveExportS3 hdl this info
 				, removeExport = removeExportS3 hdl this rs info
+				, versionedExport = versioning info
 				, checkPresentExport = checkPresentExportS3 hdl this info
 				-- S3 does not have directories.
 				, removeExportDirectory = Nothing
@@ -232,7 +233,7 @@ gen r u rc gc rs = do
 			, gitconfig = gc
 			, localpath = Nothing
 			, readonly = False
-			, appendonly = versioning info
+			, appendonly = False
 			, availability = GloballyAvailable
 			, remotetype = remote
 			, mkUnavailable = gen r u (M.insert hostField (Proposed "!dne!") rc) gc rs

Remote/WebDAV.hs

@@ -100,6 +100,7 @@ gen r u rc gc rs = do
 				, retrieveExport = retrieveExportDav hdl
 				, checkPresentExport = checkPresentExportDav hdl this
 				, removeExport = removeExportDav hdl
+				, versionedExport = False
 				, removeExportDirectory = Just $
 					removeExportDirectoryDav hdl
 				, renameExport = renameExportDav hdl

Types/Remote.hs

@@ -141,9 +141,7 @@ data RemoteA a = Remote
 	-- a Remote can be known to be readonly
 	, readonly :: Bool
 	-- a Remote can allow writes but not have a way to delete content
-	-- from it. Note that an export remote that supports removeExport
+	-- from it.
-	-- to remove a file from the exported tree, but still retains the
-	-- content in accessible form should set this to True.
 	, appendonly :: Bool
 	-- a Remote can be globally available. (Ie, "in the cloud".)
 	, availability :: Availability
@@ -251,6 +249,10 @@ data ExportActions a = ExportActions
 	-- Can throw exception if unable to access remote, or if remote
 	-- refuses to remove the content.
 	, removeExport :: Key -> ExportLocation -> a ()
+	-- Set when the content of a Key stored in the remote to an
+	-- ExportLocation and then removed with removeExport remains
+	-- accessible to retrieveKeyFile and checkPresent.
+	, versionedExport :: Bool
 	-- Removes an exported directory. Typically the directory will be
 	-- empty, but it could possibly contain files or other directories,
 	-- and it's ok to delete those (but not required to). 
@@ -263,7 +265,9 @@ data ExportActions a = ExportActions
 	-- the remote refuses to let the directory be removed.
 	, removeExportDirectory :: Maybe (ExportDirectory -> a ())
 	-- Checks if anything is exported to the remote at the specified
-	-- ExportLocation.
+	-- ExportLocation. It may check the size or other characteristics
+	-- of the Key, but does not need to guarantee that the content on
+	-- the remote is the same as the Key's content.
 	-- Throws an exception if the remote cannot be accessed.
 	, checkPresentExport :: Key -> ExportLocation -> a Bool
 	-- Renames an already exported file.