webapp: Progess bar fixes for many types of special remotes.

There was confusion in different parts of the progress bar code about
whether an update contained the total number of bytes transferred, or the
number of bytes transferred since the last update. One way this bug
showed up was progress bars that seemed to stick at zero for a long time.
In order to fix it comprehensively, I add a new BytesProcessed data type,
that is explicitly a total quantity of bytes, not a delta.

Note that this doesn't necessarily fix every problem with progress bars.
Particularly, buffering can now cause progress bars to seem to run ahead
of transfers, reaching 100% when data is still being uploaded.

11 files changed, 24 insertions, 15 deletions

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index d168f0715..1c69d0a1c 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -29,6 +29,7 @@ import Data.ByteString.Lazy.UTF8 (fromString)
 import Data.Digest.Pure.SHA
 import Utility.UserInfo
 import Annex.Content
+import Utility.Metered
 
 type BupRepo = String
 
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index be533d038..8c5fa795e 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -24,7 +24,7 @@ import Remote.Helper.Encryptable
 import Remote.Helper.Chunked
 import Crypto
 import Annex.Content
-import Meters
+import Utility.Metered
 
 remote :: RemoteType
 remote = RemoteType {
@@ -154,17 +154,20 @@ storeSplit' :: MeterUpdate -> Int64 -> [FilePath] -> [S.ByteString] -> [FilePath
 storeSplit' _ _ [] _ _ = error "ran out of dests"
 storeSplit' _ _  _ [] c = return $ reverse c
 storeSplit' meterupdate chunksize (d:dests) bs c = do
-	bs' <- E.bracket (openFile d WriteMode) hClose (feed chunksize bs)
+	bs' <- E.bracket (openFile d WriteMode) hClose $
+		feed zeroBytesProcessed chunksize bs
 	storeSplit' meterupdate chunksize dests bs' (d:c)
   where
-	feed _ [] _ = return []
-	feed sz (l:ls) h = do
-		let s = fromIntegral $ S.length l
+	feed _ _ [] _ = return []
+	feed bytes sz (l:ls) h = do
+		let len = S.length l
+		let s = fromIntegral len
 		if s <= sz || sz == chunksize
 			then do
 				S.hPut h l
-				meterupdate $ toInteger s
-				feed (sz - s) ls h
+				let bytes' = addBytesProcessed bytes len
+				meterupdate bytes'
+				feed bytes' (sz - s) ls h
 			else return (l:ls)
 
 storeHelper :: FilePath -> ChunkSize -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 207655b4e..31396003b 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -40,6 +40,7 @@ import Init
 import Types.Key
 import qualified Fields
 import Logs.Location
+import Utility.Metered
 
 import Control.Concurrent
 import Control.Concurrent.MSampleVar
@@ -309,7 +310,7 @@ copyFromRemote r key file dest
 			: maybe [] (\f -> [(Fields.associatedFile, f)]) file
 		Just (cmd, params) <- git_annex_shell (repo r) "transferinfo" 
 			[Param $ key2file key] fields
-		v <- liftIO $ newEmptySV
+		v <- liftIO $ (newEmptySV :: IO (MSampleVar Integer))
 		tid <- liftIO $ forkIO $ void $ tryIO $ do
 			bytes <- readSV v
 			p <- createProcess $
@@ -325,7 +326,7 @@ copyFromRemote r key file dest
 			send bytes
 			forever $
 				send =<< readSV v
-		let feeder = writeSV v
+		let feeder = writeSV v . fromBytesProcessed
 		bracketIO noop (const $ tryIO $ killThread tid) (a feeder)
 
 copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool
@@ -391,13 +392,13 @@ rsyncOrCopyFile rsyncparams src dest p =
 	dorsync = rsyncHelper (Just p) $
 		rsyncparams ++ [Param src, Param dest]
 	docopy = liftIO $ bracket
-		(forkIO $ watchfilesize 0)
+		(forkIO $ watchfilesize zeroBytesProcessed)
 		(void . tryIO . killThread)
 		(const $ copyFileExternal src dest)
 	watchfilesize oldsz = do
 		threadDelay 500000 -- 0.5 seconds
 		v <- catchMaybeIO $
-			fromIntegral . fileSize
+			toBytesProcessed . fileSize
 				<$> getFileStatus dest
 		case v of
 			Just sz
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index ea5df31e5..088c62fb3 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -22,7 +22,7 @@ import Remote.Helper.Encryptable
 import qualified Remote.Helper.AWS as AWS
 import Crypto
 import Creds
-import Meters
+import Utility.Metered
 import qualified Annex
 import Annex.Content
 
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 11b86042e..46678de70 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -10,7 +10,7 @@ module Remote.Helper.Chunked where
 import Common.Annex
 import Utility.DataUnits
 import Types.Remote
-import Meters
+import Utility.Metered
 
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 242fcfe8a..4f0404f2a 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -15,6 +15,7 @@ import Crypto
 import qualified Annex
 import Config.Cost
 import Utility.Base64
+import Utility.Metered
 
 {- Encryption setup for a remote. The user must specify whether to use
  - an encryption key, or not encrypt. An encrypted cipher is created, or is
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 97691d075..46ee8000f 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -21,6 +21,7 @@ import Annex.Content
 import Remote.Helper.Special
 import Remote.Helper.Encryptable
 import Crypto
+import Utility.Metered
 
 remote :: RemoteType
 remote = RemoteType {
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 1425601ad..9563b43e8 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -22,6 +22,7 @@ import Remote.Helper.Encryptable
 import Crypto
 import Utility.Rsync
 import Utility.CopyFile
+import Utility.Metered
 import Annex.Perms
 
 type RsyncUrl = String
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 0ca86f1ff..017886694 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -27,7 +27,7 @@ import Remote.Helper.Encryptable
 import qualified Remote.Helper.AWS as AWS
 import Crypto
 import Creds
-import Meters
+import Utility.Metered
 import Annex.Content
 
 remote :: RemoteType
diff --git a/Remote/Web.hs b/Remote/Web.hs
index b0d12002c..5af3c5228 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -17,6 +17,7 @@ import Config.Cost
 import Logs.Web
 import qualified Utility.Url as Url
 import Types.Key
+import Utility.Metered
 
 import qualified Data.Map as M
 
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 3b729fe83..db5535494 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -30,7 +30,7 @@ import Remote.Helper.Encryptable
 import Remote.Helper.Chunked
 import Crypto
 import Creds
-import Meters
+import Utility.Metered
 import Annex.Content
 
 type DavUrl = String