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 Annex.Common
import P2P.Protocol hiding (Offset, Bypass, auth) import P2P.Protocol hiding (Offset, Bypass, auth)
import Annex.Concurrent import Annex.Concurrent
import Annex.Verify
import Utility.Url (BasicAuth(..)) import Utility.Url (BasicAuth(..))
import Utility.Metered import Utility.Metered
import qualified Git.Credential as Git import qualified Git.Credential as Git
@ -144,27 +143,22 @@ runP2PHttpClient rmt fallback () = fallback
#endif #endif
#ifdef WITH_SERVANT #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 clientGet
:: MeterUpdate :: Key
-> Maybe IncrementalVerifier
-> Key
-> AssociatedFile -> AssociatedFile
-> Handle -> (L.ByteString -> IO BytesProcessed)
-- ^ Must consume the entire ByteString before returning its
-- total size.
-> Maybe FileSize -> Maybe FileSize
-- ^ Size of existing file, when resuming.
-> ClientAction Validity -> 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 let offset = fmap (Offset . fromIntegral) startsz
withClientM (cli (B64Key k) cu bypass baf offset auth) clientenv $ \case withClientM (cli (B64Key k) cu bypass baf offset auth) clientenv $ \case
Left err -> return (Left err) Left err -> return (Left err)
Right respheaders -> do Right respheaders -> do
b <- S.unSourceT (getResponse respheaders) gather b <- S.unSourceT (getResponse respheaders) gather
BytesProcessed len <- meteredWrite' BytesProcessed len <- consumer b
meterupdate
(writeVerifyChunk iv h) b
let DataLength dl = case lookupResponseHeader @DataLengthHeader' respheaders of let DataLength dl = case lookupResponseHeader @DataLengthHeader' respheaders of
Header hdr -> hdr Header hdr -> hdr
_ -> error "missing data length header" _ -> 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 Just startsz' -> liftIO $ do
resumeVerifyFromOffset startsz' iv p h resumeVerifyFromOffset startsz' iv p h
_ -> return p _ -> 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 () Valid -> return ()
Invalid -> giveup "Transfer failed" Invalid -> giveup "Transfer failed"