diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/AddUrl.hs | 4 | ||||
| -rw-r--r-- | Command/Get.hs | 2 | ||||
| -rw-r--r-- | Command/Move.hs | 4 | ||||
| -rw-r--r-- | Command/SendKey.hs | 2 | ||||
| -rw-r--r-- | Command/TransferKey.hs | 4 | ||||
| -rw-r--r-- | Command/TransferKeys.hs | 7 |
6 files changed, 13 insertions, 10 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 6474f2614..96a966e8d 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -223,7 +223,7 @@ addUrlFileQuvi relaxed quviurl videourl file = do tmp <- fromRepo $ gitAnnexTmpObjectLocation key showOutput ok <- Transfer.notifyTransfer Transfer.Download (Just file) $ - Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do + Transfer.download webUUID key (Just file) Transfer.forwardRetry Transfer.noObserver $ const $ do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloadUrl [videourl] tmp if ok @@ -297,7 +297,7 @@ downloadWith downloader dummykey u url file = ) where runtransfer tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ - Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do + Transfer.download u dummykey (Just file) Transfer.forwardRetry Transfer.noObserver $ \p -> do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloader tmp p diff --git a/Command/Get.hs b/Command/Get.hs index 380a68097..dcd7e367a 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -90,6 +90,6 @@ getKeyFile' key afile dest = dispatch | Remote.hasKeyCheap r = either (const False) id <$> Remote.hasKey r key | otherwise = return True - docopy r = download (Remote.uuid r) key afile noRetry $ \p -> do + docopy r = download (Remote.uuid r) key afile noRetry noObserver $ \p -> do showAction $ "from " ++ Remote.name r Remote.retrieveKeyFile r key afile dest p diff --git a/Command/Move.hs b/Command/Move.hs index 91f7c8ea7..6867052de 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -95,7 +95,7 @@ toPerform dest move key afile fastcheck isthere = Right False -> do showAction $ "to " ++ Remote.name dest ok <- notifyTransfer Upload afile $ - upload (Remote.uuid dest) key afile noRetry $ + upload (Remote.uuid dest) key afile noRetry noObserver $ Remote.storeKey dest key afile if ok then do @@ -152,7 +152,7 @@ fromPerform src move key afile = ifM (inAnnex key) ) where go = notifyTransfer Download afile $ - download (Remote.uuid src) key afile noRetry $ \p -> do + download (Remote.uuid src) key afile noRetry noObserver $ \p -> do showAction $ "from " ++ Remote.name src getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p dispatch _ False = stop -- failed diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 62b4edcba..011785582 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -44,7 +44,7 @@ fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart fieldTransfer direction key a = do afile <- Fields.getField Fields.associatedFile ok <- maybe (a $ const noop) - (\u -> runner (Transfer direction (toUUID u) key) afile noRetry a) + (\u -> runner (Transfer direction (toUUID u) key) afile noRetry noObserver a) =<< Fields.getField Fields.remoteUUID liftIO $ exitBool ok where diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 55d6b95a1..14e788893 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -42,7 +42,7 @@ start to from file key = toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform toPerform remote key file = go Upload file $ - upload (uuid remote) key file forwardRetry $ \p -> do + upload (uuid remote) key file forwardRetry noObserver $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent @@ -50,7 +50,7 @@ toPerform remote key file = go Upload file $ fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform fromPerform remote key file = go Upload file $ - download (uuid remote) key file forwardRetry $ \p -> + download (uuid remote) key file forwardRetry noObserver $ \p -> getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index b787fe9be..d490d9be4 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -36,14 +36,17 @@ start = do where runner (TransferRequest direction remote key file) | direction == Upload = notifyTransfer direction file $ - upload (Remote.uuid remote) key file forwardRetry $ \p -> do + upload (Remote.uuid remote) key file forwardRetry observer $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent return ok | otherwise = notifyTransfer direction file $ - download (Remote.uuid remote) key file forwardRetry $ \p -> + download (Remote.uuid remote) key file forwardRetry observer $ \p -> getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p + + observer False t info = recordFailedTransfer t info + observer True _ _ = noop runRequests :: Handle |