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
Show stats 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 Types.StoreRetrieve
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 Utility.Metered
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as S
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
-- the content to store.
@ -72,5 +71,15 @@ 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 = runResourceT $
sinkResponseFile meterupdate zeroBytesProcessed dest WriteMode 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