diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/AddUrl.hs | 11 | ||||
| -rw-r--r-- | Command/Get.hs | 20 | ||||
| -rw-r--r-- | Command/List.hs | 4 | ||||
| -rw-r--r-- | Command/Move.hs | 14 | ||||
| -rw-r--r-- | Command/SendKey.hs | 2 | ||||
| -rw-r--r-- | Command/TransferKey.hs | 10 | ||||
| -rw-r--r-- | Command/TransferKeys.hs | 9 |
7 files changed, 36 insertions, 34 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index a0978a88d..1c73cd24f 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -26,7 +26,7 @@ import Types.KeySource import Config import Annex.Content.Direct import Logs.Location -import qualified Logs.Transfer as Transfer +import qualified Annex.Transfer as Transfer #ifdef WITH_QUVI import Annex.Quvi import qualified Utility.Quvi as Quvi @@ -116,9 +116,10 @@ addUrlFileQuvi relaxed quviurl videourl file = do prepGetViaTmpChecked sizedkey $ do tmp <- fromRepo $ gitAnnexTmpObjectLocation key showOutput - ok <- Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do - liftIO $ createDirectoryIfMissing True (parentDir tmp) - downloadUrl [videourl] tmp + ok <- Transfer.notifyTransfer Transfer.Download (Just file) $ + Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do + liftIO $ createDirectoryIfMissing True (parentDir tmp) + downloadUrl [videourl] tmp if ok then cleanup quviurl file key (Just tmp) else return False @@ -179,7 +180,7 @@ download url file = do , return False ) where - runtransfer dummykey tmp = + runtransfer dummykey tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloadUrl [url] tmp diff --git a/Command/Get.hs b/Command/Get.hs index f436b15b5..bef466724 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -11,7 +11,7 @@ import Common.Annex import Command import qualified Remote import Annex.Content -import Logs.Transfer +import Annex.Transfer import Config.NumCopies import Annex.Wanted import qualified Command.Move @@ -69,15 +69,15 @@ getKeyFile' key afile dest = dispatch showNote "not available" showlocs return False - dispatch remotes = trycopy remotes remotes - trycopy full [] = do + dispatch remotes = notifyTransfer Download afile $ trycopy remotes remotes + trycopy full [] _ = do Remote.showTriedRemotes full showlocs return False - trycopy full (r:rs) = + trycopy full (r:rs) witness = ifM (probablyPresent r) - ( docopy r (trycopy full rs) - , trycopy full rs + ( docopy r witness <||> trycopy full rs witness + , trycopy full rs witness ) showlocs = Remote.showLocations key [] "No other repository is known to contain the file." @@ -87,8 +87,6 @@ getKeyFile' key afile dest = dispatch | Remote.hasKeyCheap r = either (const False) id <$> Remote.hasKey r key | otherwise = return True - docopy r continue = do - ok <- download (Remote.uuid r) key afile noRetry $ \p -> do - showAction $ "from " ++ Remote.name r - Remote.retrieveKeyFile r key afile dest p - if ok then return ok else continue + docopy r = download (Remote.uuid r) key afile noRetry $ \p -> do + showAction $ "from " ++ Remote.name r + Remote.retrieveKeyFile r key afile dest p diff --git a/Command/List.hs b/Command/List.hs index ba6251333..1fa206405 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -38,7 +38,7 @@ seek ps = do getList :: Annex [(UUID, RemoteName, TrustLevel)] getList = ifM (Annex.getFlag $ optionName allrepos) - ( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAll) + ( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs) , getRemotes ) where @@ -48,7 +48,7 @@ getList = ifM (Annex.getFlag $ optionName allrepos) hereu <- getUUID heretrust <- lookupTrust hereu return $ (hereu, "here", heretrust) : zip3 (map uuid rs) (map name rs) ts - getAll = do + getAllUUIDs = do rs <- M.toList <$> uuidMap rs3 <- forM rs $ \(u, n) -> (,,) <$> pure u diff --git a/Command/Move.hs b/Command/Move.hs index 3a39e1de0..206a875b7 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -14,8 +14,8 @@ import qualified Annex import Annex.Content import qualified Remote import Annex.UUID +import Annex.Transfer import Logs.Presence -import Logs.Transfer def :: [Command] def = [withOptions moveOptions $ command "move" paramPaths seek @@ -98,8 +98,9 @@ toPerform dest move key afile fastcheck isthere = moveLock move key $ stop Right False -> do showAction $ "to " ++ Remote.name dest - ok <- upload (Remote.uuid dest) key afile noRetry $ - Remote.storeKey dest key afile + ok <- notifyTransfer Upload afile $ + upload (Remote.uuid dest) key afile noRetry $ + Remote.storeKey dest key afile if ok then do Remote.logStatus dest key InfoPresent @@ -155,9 +156,10 @@ fromPerform src move key afile = moveLock move key $ , handle move =<< go ) where - go = download (Remote.uuid src) key afile noRetry $ \p -> do - showAction $ "from " ++ Remote.name src - getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p + go = notifyTransfer Download afile $ + download (Remote.uuid src) key afile noRetry $ \p -> do + showAction $ "from " ++ Remote.name src + getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p handle _ False = stop -- failed handle False True = next $ return True -- copy complete handle True True = do -- finish moving diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 2215b16b2..a201d1b89 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -12,7 +12,7 @@ import Command import Annex.Content import Annex import Utility.Rsync -import Logs.Transfer +import Annex.Transfer import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index b6b237467..13bfd825e 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -11,7 +11,7 @@ import Common.Annex import Command import Annex.Content import Logs.Location -import Logs.Transfer +import Annex.Transfer import qualified Remote import Types.Remote @@ -41,7 +41,7 @@ start to from file key = _ -> error "specify either --from or --to" toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform -toPerform remote key file = go $ +toPerform remote key file = go Upload file $ upload (uuid remote) key file forwardRetry $ \p -> do ok <- Remote.storeKey remote key file p when ok $ @@ -49,9 +49,9 @@ toPerform remote key file = go $ return ok fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform -fromPerform remote key file = go $ +fromPerform remote key file = go Upload file $ download (uuid remote) key file forwardRetry $ \p -> getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p -go :: Annex Bool -> CommandPerform -go a = a >>= liftIO . exitBool +go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform +go direction file a = notifyTransfer direction file a >>= liftIO . exitBool diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index b42628609..8f4498eb1 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -13,7 +13,7 @@ import Common.Annex import Command import Annex.Content import Logs.Location -import Logs.Transfer +import Annex.Transfer import qualified Remote import Types.Key @@ -34,14 +34,15 @@ start = withHandles $ \(readh, writeh) -> do stop where runner (TransferRequest direction remote key file) - | direction == Upload = + | direction == Upload = notifyTransfer direction file $ upload (Remote.uuid remote) key file forwardRetry $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent return ok - | otherwise = download (Remote.uuid remote) key file forwardRetry $ \p -> - getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p + | otherwise = notifyTransfer direction file $ + download (Remote.uuid remote) key file forwardRetry $ \p -> + getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p {- stdin and stdout are connected with the caller, to be used for - communication with it. But doing a transfer might involve something |