runTransfer' :: Observable v => Bool -> Transfer -> AssociatedFile -> Maybe StallDetection -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
runTransfer' ignorelock t afile stalldetection retrydecider transferaction =
- enteringStage TransferStage $
+ enteringStage (TransferStage (transferDirection t)) $
debugLocks $
preCheckSecureHashes (transferKey t) go
where
-> NotifyWitness
-> Annex Bool
runTransferrer sd r k afile retrydecider direction _witness =
- enteringStage TransferStage $ preCheckSecureHashes k $ do
+ enteringStage (TransferStage direction) $ preCheckSecureHashes k $ do
info <- liftIO $ startTransferInfo afile
go 0 info
where
Nothing -> giveup "Specify --from or --to"
seek' :: CopyOptions -> FromToHereOptions -> CommandSeek
-seek' o fto = startConcurrency commandStages $ do
+seek' o fto = startConcurrend stages $ do
case batchOption o of
NoBatch -> withKeyOptions
(keyOptions o) (autoMode o) seeker
}
keyaction = Command.Move.startKey fto Command.Move.RemoveNever
+ stages = case fto of
+ FromOrToRemote (FromRemote _) -> commandStages
+ FromOrToRemote (ToRemote _) -> commandStages
+ ToHere -> commandStages
+ FromRemoteToRemote _ _ -> transferStages
+
{- A copy is just a move that does not delete the source file.
- However, auto mode avoids unnecessary copies, and avoids getting or
- sending non-preferred content. -}
<*> parseBatchOption True
seek :: GetOptions -> CommandSeek
-seek o = startConcurrency downloadStages $ do
+seek o = startConcurrency transferStages $ do
from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
let seeker = AnnexedFileSeeker
{ startAction = start o from
=<< workTreeItems ww (mirrorFiles o)
where
stages = case fromToOptions o of
- FromRemote _ -> downloadStages
+ FromRemote _ -> transferStages
ToRemote _ -> commandStages
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
, usesLocationLog = True
}
stages = case fto of
- FromOrToRemote (FromRemote _) -> downloadStages
+ FromOrToRemote (FromRemote _) -> transferStages
FromOrToRemote (ToRemote _) -> commandStages
- ToHere -> downloadStages
- FromRemoteToRemote _ _ -> commandStages
+ ToHere -> transferStages
+ FromRemoteToRemote _ _ -> transferStages
keyaction = startKey fto (removeWhen o)
ww = WarnUnmatchLsFiles
seek :: SyncOptions -> CommandSeek
seek o = do
prepMerge
- startConcurrency downloadStages (seek' o)
+ startConcurrency transferStages (seek' o)
seek' :: SyncOptions -> CommandSeek
seek' o = do
--- /dev/null
+{- git-annex transfer direction types
+ -
+ - Copyright 2012 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Types.Direction where
+
+import qualified Data.ByteString as B
+
+data Direction = Upload | Download
+ deriving (Eq, Ord, Show, Read)
+
+formatDirection :: Direction -> B.ByteString
+formatDirection Upload = "upload"
+formatDirection Download = "download"
+
+parseDirection :: String -> Maybe Direction
+parseDirection "upload" = Just Upload
+parseDirection "download" = Just Download
+parseDirection _ = Nothing
+
- Licensed under the GNU AGPL version 3 or higher.
-}
-{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
-module Types.Transfer where
+module Types.Transfer (
+ module Types.Transfer,
+ module Types.Direction
+) where
import Types
import Types.Remote (Verification(..))
import Types.Key
+import Types.Direction
import Utility.PID
import Utility.QuickCheck
import Utility.Url
import Utility.FileSystemEncoding
-import qualified Data.ByteString as B
import Data.Time.Clock.POSIX
import Control.Concurrent
import Control.Applicative
stubTransferInfo :: TransferInfo
stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing (AssociatedFile Nothing) False
-data Direction = Upload | Download
- deriving (Eq, Ord, Show, Read)
-
-formatDirection :: Direction -> B.ByteString
-formatDirection Upload = "upload"
-formatDirection Download = "download"
-
-parseDirection :: String -> Maybe Direction
-parseDirection "upload" = Just Upload
-parseDirection "download" = Just Download
-parseDirection _ = Nothing
-
instance Arbitrary TransferInfo where
arbitrary = TransferInfo
<$> arbitrary
{- Worker thread pool.
-
- - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Types.WorkerPool where
+import Types.Direction
+
import Control.Concurrent
import Control.Concurrent.Async
import qualified Data.Set as S
-- ^ Running a CommandPerform action.
| CleanupStage
-- ^ Running a CommandCleanup action.
- | TransferStage
+ | TransferStage Direction
-- ^ Transferring content to or from a remote.
| VerifyStage
-- ^ Verifying content, eg by calculating a checksum.
, stageSet = S.fromList [PerformStage, CleanupStage]
}
--- | When a command is downloading content, it can use this instead.
--- Downloads are often bottlenecked on the network or another disk
--- than the one containing the repository, while verification bottlenecks
--- on the disk containing the repository or on the CPU. So, run the
--- transfer and verify stage separately.
-downloadStages :: UsedStages
-downloadStages = UsedStages
- { initialStage = TransferStage
- , stageSet = S.fromList [TransferStage, VerifyStage]
+-- | This is mostly useful for downloads, not for uploads. A download
+-- is often bottlenecked on the network or another disk than the one
+-- containing the repository. When verification is not done incrementally,
+-- it bottlenecks on the disk containing the repository or on the CPU.
+-- So it makes sense to run the download and verify stages separately.
+--
+-- For uploads, there is no separate verify step to this is less likely
+-- to be useful than commandStages. However, a separate stage is provided
+-- for Uploads. That can be useful when a command downloads from one remote
+-- (eg using the network) and uploads to another remote (eg using a disk).
+transferStages :: UsedStages
+transferStages = UsedStages
+ { initialStage = TransferStage Download
+ , stageSet = S.fromList
+ [ TransferStage Download
+ , TransferStage Upload
+ , VerifyStage
+ ]
}
workerStage :: Worker t -> WorkerStage
Setting this to "cpus" will run one job per CPU core.
+ Note that when using --from with --to, twice this many jobs will
+ run at once, evenly split between the two remotes.
+
* `--auto`
Rather than copying all specified files, only copy those that don't yet have
Setting this to "cpus" will run one job per CPU core.
+ Note that when using --from with --to, twice this many jobs will
+ run at once, evenly split between the two remotes.
+
* `--all` `-A`
Rather than specifying a filename or path to move, this option can be
Types.DeferredParse
Types.DesktopNotify
Types.Difference
+ Types.Direction
Types.Distribution
Types.Export
Types.FileMatcher
projects / git-annex.git / commitdiff