From cfdb80cd05b65a064e0d006b321a6345345f0a33 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 24 Jul 2024 12:14:56 -0400
Subject: [PATCH] progress meter for p2phttp storeKey

---
 P2P/Http/Client.hs              | 2 +-
 Remote/Git.hs                   | 6 ++++--
 doc/todo/git-annex_proxies.mdwn | 2 +-
 3 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/P2P/Http/Client.hs b/P2P/Http/Client.hs
index 78a17c30d6..ed0773ddd9 100644
--- 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 dec386e081..a52884fee4 100644
--- 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 a664f5749a..e57238f305 100644
--- 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