refactor sinkResponseFile and add downloadC
Remote.S3 and Remote.Helper.Http both had similar code to sink a http-conduit Response to a file; refactor out sinkResponseFile. downloadC downloads an url to a file using http-conduit, and supports resuming. Falls back to curl to handle urls that http-conduit does not support. This is not used yet, but the goal is to replace download with it. git-annex.cabal: conduit-extra was not actually used for a long time, remove the dep. conduit moves into the main dependency list, but since http-conduit was already in there, and it depends on conduit, that's not really adding a new build dep. This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
parent
0e8564201e
commit
0f6775f1ff
6 changed files with 138 additions and 35 deletions
|
@ -15,6 +15,7 @@ import Utility.Metered
|
|||
import Remote.Helper.Special
|
||||
import Network.HTTP.Client (RequestBody(..), Response, responseStatus, responseBody, BodyReader, NeedsPopper)
|
||||
import Network.HTTP.Types
|
||||
import Network.HTTP.Conduit
|
||||
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString as S
|
||||
|
@ -71,15 +72,5 @@ handlePopper numchunks chunksize meterupdate h sink = do
|
|||
httpBodyRetriever :: FilePath -> MeterUpdate -> Response BodyReader -> IO ()
|
||||
httpBodyRetriever dest meterupdate resp
|
||||
| responseStatus resp /= ok200 = giveup $ show $ responseStatus resp
|
||||
| otherwise = bracket (openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)
|
||||
where
|
||||
reader = responseBody resp
|
||||
go sofar h = do
|
||||
b <- reader
|
||||
if S.null b
|
||||
then return ()
|
||||
else do
|
||||
let sofar' = addBytesProcessed sofar $ S.length b
|
||||
S.hPut h b
|
||||
meterupdate sofar'
|
||||
go sofar' h
|
||||
| otherwise = runResourceT $
|
||||
sinkResponseFile meterupdate zeroBytesProcessed dest WriteMode resp
|
||||
|
|
16
Remote/S3.hs
16
Remote/S3.hs
|
@ -47,6 +47,7 @@ import Creds
|
|||
import Annex.UUID
|
||||
import Logs.Web
|
||||
import Utility.Metered
|
||||
import qualified Utility.Url as Url
|
||||
import Utility.DataUnits
|
||||
import Utility.FileSystemEncoding
|
||||
import Annex.Content
|
||||
|
@ -259,22 +260,9 @@ retrieve r info Nothing = case getpublicurl info of
|
|||
|
||||
retrieveHelper :: S3Info -> S3Handle -> S3.Object -> FilePath -> MeterUpdate -> Annex ()
|
||||
retrieveHelper info h object f p = liftIO $ runResourceT $ do
|
||||
(fr, fh) <- allocate (openFile f WriteMode) hClose
|
||||
let req = S3.getObject (bucket info) object
|
||||
S3.GetObjectResponse { S3.gorResponse = rsp } <- sendS3Handle' h req
|
||||
responseBody rsp $$+- sinkprogressfile fh p zeroBytesProcessed
|
||||
release fr
|
||||
where
|
||||
sinkprogressfile fh meterupdate sofar = do
|
||||
mbs <- await
|
||||
case mbs of
|
||||
Nothing -> return ()
|
||||
Just bs -> do
|
||||
let sofar' = addBytesProcessed sofar (S.length bs)
|
||||
liftIO $ do
|
||||
void $ meterupdate sofar'
|
||||
S.hPut fh bs
|
||||
sinkprogressfile fh meterupdate sofar'
|
||||
Url.sinkResponseFile p zeroBytesProcessed f WriteMode rsp
|
||||
|
||||
retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
|
||||
retrieveCheap _ _ _ = return False
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue