finally using transferkeys

Seems to work! Even progress bars. Have not tested prompting or various
error message displays yet.

transferkeys had to be made to operate in different modes for the
Assistant and Annex monads. A bit ugly, but it did relegate that
really ugly Database.Keys.closeDb in transferkeys to only the assistant
code path.

This commit was sponsored by Noam Kremen.
This commit is contained in:
Joey Hess 2020-12-07 16:11:29 -04:00
parent 4c47568876
commit fcc9e01556
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 132 additions and 68 deletions

View file

@ -91,8 +91,7 @@ runTransferThread' mkcheck program batchmaker d run = go
go = catchPauseResume $ do
p <- runAssistant d $ liftAnnex $
Annex.getState Annex.transferrerpool
withTransferrer True mkcheck program batchmaker p
run
withTransferrer' True mkcheck program batchmaker p run
pause = catchPauseResume $
runEvery (Seconds 86400) noop
{- Note: This must use E.try, rather than E.catch.
@ -163,7 +162,7 @@ genTransfer t info = case transferRemote info of
- usual cleanup. However, first check if something else is
- running the transfer, to avoid removing active transfers.
-}
go remote transferrer = ifM (performTransfer transferrer t info liftAnnex)
go remote transferrer = ifM (performTransfer transferrer AssistantLevel t (transferRemote info) (associatedFile info) liftAnnex)
( do
case associatedFile info of
AssociatedFile Nothing -> noop