progress meter for p2phttp storeKey

This commit is contained in:
Joey Hess 2024-07-24 12:14:56 -04:00
parent b3915b88ba
commit cfdb80cd05
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 6 additions and 4 deletions

View file

@ -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

View file

@ -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

View file

@ -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