summaryrefslogtreecommitdiff
path: root/Assistant/Threads
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/Threads')
-rw-r--r--Assistant/Threads/Committer.hs2
-rw-r--r--Assistant/Threads/Glacier.hs2
-rw-r--r--Assistant/Threads/Merger.hs2
-rw-r--r--Assistant/Threads/TransferScanner.hs8
-rw-r--r--Assistant/Threads/TransferWatcher.hs7
-rw-r--r--Assistant/Threads/Transferrer.hs4
-rw-r--r--Assistant/Threads/Watcher.hs4
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