more generic clientGet

This commit is contained in:
Joey Hess 2024-07-24 11:10:19 -04:00
parent 10f2c23fd7
commit 5b1ac1a313
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 10 additions and 14 deletions

View file

@ -28,7 +28,6 @@ import P2P.Http.Url
import Annex.Common
import P2P.Protocol hiding (Offset, Bypass, auth)
import Annex.Concurrent
import Annex.Verify
import Utility.Url (BasicAuth(..))
import Utility.Metered
import qualified Git.Credential as Git
@ -144,27 +143,22 @@ runP2PHttpClient rmt fallback () = fallback
#endif
#ifdef WITH_SERVANT
-- Downloads and writes to the Handle. If the file already exists, provide
-- its starting size, and it will resume from that point. Note that the
-- IncrementalVerifier needs to have already been fed the existing content
-- of the file.
clientGet
:: MeterUpdate
-> Maybe IncrementalVerifier
-> Key
:: Key
-> AssociatedFile
-> Handle
-> (L.ByteString -> IO BytesProcessed)
-- ^ Must consume the entire ByteString before returning its
-- total size.
-> Maybe FileSize
-- ^ Size of existing file, when resuming.
-> ClientAction Validity
clientGet meterupdate iv k af h startsz clientenv (ProtocolVersion ver) su cu bypass auth = liftIO $ do
clientGet k af consumer startsz clientenv (ProtocolVersion ver) su cu bypass auth = liftIO $ do
let offset = fmap (Offset . fromIntegral) startsz
withClientM (cli (B64Key k) cu bypass baf offset auth) clientenv $ \case
Left err -> return (Left err)
Right respheaders -> do
b <- S.unSourceT (getResponse respheaders) gather
BytesProcessed len <- meteredWrite'
meterupdate
(writeVerifyChunk iv h) b
BytesProcessed len <- consumer b
let DataLength dl = case lookupResponseHeader @DataLengthHeader' respheaders of
Header hdr -> hdr
_ -> error "missing data length header"

View file

@ -583,7 +583,9 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc
Just startsz' -> liftIO $ do
resumeVerifyFromOffset startsz' iv p h
_ -> return p
p2pHttpClient r giveup (clientGet p' iv key af h startsz) >>= \case
let consumer = meteredWrite' p'
(writeVerifyChunk iv h)
p2pHttpClient r giveup (clientGet key af consumer startsz) >>= \case
Valid -> return ()
Invalid -> giveup "Transfer failed"