diff options
author | Joey Hess <joey@kitenet.net> | 2012-09-23 13:27:13 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-09-23 13:27:13 -0400 |
commit | df07ccf404bf6a950fe0a0a31f315486c510a2f0 (patch) | |
tree | a7188982ebb24b9ca0122c7516143c5089aef197 /Logs | |
parent | d4055b3dd2999a75381c4cae2ed30a7dcd32d3f2 (diff) |
make the assistant retry failed transfers
When a transfer fails, the progress info can be used to intelligently
retry it. If the transfer managed to make some progress, but did not
fully complete, then there's a good chance that a retry will finish it
(or at least make more progress).
Diffstat (limited to 'Logs')
-rw-r--r-- | Logs/Transfer.hs | 36 |
1 files changed, 28 insertions, 8 deletions
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 7188143d6..016571d23 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -74,11 +74,21 @@ percentComplete :: Transfer -> TransferInfo -> Maybe Percentage percentComplete (Transfer { transferKey = key }) info = percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info) -upload :: UUID -> Key -> AssociatedFile -> (MeterUpdate -> Annex Bool) -> Annex Bool -upload u key file a = runTransfer (Transfer Upload u key) file a +type RetryDecider = TransferInfo -> TransferInfo -> Bool -download :: UUID -> Key -> AssociatedFile -> Annex Bool -> Annex Bool -download u key file a = runTransfer (Transfer Download u key) file (const a) +noRetry :: RetryDecider +noRetry _ _ = False + +{- Retries a transfer when it fails, as long as the failed transfer managed + - to send some data. -} +forwardRetry :: RetryDecider +forwardRetry old new = bytesComplete old < bytesComplete new + +upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool +upload u key = runTransfer (Transfer Upload u key) + +download :: UUID -> Key -> AssociatedFile -> RetryDecider -> Annex Bool -> Annex Bool +download u key file shouldretry a = runTransfer (Transfer Download u key) file shouldretry (const a) {- Runs a transfer action. Creates and locks the lock file while the - action is running, and stores info in the transfer information @@ -87,12 +97,12 @@ download u key file a = runTransfer (Transfer Download u key) file (const a) - If the transfer action returns False, the transfer info is - left in the failedTransferDir. -} -runTransfer :: Transfer -> Maybe FilePath -> (MeterUpdate -> Annex Bool) -> Annex Bool -runTransfer t file a = do +runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool +runTransfer t file shouldretry a = do info <- liftIO $ startTransferInfo file (meter, tfile) <- mkProgressUpdater t info mode <- annexFileMode - ok <- bracketIO (prep tfile mode info) (cleanup tfile) (a meter) + ok <- retry tfile info $ bracketIO (prep tfile mode info) (cleanup tfile) (a meter) unless ok $ failed info return ok where @@ -113,7 +123,17 @@ runTransfer t file a = do failedtfile <- fromRepo $ failedTransferFile t createAnnexDirectory $ takeDirectory failedtfile liftIO $ writeTransferInfoFile info failedtfile - + retry tfile oldinfo run = do + ok <- run + if ok + then return ok + else do + v <- liftIO $ readTransferInfoFile Nothing tfile + case v of + Nothing -> return ok + Just newinfo -> if shouldretry oldinfo newinfo + then retry tfile newinfo run + else return ok {- Generates a callback that can be called as transfer progresses to update - the transfer info file. Also returns the file it'll be updating. -} |