avoid watchFileSize running backward

This is groundwork for using watchFileSize for downloads from external
special remotes.

In Annex.Content.downloadUrl, this potentially avoids jitter in the
progress meter. When downloading with conduit, the meter gets updated based
on both the size of the file, and on the data flowing through conduit.
If that has not yet been flushed to the file, it seems possible for the
meter to run backwards when meter is updated with the file size.
It's probably only a few kb of jitter, so may not be visible.

Sponsored-by: Dartmouth College's DANDI project

4 files changed, 41 insertions, 15 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 4fddf43b51..9c5d01cd83 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -753,7 +753,7 @@ downloadUrl listfailedurls k p iv urls file uo =
 	-- download command is used.
 	meteredFile file (Just p) k (go urls [])
   where
-	go (u:us) errs = Url.download' p iv u file uo >>= \case
+	go (u:us) errs p' = Url.download' p' iv u file uo >>= \case
 		Right () -> return True
 		Left err -> do
 			-- If the incremental verifier was fed anything
@@ -765,9 +765,9 @@ downloadUrl listfailedurls k p iv urls file uo =
 					Just n | n > 0 -> unableIncrementalVerifier iv'
 					_ -> noop
 				Nothing -> noop
-			go us ((u, err) : errs)
-	go [] [] = return False
-	go [] errs@((_, err):_) = do
+			go us ((u, err) : errs) p'
+	go [] [] _ = return False
+	go [] errs@((_, err):_) _ = do
 		if listfailedurls
 			then warning $ UnquotedString $
 				unlines $ flip map errs $ \(u, err') ->
diff --git a/Annex/CopyFile.hs b/Annex/CopyFile.hs
index 0be9debd5f..176f71c076 100644
--- a/Annex/CopyFile.hs
+++ b/Annex/CopyFile.hs
@@ -57,7 +57,7 @@ tryCopyCoW (CopyCoWTried copycowtried) src dest meterupdate =
 			)
 		)
   where
-	docopycow = watchFileSize dest meterupdate $
+	docopycow = watchFileSize dest meterupdate $ const $
 		copyCoW CopyTimeStamps src dest
 	
 	dest' = toRawFilePath dest
diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index 4327e1970f..6392f12fa2 100644
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -171,7 +171,7 @@ metered' st setclear othermeterupdate msize bwlimit showoutput a = go st
 	minratelimit = min consoleratelimit jsonratelimit
 		
 {- Poll file size to display meter. -}
-meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> Annex a -> Annex a
+meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
 meteredFile file combinemeterupdate key a = 
 	metered combinemeterupdate key Nothing $ \_ p ->
 		watchFileSize file p a
diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index 7be8c9ec61..b97516cb1a 100644
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -1,6 +1,6 @@
 {- Metered IO and actions
  -
- - Copyright 2012-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -218,23 +218,49 @@ defaultChunkSize = 32 * k - chunkOverhead
  - away and start over. To avoid reporting the original file size followed
  - by a smaller size in that case, wait until the file starts growing
  - before updating the meter for the first time.
+ -
+ - An updated version of the MeterUpdate is passed to the action, and the
+ - action should use that for any updates that it makes. This allows for
+ - eg, the action updating the meter before a write is flushed to the file.
+ - In that situation, this avoids the meter being set back to the size of
+ - the file when it's gotten ahead of that point.
  -}
-watchFileSize :: (MonadIO m, MonadMask m) => FilePath -> MeterUpdate -> m a -> m a
-watchFileSize f p a = bracket 
-	(liftIO $ forkIO $ watcher =<< getsz)
-	(liftIO . void . tryIO . killThread)
-	(const a)
+watchFileSize
+	:: (MonadIO m, MonadMask m)
+	=> FilePath
+	-> MeterUpdate
+	-> (MeterUpdate -> m a)
+	-> m a
+watchFileSize f p a = do
+	sizevar <- liftIO $ newMVar zeroBytesProcessed
+	bracket 
+		(liftIO $ forkIO $ watcher (meterupdate sizevar True) =<< getsz)
+		(liftIO . void . tryIO . killThread)
+		(const (a (meterupdate sizevar False)))
   where
-	watcher oldsz = do
+	watcher p' oldsz = do
 		threadDelay 500000 -- 0.5 seconds
 		sz <- getsz
 		when (sz > oldsz) $
-			p sz
-		watcher sz
+			p' sz
+		watcher p' sz
 	getsz = catchDefaultIO zeroBytesProcessed $
 		toBytesProcessed <$> getFileSize f'
 	f' = toRawFilePath f
 
+	meterupdate sizevar preventbacktracking n
+		| preventbacktracking = do
+			old <- takeMVar sizevar
+			if old > n
+				then putMVar sizevar old
+				else do
+					putMVar sizevar n
+					p n
+		| otherwise = do
+			void $ takeMVar sizevar
+			putMVar sizevar n
+			p n
+
 data OutputHandler = OutputHandler
 	{ quietMode :: Bool
 	, stderrHandler :: String -> IO ()