diff options
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/Committer.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/Glacier.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/Merger.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 8 | ||||
-rw-r--r-- | Assistant/Threads/TransferWatcher.hs | 7 | ||||
-rw-r--r-- | Assistant/Threads/Transferrer.hs | 4 | ||||
-rw-r--r-- | Assistant/Threads/Watcher.hs | 4 |
7 files changed, 15 insertions, 14 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 585dfde9b..0062e2324 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -216,7 +216,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do stageSymlink file =<< hashSymlink link showEndOk - queueTransfers Next key (Just file) Upload + queueTransfers "newly added file" Next key (Just file) Upload return $ Just change {- Check that the keysource's keyFilename still exists, diff --git a/Assistant/Threads/Glacier.hs b/Assistant/Threads/Glacier.hs index 2f3b03b16..46f64cd56 100644 --- a/Assistant/Threads/Glacier.hs +++ b/Assistant/Threads/Glacier.hs @@ -39,5 +39,5 @@ glacierThread = namedThread "Glacier" $ runEvery (Seconds 3600) <~> go let l' = filter (\p -> S.member (getkey p) s) l forM_ l' $ \(t, info) -> do liftAnnex $ removeFailedTransfer t - queueTransferWhenSmall (associatedFile info) t r + queueTransferWhenSmall "object available from glacier" (associatedFile info) t r getkey = transferKey . fst diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index d8eea8c84..1488a2f0d 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -65,7 +65,7 @@ onAdd file | isAnnexBranch file = do branchChanged whenM (liftAnnex Annex.Branch.forceUpdate) $ - queueDeferredDownloads Later + queueDeferredDownloads "retrying deferred download" Later | "/synced/" `isInfixOf` file = do mergecurrent =<< liftAnnex (inRepo Git.Branch.current) | otherwise = noop diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 929fb53e7..198daca94 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -78,7 +78,7 @@ failedTransferScan r = do - that the remote doesn't already have the - key, so it's not redundantly checked here. -} requeue t info - requeue t info = queueTransferWhenSmall (associatedFile info) t r + requeue t info = queueTransferWhenSmall "retrying failed transfer" (associatedFile info) t r {- This is a expensive scan through the full git work tree, finding - files to transfer. The scan is blocked when the transfer queue gets @@ -108,9 +108,9 @@ expensiveScan rs = unless onlyweb $ do onlyweb = all (== webUUID) $ map Remote.uuid rs visiblers = let rs' = filter (not . Remote.readonly) rs in if null rs' then rs else rs' - enqueue f (r, t) = do - debug ["queuing", show t] - queueTransferWhenSmall (Just f) t r + enqueue f (r, t) = + queueTransferWhenSmall "expensive scan found missing object" + (Just f) t r findtransfers f (key, _) = do {- The syncable remotes may have changed since this - scan began. -} diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index d2ca0e535..fcf573374 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -61,7 +61,7 @@ onAdd file = case parseTransferFile file of where go _ Nothing = noop -- transfer already finished go t (Just info) = do - debug [ "transfer starting:", show t] + debug [ "transfer starting:", describeTransfer t info ] r <- headMaybe . filter (sameuuid t) <$> liftAnnex Remote.remoteList updateTransferInfo t info { transferRemote = r } @@ -116,8 +116,9 @@ finishedTransfer t (Just info) | transferDirection t == Download = whenM (liftAnnex $ inAnnex $ transferKey t) $ do handleDrops False (transferKey t) (associatedFile info) Nothing - queueTransfersMatching (/= transferUUID t) Later - (transferKey t) (associatedFile info) Upload + queueTransfersMatching (/= transferUUID t) + "newly received object" + Later (transferKey t) (associatedFile info) Upload | otherwise = handleDrops True (transferKey t) (associatedFile info) Nothing finishedTransfer _ _ = noop diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index 0acadec4b..fe3cb212c 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -40,11 +40,11 @@ startTransfer :: FilePath -> Transfer -> TransferInfo -> Assistant (Maybe (Trans startTransfer program t info = case (transferRemote info, associatedFile info) of (Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info) ( do - debug [ "Transferring:" , show t ] + debug [ "Transferring:" , describeTransfer t info ] notifyTransfer return $ Just (t, info, transferprocess remote file) , do - debug [ "Skipping unnecessary transfer:" , show t ] + debug [ "Skipping unnecessary transfer:" , describeTransfer t info ] void $ removeTransfer t return Nothing ) diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index be82a105f..c7616b678 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -252,8 +252,8 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file) | scanComplete daemonstatus = do present <- liftAnnex $ inAnnex key if present - then queueTransfers Next key (Just file) Upload - else queueTransfers Next key (Just file) Download + then queueTransfers "new file created" Next key (Just file) Upload + else queueTransfers "new or renamed file wanted" Next key (Just file) Download handleDrops present key (Just file) Nothing | otherwise = noop |