optimisation for borg

Skip needing to list importable contents when unchanged since last time.

Remote/Adb.hs

@@ -286,9 +286,9 @@ renameExportM serial adir _k old new = do
 		, File newloc
 		]
 
-listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (ImportableContents (ContentIdentifier, ByteSize))
+listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
 listImportableContentsM serial adir = adbfind >>= \case
-	Just ls -> return $ ImportableContents (mapMaybe mk ls) []
+	Just ls -> return $ Just $ ImportableContents (mapMaybe mk ls) []
 	Nothing -> giveup "adb find failed"
   where
 	adbfind = adbShell serial

Remote/Borg.hs

@@ -26,6 +26,7 @@ import Utility.Metered
 import qualified Remote.Helper.ThirdPartyPopulated as ThirdPartyPopulated
 import Logs.Export
 
+import Data.Either
 import Text.Read
 import Control.Exception (evaluate)
 import Control.DeepSeq
@@ -122,8 +123,6 @@ borgSetup _ mu _ c _gc = do
 	-- persistant state, so it can vary between hosts.
 	gitConfigSpecialRemote u c [("borgrepo", borgrepo)]
 
-	-- TODO: untrusted by default, but allow overriding that
-
 	return (c, u)
 
 borgLocal :: BorgRepo -> Bool
@@ -132,18 +131,20 @@ borgLocal = notElem ':'
 -- XXX the tree generated by using this does not seem to get grafted into
 -- the git-annex branch, so would be subject to being lost to GC.
 -- Is this a general problem affecting importtree too?
-listImportableContentsM :: UUID -> BorgRepo -> Annex (ImportableContents (ContentIdentifier, ByteSize))
+listImportableContentsM :: UUID -> BorgRepo -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
 listImportableContentsM u borgrepo = prompt $ do
 	imported <- getImported u
 	ls <- withborglist borgrepo "{barchive}{NUL}" $ \as ->
 		forM as $ \archivename ->
 			case M.lookup archivename imported of
-				Just getfast -> getfast
-				Nothing -> 
+				Just getfast -> return $ Left getfast
+				Nothing -> Right <$>
 					let archive = borgrepo ++ "::" ++ decodeBS' archivename
 					in withborglist archive "{size}{NUL}{path}{NUL}" $
 						liftIO . evaluate . force . parsefilelist archivename
-	return $ mkimportablecontents ls
+	if all isLeft ls
+		then return Nothing -- unchanged since last time, avoid work
+		else Just . mkimportablecontents <$> mapM (either id pure) ls
   where
 	withborglist what format a = do
 		let p = (proc "borg" ["list", what, "--format", format])

Remote/Directory.hs

@@ -337,11 +337,11 @@ removeExportLocation topdir loc =
 			mkExportLocation loc'
 		in go (upFrom loc') =<< tryIO (removeDirectory p)
 
-listImportableContentsM :: RawFilePath -> Annex (ImportableContents (ContentIdentifier, ByteSize))
+listImportableContentsM :: RawFilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
 listImportableContentsM dir = liftIO $ do
 	l <- dirContentsRecursive (fromRawFilePath dir)
 	l' <- mapM (go . toRawFilePath) l
-	return $ ImportableContents (catMaybes l') []
+	return $ Just $ ImportableContents (catMaybes l') []
   where
 	go f = do
 		st <- R.getFileStatus f

Remote/S3.hs

@@ -550,13 +550,14 @@ renameExportS3 hv r rs info k src dest = Just <$> go
 	srcobject = T.pack $ bucketExportLocation info src
 	dstobject = T.pack $ bucketExportLocation info dest
 
-listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> Annex (ImportableContents (ContentIdentifier, ByteSize))
+listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
 listImportableContentsS3 hv r info =
 	withS3Handle hv $ \case
 		Nothing -> giveup $ needS3Creds (uuid r)
-		Just h -> liftIO $ runResourceT $
-			extractFromResourceT =<< startlist h
+		Just h -> Just <$> go h
   where
+	go h = liftIO $ runResourceT $ extractFromResourceT =<< startlist h
+
 	startlist h
 		| versioning info = do
 			rsp <- sendS3Handle h $