fixes for transfer resume

Fix resuming of downloads, which do not have a transfer info file to read.

When checking upload progress, use the MVar, rather than re-reading
the info file.

Catch exceptions in the transfer action. Required a tryAnnex.

3 files changed, 34 insertions, 20 deletions

diff --git a/Annex/Exception.hs b/Annex/Exception.hs
index cb36d1bdb..4d21297b1 100644
--- a/Annex/Exception.hs
+++ b/Annex/Exception.hs
@@ -8,12 +8,13 @@
 module Annex.Exception (
 	bracketIO,
 	handle,
+	tryAnnex,
 	throw,
 ) where
 
-import Control.Exception.Lifted (handle)
+import Control.Exception.Lifted (handle, try)
 import Control.Monad.Trans.Control (liftBaseOp)
-import Control.Exception hiding (handle, throw)
+import Control.Exception hiding (handle, try, throw)
 
 import Common.Annex
 
@@ -22,6 +23,10 @@ bracketIO :: IO c -> (c -> IO b) -> Annex a -> Annex a
 bracketIO setup cleanup go =
 	liftBaseOp (Control.Exception.bracket setup cleanup) (const go)
 
+{- try in the Annex monad -}
+tryAnnex :: Annex a -> Annex (Either SomeException a)
+tryAnnex = try
+
 {- Throws an exception in the Annex monad. -}
 throw :: Control.Exception.Exception e => e -> Annex a
 throw = liftIO . throwIO
diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs
index f64ffa765..800b72169 100644
--- a/Command/TransferInfo.hs
+++ b/Command/TransferInfo.hs
@@ -47,7 +47,7 @@ start (k:[]) = do
 				, transferKey = key
 				}
 			info <- liftIO $ startTransferInfo file
-			(update, tfile) <- mkProgressUpdater t info
+			(update, tfile, _) <- mkProgressUpdater t info
 			liftIO $ mapM_ void
 				[ tryIO $ forever $ do
 					bytes <- readish <$> getLine
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 016571d23..3b68eeeb7 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -100,9 +100,10 @@ download u key file shouldretry a = runTransfer (Transfer Download u key) file s
 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
+	(meter, tfile, metervar) <- mkProgressUpdater t info
 	mode <- annexFileMode
-	ok <- retry tfile info $ bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
+	ok <- retry info metervar $
+		bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
 	unless ok $ failed info
 	return ok
 	where
@@ -123,26 +124,34 @@ runTransfer t file shouldretry 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
+		retry oldinfo metervar run = do
+			v <- tryAnnex run
+			case v of
+				Right b -> return b
+				Left _ -> do
+					b <- getbytescomplete metervar
+					let newinfo = oldinfo { bytesComplete = Just b }
+					if shouldretry oldinfo newinfo
+						then retry newinfo metervar run
+						else return False
+		getbytescomplete metervar
+			| transferDirection t == Upload =
+				liftIO $ readMVar metervar
+			| otherwise = do
+				f <- fromRepo $ gitAnnexTmpLocation (transferKey t)
+				liftIO $ catchDefaultIO 0 $
+					fromIntegral . fileSize
+						<$> getFileStatus f
 
 {- Generates a callback that can be called as transfer progresses to update
- - the transfer info file. Also returns the file it'll be updating. -}
-mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath)
+ - the transfer info file. Also returns the file it'll be updating, and a
+ - MVar that can be used to read the number of bytesComplete. -}
+mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, MVar Integer)
 mkProgressUpdater t info = do
 	tfile <- fromRepo $ transferFile t
 	createAnnexDirectory $ takeDirectory tfile
 	mvar <- liftIO $ newMVar 0
-	return (liftIO . updater tfile mvar, tfile)
+	return (liftIO . updater tfile mvar, tfile, mvar)
 	where
 		updater tfile mvar bytes = modifyMVar_ mvar $ \oldbytes -> do
 			if (bytes - oldbytes >= mindelta)
@@ -268,7 +277,7 @@ writeTransferInfo info = unlines
 	]
 
 readTransferInfoFile :: (Maybe ProcessID) -> FilePath -> IO (Maybe TransferInfo)
-readTransferInfoFile mpid tfile = do
+readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ do
 	h <- openFile tfile ReadMode
 	fileEncoding h
 	hClose h `after` (readTransferInfo mpid <$> hGetContentsStrict h)