first pass at assistant knowing about export remotes

Split exportRemotes out from syncDataRemotes; the parts of the assistant
that upload keys and drop keys from remotes don't apply to exports,
because those operations are not supported.

Some parts of the assistant and webapp do operate on both
syncDataRemotes and exportRemotes. Particularly when downloading from
either of them. Added a downloadRemotes that combines both.

With this, the assistant should download from exports, but it won't yet
upload changes to them.

This commit was sponsored by Fernando Jimenez on Patreon.

Assistant/DaemonStatus.hs

@@ -20,6 +20,7 @@ import Logs.TimeStamp
 import qualified Remote
 import qualified Types.Remote as Remote
 import Config.DynamicConfig
+import Annex.Export
 
 import Control.Concurrent.STM
 import System.Posix.Types
@@ -53,15 +54,18 @@ calcSyncRemotes = do
 	alive <- trustExclude DeadTrusted (map Remote.uuid rs)
 	let good r = Remote.uuid r `elem` alive
 	let syncable = filter good rs
-	syncdata <- filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) $
+	contentremotes <- filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) $
 		filter (\r -> Remote.uuid r /= NoUUID) $
 		filter (not . Remote.isXMPPRemote) syncable
+	let (exportremotes, dataremotes) = partition (exportTree . Remote.config) contentremotes
 
 	return $ \dstatus -> dstatus
 		{ syncRemotes = syncable
 		, syncGitRemotes = filter Remote.gitSyncableRemote syncable
-		, syncDataRemotes = syncdata
+		, syncDataRemotes = dataremotes
-		, syncingToCloudRemote = any iscloud syncdata
+		, exportRemotes = exportremotes
+		, downloadRemotes = contentremotes
+		, syncingToCloudRemote = any iscloud contentremotes
 		}
   where
 	iscloud r = not (Remote.readonly r) && Remote.availability r == Remote.GloballyAvailable

Assistant/Threads/Glacier.hs

@@ -29,7 +29,7 @@ glacierThread = namedThread "Glacier" $ runEvery (Seconds 3600) <~> go
   where
 	isglacier r = Remote.remotetype r == Glacier.remote
 	go = do
-		rs <- filter isglacier . syncDataRemotes <$> getDaemonStatus
+		rs <- filter isglacier . downloadRemotes <$> getDaemonStatus
 		forM_ rs $ \r -> 
 			check r =<< liftAnnex (getFailedTransfers $ Remote.uuid r)
 	check _ [] = noop

Assistant/Threads/TransferScanner.hs

@@ -78,7 +78,7 @@ transferScannerThread urlrenderer = namedThread "TransferScanner" $ do
 	 -}
 	startupScan = do
 		reconnectRemotes =<< syncGitRemotes <$> getDaemonStatus
-		addScanRemotes True =<< syncDataRemotes <$> getDaemonStatus
+		addScanRemotes True =<< scannableRemotes
 
 {- This is a cheap scan for failed transfers involving a remote. -}
 failedTransferScan :: Remote -> Assistant ()
@@ -157,25 +157,30 @@ expensiveScan urlrenderer rs = batch <~> do
 			(AssociatedFile (Just f)) t r
 	findtransfers f unwanted key = do
 		let af = AssociatedFile (Just f)
-		{- The syncable remotes may have changed since this
-		 - scan began. -}
-		syncrs <- syncDataRemotes <$> getDaemonStatus
 		locs <- liftAnnex $ loggedLocations key
 		present <- liftAnnex $ inAnnex key
+		let slocs = S.fromList locs
+		
+		{- The remotes may have changed since this scan began. -}
+		syncrs <- syncDataRemotes <$> getDaemonStatus
+		let use l a = mapMaybe (a key slocs) . l <$> getDaemonStatus
+
 		liftAnnex $ handleDropsFrom locs syncrs
 			"expensive scan found too many copies of object"
 			present key af [] callCommandAction
-		liftAnnex $ do
-			let slocs = S.fromList locs
-			let use a = return $ mapMaybe (a key slocs) syncrs
 		ts <- if present
-				then filterM (wantSend True (Just key) af . Remote.uuid . fst)
+			then liftAnnex . filterM (wantSend True (Just key) af . Remote.uuid . fst)
-					=<< use (genTransfer Upload False)
+				=<< use syncDataRemotes (genTransfer Upload False)
-				else ifM (wantGet True (Just key) af)
+			else ifM (liftAnnex $ wantGet True (Just key) af)
-					( use (genTransfer Download True) , return [] )
+				( use downloadRemotes (genTransfer Download True) , return [] )
 		let unwanted' = S.difference unwanted slocs
 		return (unwanted', ts)
 
+-- Both syncDataRemotes and exportRemotes can be scanned.
+-- The downloadRemotes list contains both.
+scannableRemotes :: Assistant [Remote]
+scannableRemotes = downloadRemotes <$> getDaemonStatus
+
 genTransfer :: Direction -> Bool -> Key -> S.Set UUID -> Remote -> Maybe (Remote, Transfer)
 genTransfer direction want key slocs r
 	| direction == Upload && Remote.readonly r = Nothing

Assistant/TransferQueue.hs

@@ -66,9 +66,7 @@ queueTransfersMatching matching reason schedule k f direction
 	| otherwise = go
   where
 	go = do
-		
+		rs <- liftAnnex . selectremotes =<< getDaemonStatus
-		rs <- liftAnnex . selectremotes
-			=<< syncDataRemotes <$> getDaemonStatus
 		let matchingrs = filter (matching . Remote.uuid) rs
 		if null matchingrs
 			then do
@@ -78,20 +76,21 @@ queueTransfersMatching matching reason schedule k f direction
 				forM_ matchingrs $ \r ->
 					enqueue reason schedule (gentransfer r) (stubInfo f r)
 				return True
-	selectremotes rs
+	selectremotes st
 		{- Queue downloads from all remotes that
 		 - have the key. The list of remotes is ordered with
 		 - cheapest first. More expensive ones will only be tried
 		 - if downloading from a cheap one fails. -}
 		| direction == Download = do
 			s <- locs
-			return $ filter (inset s) rs
+			return $ filter (inset s) (downloadRemotes st)
 		{- Upload to all remotes that want the content and don't
 		 - already have it. -}
 		| otherwise = do
 			s <- locs
 			filterM (wantSend True (Just k) f . Remote.uuid) $
-				filter (\r -> not (inset s r || Remote.readonly r)) rs
+				filter (\r -> not (inset s r || Remote.readonly r))
+					(syncDataRemotes st)
 	  where
 		locs = S.fromList <$> Remote.keyLocations k
 		inset s r = S.member (Remote.uuid r) s
@@ -114,7 +113,7 @@ queueDeferredDownloads :: Reason -> Schedule -> Assistant ()
 queueDeferredDownloads reason schedule = do
 	q <- getAssistant transferQueue
 	l <- liftIO $ atomically $ readTList (deferreddownloads q)
-	rs <- syncDataRemotes <$> getDaemonStatus
+	rs <- downloadRemotes <$> getDaemonStatus
 	left <- filterM (queue rs) l
 	unless (null left) $
 		liftIO $ atomically $ appendTList (deferreddownloads q) left

Assistant/Types/DaemonStatus.hs

@@ -49,6 +49,10 @@ data DaemonStatus = DaemonStatus
 	, syncGitRemotes :: [Remote]
 	-- Ordered list of remotes to sync data with
 	, syncDataRemotes :: [Remote]
+	-- Ordered list of remotes to export to
+	, exportRemotes :: [Remote]
+	-- Ordered list of remotes that data can be downloaded from
+	, downloadRemotes :: [Remote]
 	-- Are we syncing to any cloud remotes?
 	, syncingToCloudRemote :: Bool
 	-- Set of uuids of remotes that are currently connected.
@@ -97,6 +101,8 @@ newDaemonStatus = DaemonStatus
 	<*> pure []
 	<*> pure []
 	<*> pure []
+	<*> pure []
+	<*> pure []
 	<*> pure False
 	<*> pure S.empty
 	<*> pure Nothing

Assistant/WebApp/Configurators/Delete.hs

@@ -72,7 +72,7 @@ deleteCurrentRepository :: Handler Html
 deleteCurrentRepository = dangerPage $ do
 	reldir <- fromJust . relDir <$> liftH getYesod
 	havegitremotes <- haveremotes syncGitRemotes
-	havedataremotes <- haveremotes syncDataRemotes
+	havedataremotes <- haveremotes downloadRemotes
 	((result, form), enctype) <- liftH $
 		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
 			sanityVerifierAForm $ SanityVerifier magicphrase