diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/DeleteRemote.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/Committer.hs | 7 | ||||
| -rw-r--r-- | Assistant/Threads/Cronner.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 4 | ||||
| -rw-r--r-- | Assistant/Threads/TransferScanner.hs | 9 | ||||
| -rw-r--r-- | Assistant/TransferSlots.hs | 9 | ||||
| -rw-r--r-- | Assistant/Upgrade.hs | 2 |
7 files changed, 19 insertions, 16 deletions
diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs index c69011e79..6c88c61f5 100644 --- a/Assistant/DeleteRemote.hs +++ b/Assistant/DeleteRemote.hs @@ -64,7 +64,7 @@ removableRemote urlrenderer uuid = do where queueremaining r k = queueTransferWhenSmall "remaining object in unwanted remote" - Nothing (Transfer Download uuid k) r + (AssociatedFile Nothing) (Transfer Download uuid k) r {- Scanning for keys can take a long time; do not tie up - the Annex monad while doing it, so other threads continue to - run. -} diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index dbd030b33..d0acb8c60 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -503,9 +503,10 @@ checkChangeContent change@(Change { changeInfo = i }) = Just k -> whenM (scanComplete <$> getDaemonStatus) $ do present <- liftAnnex $ inAnnex k void $ if present - then queueTransfers "new file created" Next k (Just f) Upload - else queueTransfers "new or renamed file wanted" Next k (Just f) Download - handleDrops "file renamed" present k (Just f) [] + then queueTransfers "new file created" Next k af Upload + else queueTransfers "new or renamed file wanted" Next k af Download + handleDrops "file renamed" present k af [] where f = changeFile change + af = AssociatedFile (Just f) checkChangeContent _ = noop diff --git a/Assistant/Threads/Cronner.hs b/Assistant/Threads/Cronner.hs index 0b505b8f2..145a76e7b 100644 --- a/Assistant/Threads/Cronner.hs +++ b/Assistant/Threads/Cronner.hs @@ -190,7 +190,7 @@ runActivity' urlrenderer (ScheduledSelfFsck _ d) = do void $ repairWhenNecessary urlrenderer u Nothing fsckresults mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir) where - reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download + reget k = queueTransfers "fsck found bad file; redownloading" Next k (AssociatedFile Nothing) Download runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (remoteFromUUID u) where dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s] diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 0c79ef605..816969511 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -190,8 +190,8 @@ dailyCheck urlrenderer = do unused <- liftAnnex unusedKeys' void $ liftAnnex $ setUnusedKeys unused forM_ unused $ \k -> do - unlessM (queueTransfers "unused" Later k Nothing Upload) $ - handleDrops "unused" True k Nothing [] + unlessM (queueTransfers "unused" Later k (AssociatedFile Nothing) Upload) $ + handleDrops "unused" True k (AssociatedFile Nothing) [] return True where diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 5436c2ca1..4b6a90cd9 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -154,8 +154,9 @@ expensiveScan urlrenderer rs = batch <~> do enqueue f (r, t) = queueTransferWhenSmall "expensive scan found missing object" - (Just f) t r + (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 @@ -163,14 +164,14 @@ expensiveScan urlrenderer rs = batch <~> do present <- liftAnnex $ inAnnex key liftAnnex $ handleDropsFrom locs syncrs "expensive scan found too many copies of object" - present key (Just f) [] callCommandAction + 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) (Just f) . Remote.uuid . fst) + then filterM (wantSend True (Just key) af . Remote.uuid . fst) =<< use (genTransfer Upload False) - else ifM (wantGet True (Just key) (Just f)) + else ifM (wantGet True (Just key) af) ( use (genTransfer Download True) , return [] ) let unwanted' = S.difference unwanted slocs return (unwanted', ts) diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 25342f2b3..c80cf880a 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -153,10 +153,11 @@ genTransfer t info = case transferRemote info of -} go remote transferrer = ifM (liftIO $ performTransfer transferrer t info) ( do - maybe noop - (void . addAlert . makeAlertFiller True - . transferFileAlert direction True) - (associatedFile info) + case associatedFile info of + AssociatedFile Nothing -> noop + AssociatedFile (Just af) -> void $ + addAlert $ makeAlertFiller True $ + transferFileAlert direction True af unless isdownload $ handleDrops ("object uploaded to " ++ show remote) diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index a2f6f9e0a..67a4d9fc2 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -85,7 +85,7 @@ startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO ol hook <- asIO1 $ distributionDownloadComplete d dest cleanup modifyDaemonStatus_ $ \s -> s { transferHook = M.insert k hook (transferHook s) } - maybe noop (queueTransfer "upgrade" Next (Just f) t) + maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just f)) t) =<< liftAnnex (remoteFromUUID webUUID) startTransfer t k = distributionKey d |