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.

2 files changed, 5 insertions, 26 deletions

diff --git a/Remote/Helper/Http.hs b/Remote/Helper/Http.hs
index ebe0f2598e..ee3107e46e 100644
--- a/Remote/Helper/Http.hs
+++ b/Remote/Helper/Http.hs
@@ -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
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 22f38ef59d..f08ed6770f 100644
--- a/Remote/S3.hs
+++ b/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