progress meter for p2phttp storeKey

diff --git a/P2P/Http/Client.hs b/P2P/Http/Client.hs
index 78a17c30d6fdb97a96e62a1195e8f08a0c123325..ed0773ddd999a0ae7990108caec70ccabee6a8c0 100644 (file)
--- a/P2P/Http/Client.hs
+++ b/P2P/Http/Client.hs
@@ -318,7 +318,7 @@ clientPut meterupdate k moffset af contentfile contentfilesize validitycheck cli
                        return (Right res)
   where
        stream h checkv checkresultv = S.SourceT $ \a -> do
-               bl <- L.hGetContents h
+               bl <- hGetContentsMetered h meterupdate
                v <- newMVar (0, filter (not . B.null) (L.toChunks bl))
                a (go v)
          where

diff --git a/Remote/Git.hs b/Remote/Git.hs
index dec386e081d03a17ed6423b8153728aa7605f315..a52884fee48ad60bf1f259bc7eb3b0c11bbb370c 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -57,6 +57,7 @@ import qualified Remote.GCrypt
 import qualified Remote.GitLFS
 import qualified Remote.P2P
 import qualified Remote.Helper.P2P as P2PHelper
+import qualified P2P.Protocol as P2P
 import P2P.Address
 import P2P.Http.Url
 import P2P.Http.Client
@@ -667,10 +668,11 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate
                                return False
                        Nothing -> return True
                in p2pHttpClient r (const $ pure $ PutOffsetResultPlus (Offset 0)) (clientPutOffset key) >>= \case
-                       PutOffsetResultPlus offset -> 
+                       PutOffsetResultPlus (offset@(Offset (P2P.Offset n))) ->
                                metered (Just meterupdate) key bwlimit $ \_ p -> do
+                                       let p' = offsetMeterUpdate p (BytesProcessed n)
                                        res <- p2pHttpClient r giveup $
-                                               clientPut p key (Just offset) af object sz check'
+                                               clientPut p' key (Just offset) af object sz check'
                                        case res of
                                                PutResultPlus False _ ->
                                                        failedsend

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index a664f5749a0e594e1f857fba276b29b22c736f61..e57238f305b41e3f41f7536e749e90f481b368c9 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -28,7 +28,7 @@ Planned schedule of work:
 
 ## work notes
 
-* Rest of Remote.Git needs implementing: put, drop, lock
+* Rest of Remote.Git needs implementing: drop, lock
 
 * A Locker should expire the lock on its own after 10 minutes,
   initially. Once keeplocked is called, the expiry should end with the end