testremote: Test retrieveKeyFile resume

And fixed a bug found by these tests; retrieveKeyFile would fail
when the dest file was already complete.

This commit was sponsored by Bradley Unterrheiner.

Command/TestRemote.hs

@@ -22,15 +22,19 @@ import qualified Backend.Hash
 import Utility.Tmp
 import Utility.Metered
 import Utility.DataUnits
+import Utility.CopyFile
 import Messages
 import Types.Messages
 import Remote.Helper.Chunked
+import Locations
 
 import Test.Tasty
 import Test.Tasty.Runners
 import Test.Tasty.HUnit
+import Control.Exception
 import "crypto-api" Crypto.Random
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 
 def :: [Command]
@@ -87,27 +91,40 @@ adjustChunkSize r chunksize = Remote.generate (Remote.remotetype r)
 
 test :: Annex.AnnexState -> Remote -> Key -> [TestTree]
 test st r k =
-	[ check "removeKey when not present" $
+	[ check "removeKey when not present" remove
-		Remote.removeKey r k
 	, present False
-	, check "storeKey" $
+	, check "storeKey" store
-		Remote.storeKey r k Nothing nullMeterUpdate
 	, present True
-	, check "storeKey when already present" $
+	, check "storeKey when already present" store
-		Remote.storeKey r k Nothing nullMeterUpdate
 	, present True
 	, check "retrieveKeyFile" $ do
 		removeAnnex k
-		getViaTmp k $ \dest ->
+		get
-			Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate
+	, check "fsck downloaded object" fsck
-	, check "fsck downloaded object" $ do
+	, check "retrieveKeyFile resume from 33%" $ do
-		case maybeLookupBackendName (keyBackendName k) of
+		loc <- Annex.calcRepo (gitAnnexLocation k)
-			Nothing -> return True
+		tmp <- prepTmp k
-			Just b -> case fsckKey b of
+		partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do
-				Nothing -> return True
+			sz <- hFileSize h
-				Just fscker -> fscker k (key2file k)
+			L.hGet h $ fromInteger $ sz `div` 3
-	, check "removeKey when present" $
+		liftIO $ L.writeFile tmp partial
-		Remote.removeKey r k
+		removeAnnex k
+		get
+	, check "fsck downloaded object" fsck
+	, check "retrieveKeyFile resume from 0" $ do
+		tmp <- prepTmp k
+		liftIO $ writeFile tmp ""
+		removeAnnex k
+		get
+	, check "fsck downloaded object" fsck
+	, check "retrieveKeyFile resume from end" $ do
+		loc <- Annex.calcRepo (gitAnnexLocation k)
+		tmp <- prepTmp k
+		void $ liftIO $ copyFileExternal loc tmp
+		removeAnnex k
+		get
+	, check "fsck downloaded object" fsck
+	, check "removeKey when present" remove
 	, present False
 	]
   where
@@ -115,6 +132,15 @@ test st r k =
 		Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"
 	present b = check ("present " ++ show b) $
 		(== Right b) <$> Remote.hasKey r k
+	fsck = case maybeLookupBackendName (keyBackendName k) of
+		Nothing -> return True
+		Just b -> case fsckKey b of
+			Nothing -> return True
+			Just fscker -> fscker k (key2file k)
+	get = getViaTmp k $ \dest ->
+		Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate
+	store = Remote.storeKey r k Nothing nullMeterUpdate
+	remove = Remote.removeKey r k
 
 cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup
 cleanup rs ks ok = do

Remote/Helper/Chunked.hs

@@ -241,7 +241,9 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 		currsize <- liftIO $ catchMaybeIO $
 			toInteger . fileSize <$> getFileStatus dest
 		let ls' = maybe ls (setupResume ls) currsize
-		firstavail currsize ls' `catchNonAsyncAnnex` giveup
+		if any (== 0) (map length ls')
+			then return True -- dest is already complete
+			else firstavail currsize ls' `catchNonAsyncAnnex` giveup
 
 	giveup e = do
 		warning (show e)