mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

finally using transferkeys

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

26
Annex/Transfer.hs
View file

@ -38,6 +38,7 @@ import Types.Concurrency
import Annex.Concurrent.Utility
import Types.WorkerPool
import Annex.WorkerPool
import Annex.TransferrerPool
import Backend (isCryptographicallySecure)
import qualified Utility.RawFilePath as R
@ -47,8 +48,17 @@ import qualified System.FilePath.ByteString as P
import Data.Ord
upload :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
upload r key f d = upload' (Remote.uuid r) key f d $
action . Remote.storeKey r key f
upload r key f d _witness =
-- TODO: use this when not handling timeouts
--upload' (Remote.uuid r) key f d $
-- action . Remote.storeKey r key f
-- TODO: RetryDecider
-- TODO: Handle timeouts
withTransferrer $ \transferrer ->
performTransfer transferrer AnnexLevel
(Transfer Upload (Remote.uuid r) (fromKey id key))
(Just r) f id
upload' :: Observable v => UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> NotifyWitness -> Annex v
upload' u key f d a _witness = guardHaveUUID u $
@ -60,8 +70,16 @@ alwaysUpload u key f d a _witness = guardHaveUUID u $
download :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
download r key f d witness =
getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key f $ \dest ->
download' (Remote.uuid r) key f d (go dest) witness
-- TODO: use this when not handling timeouts
--getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key f $ \dest ->
-- download' (Remote.uuid r) key f d (go dest) witness
-- TODO: RetryDecider
-- TODO: Handle timeouts
withTransferrer $ \transferrer ->
performTransfer transferrer AnnexLevel
(Transfer Download (Remote.uuid r) (fromKey id key))
(Just r) f id
where
go dest p = verifiedAction $
Remote.retrieveKeyFile r key f (fromRawFilePath dest) p