mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

fix bad refactoring

Browse source 
Reponse BodyReader is not a conduit thing, so can't use the refactored
function here after all. Oops. Put it back how it was.
This commit is contained in:
Joey Hess 2018-04-06 16:59:14 -04:00
parent 36e6b8abbf
commit 0791c24221
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 15 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

21
Remote/Helper/Http.hs
View file

@ -11,15 +11,14 @@ module Remote.Helper.Http where
import Annex.Common import Annex.Common
import Types.StoreRetrieve import Types.StoreRetrieve
import Utility.Metered
import Remote.Helper.Special import Remote.Helper.Special
import Network.HTTP.Client (RequestBody(..), Response, responseStatus, responseBody, BodyReader, NeedsPopper) import Utility.Metered
import Network.HTTP.Types
import Network.HTTP.Conduit
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as S import qualified Data.ByteString as S
import Control.Concurrent import Control.Concurrent
import Network.HTTP.Client (RequestBody(..), Response, responseStatus, responseBody, BodyReader, NeedsPopper)
import Network.HTTP.Types
-- A storer that expects to be provided with a http RequestBody containing -- A storer that expects to be provided with a http RequestBody containing
-- the content to store. -- the content to store.
@ -72,5 +71,15 @@ handlePopper numchunks chunksize meterupdate h sink = do
httpBodyRetriever :: FilePath -> MeterUpdate -> Response BodyReader -> IO () httpBodyRetriever :: FilePath -> MeterUpdate -> Response BodyReader -> IO ()
httpBodyRetriever dest meterupdate resp httpBodyRetriever dest meterupdate resp
| responseStatus resp /= ok200 = giveup $ show $ responseStatus resp | responseStatus resp /= ok200 = giveup $ show $ responseStatus resp
| otherwise = runResourceT $ | otherwise = bracket (openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)
sinkResponseFile meterupdate zeroBytesProcessed dest WriteMode resp 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