distinguish between incremental verification failing and not being done

Sponsored-by: Dartmouth College's DANDI project

Annex/Content.hs

@@ -633,8 +633,8 @@ saveState nocommit = doSideAction $ do
 
 {- Downloads content from any of a list of urls, displaying a progress
  - meter. -}
-downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool
-downloadUrl k p urls file uo = 
+downloadUrl :: Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool
+downloadUrl k p iv urls file uo = 
 	-- Poll the file to handle configurations where an external
 	-- download command is used.
 	meteredFile file (Just p) k (go urls Nothing)
@@ -643,7 +643,7 @@ downloadUrl k p urls file uo =
 	-- download.
 	go [] (Just err) = warning err >> return False
 	go [] Nothing = return False
-	go (u:us) _ = Url.download' p u file uo >>= \case
+	go (u:us) _ = Url.download' p iv u file uo >>= \case
 		Right () -> return True
 		Left err -> go us (Just err)
 

Annex/CopyFile.hs

@@ -72,9 +72,7 @@ fileCopier _ src dest meterupdate iv = docopy
 fileCopier copycowtried src dest meterupdate iv =
 	ifM (liftIO $ tryCopyCoW copycowtried src dest meterupdate)
 		( do
-			-- Make sure the incremental verifier fails,
-			-- since we did not feed it.
-			liftIO $ maybe noop failIncremental iv
+			liftIO $ maybe noop unableIncremental iv
 			return CopiedCoW
 		, docopy
 		)

Annex/Verify.hs

@@ -110,17 +110,19 @@ resumeVerifyKeyContent k f iv = liftIO (positionIncremental iv) >>= \case
 			then fallback
 			else case fromKey keySize k of
 				Just size | fsz /= size -> return False
-				_ -> go fsz endpos
+				_ -> go fsz endpos >>= \case
+					Just v -> return v
+					Nothing -> fallback
   where
 	fallback = verifyKeyContent k f
 
 	go fsz endpos
 		| fsz == endpos =
-			liftIO $ catchDefaultIO False $
+			liftIO $ catchDefaultIO (Just False) $
 				finalizeIncremental iv
 		| otherwise = do
 			showAction (descVerify iv)
-			liftIO $ catchDefaultIO False $
+			liftIO $ catchDefaultIO (Just False) $
 				withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do
 					hSeek h AbsoluteSeek endpos
 					feedincremental h
@@ -172,12 +174,13 @@ finishVerifyKeyContentIncrementally :: Maybe IncrementalVerifier -> Annex (Bool,
 finishVerifyKeyContentIncrementally Nothing = 
 	return (True, UnVerified)
 finishVerifyKeyContentIncrementally (Just iv) =
-	ifM (liftIO $ finalizeIncremental iv)
-		( return (True, Verified)
-		, do
+	liftIO (finalizeIncremental iv) >>= \case
+		Just True -> return (True, Verified)
+		Just False -> do
 			warning "verification of content failed"
 			return (False, UnVerified)
-		)
+		-- Incremental verification was not able to be done.
+		Nothing -> return (True, UnVerified)
 
 -- | Reads the file as it grows, and feeds it to the incremental verifier.
 -- 
@@ -190,11 +193,11 @@ finishVerifyKeyContentIncrementally (Just iv) =
 -- for the file to appear before opening it and starting verification.
 --
 -- This is not supported for all OSs, and on OS's where it is not
--- supported, verification will fail.
+-- supported, verification will not happen.
 --
 -- The writer probably needs to be another process. If the file is being
 -- written directly by git-annex, the haskell RTS will prevent opening it
--- for read at the same time, and verification will fail.
+-- for read at the same time, and verification will not happen.
 --
 -- Note that there are situations where the file may fail to verify despite
 -- having the correct content. For example, when the file is written out
@@ -221,7 +224,7 @@ tailVerify :: IncrementalVerifier -> RawFilePath -> TMVar () -> IO ()
 tailVerify iv f finished = 
 	tryNonAsync go >>= \case
 		Right r -> return r
-		Left _ -> failIncremental iv
+		Left _ -> unableIncremental iv
   where
 	-- Watch the directory containing the file, and wait for
 	-- the file to be modified. It's possible that the file already
@@ -246,7 +249,7 @@ tailVerify iv f finished =
 		let cleanup = void . tryNonAsync . INotify.removeWatch
 		let stop w = do
 			cleanup w
-			failIncremental iv
+			unableIncremental iv
 		waitopen modified >>= \case
 			Nothing -> stop wd
 			Just h -> do
@@ -305,5 +308,5 @@ tailVerify iv f finished =
 
 	chunk = 65536
 #else
-tailVerify iv _ _ = failIncremental iv
+tailVerify iv _ _ = unableIncremental iv
 #endif

P2P/Annex.hs

@@ -202,10 +202,12 @@ runLocal runst runner a = case a of
 					
 				runner validitycheck >>= \case
 					Right (Just Valid) -> case incrementalverifier of
-						Just iv -> ifM (liftIO (finalizeIncremental iv) <&&> pure rightsize)
-							( return (True, Verified)
-							, return (False, UnVerified)
-							)
+						Just iv
+							| rightsize -> liftIO (finalizeIncremental iv) >>= \case
+								Nothing -> return (True, UnVerified)
+								Just True -> return (True, Verified)
+								Just False -> return (False, UnVerified)
+							| otherwise -> return (False, UnVerified)
 						Nothing -> return (rightsize, UnVerified)
 					Right (Just Invalid) | l == 0 ->
 						-- Special case, for when

Remote/Helper/Chunked.hs

@@ -366,11 +366,10 @@ retrieveChunks retriever u vc chunkconfig encryptor basek dest basep enc encc
 			| otherwise = Nothing
 	
 	finalize (Right Nothing) = return UnVerified
-	finalize (Right (Just iv)) = 
-		ifM (liftIO $ finalizeIncremental iv)
-			( return Verified
-			, return UnVerified
-			)
+	finalize (Right (Just iv)) =
+		liftIO (finalizeIncremental iv) >>= \case
+			Just True -> return Verified
+			_ -> return UnVerified
 	finalize (Left v) = return v
 
 {- Writes retrieved file content to the provided Handle, decrypting it

Remote/WebDAV.hs

@@ -173,7 +173,7 @@ retrieve hv cc = fileRetriever' $ \d k p iv ->
 	withDavHandle hv $ \dav -> case cc of
 		LegacyChunks _ -> do
 			-- Not doing incremental verification for chunks.
-			liftIO $ maybe noop failIncremental iv
+			liftIO $ maybe noop unableIncremental iv
 			retrieveLegacyChunked (fromRawFilePath d) k p dav
 		_ -> liftIO $ goDAV dav $
 			retrieveHelper (keyLocation k) (fromRawFilePath d) p iv

Utility/Hash.hs

@@ -283,14 +283,15 @@ props_macs_stable = map (\(desc, mac, result) -> (desc ++ " stable", calcMac mac
 data IncrementalVerifier = IncrementalVerifier
 	{ updateIncremental :: S.ByteString -> IO ()
 	-- ^ Called repeatedly on each peice of the content.
-	, finalizeIncremental :: IO Bool
-	-- ^ Called once the full content has been sent, returns true
-	-- if the hash verified.
-	, failIncremental :: IO ()
-	-- ^ Call if the incremental verification needs to fail.
+	, finalizeIncremental :: IO (Maybe Bool)
+	-- ^ Called once the full content has been sent, returns True
+	-- if the hash verified, False if it did not, and Nothing if
+	-- incremental verification was unable to be done.
+	, unableIncremental :: IO ()
+	-- ^ Call if the incremental verification is unable to be done.
 	, positionIncremental :: IO (Maybe Integer)
 	-- ^ Returns the number of bytes that have been fed to this
-	-- incremental verifier so far. (Nothing if failIncremental was
+	-- incremental verifier so far. (Nothing if unableIncremental was
 	-- called.)
 	, descVerify :: String
 	-- ^ A description of what is done to verify the content.
@@ -311,9 +312,10 @@ mkIncrementalVerifier ctx descverify samechecksum = do
 			readIORef v >>= \case
 				(Just (ctx', _)) -> do
 					let digest = hashFinalize ctx'
-					return $ samechecksum (show digest)
-				Nothing -> return False
-		, failIncremental = writeIORef v Nothing
+					return $ Just $ 
+						samechecksum (show digest)
+				Nothing -> return Nothing
+		, unableIncremental = writeIORef v Nothing
 		, positionIncremental = readIORef v >>= \case
 			Just (_, n) -> return (Just n)
 			Nothing -> return Nothing