diff options
| -rw-r--r-- | Assistant/DaemonStatus.hs | 10 | ||||
| -rw-r--r-- | Assistant/Threads/Glacier.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/TransferScanner.hs | 33 | ||||
| -rw-r--r-- | Assistant/TransferQueue.hs | 13 | ||||
| -rw-r--r-- | Assistant/Types/DaemonStatus.hs | 6 |
5 files changed, 39 insertions, 25 deletions
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 58cb28c01..49823c3c0 100644 --- a/Assistant/DaemonStatus.hs +++ b/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 - , syncingToCloudRemote = any iscloud syncdata + , syncDataRemotes = dataremotes + , exportRemotes = exportremotes + , downloadRemotes = contentremotes + , syncingToCloudRemote = any iscloud contentremotes } where iscloud r = not (Remote.readonly r) && Remote.availability r == Remote.GloballyAvailable diff --git a/Assistant/Threads/Glacier.hs b/Assistant/Threads/Glacier.hs index b5eaa5ea9..2fd025df1 100644 --- a/Assistant/Threads/Glacier.hs +++ b/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 diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 4b6a90cd9..fd77b88d2 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/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,24 +157,29 @@ 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) - =<< use (genTransfer Upload False) - else ifM (wantGet True (Just key) af) - ( use (genTransfer Download True) , return [] ) - let unwanted' = S.difference unwanted slocs - return (unwanted', ts) + ts <- if present + then liftAnnex . filterM (wantSend True (Just key) af . Remote.uuid . fst) + =<< use syncDataRemotes (genTransfer Upload False) + else ifM (liftAnnex $ wantGet True (Just key) af) + ( 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 diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 8117d309c..278bcbaa1 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -66,9 +66,7 @@ queueTransfersMatching matching reason schedule k f direction | otherwise = go where go = do - - rs <- liftAnnex . selectremotes - =<< syncDataRemotes <$> getDaemonStatus + rs <- liftAnnex . selectremotes =<< 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 diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs index 08e98d98e..1166cd18a 100644 --- a/Assistant/Types/DaemonStatus.hs +++ b/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 |