diff options
Diffstat (limited to 'Remote/Helper/Http.hs')
| -rw-r--r-- | Remote/Helper/Http.hs | 20 |
1 files changed, 17 insertions, 3 deletions
diff --git a/Remote/Helper/Http.hs b/Remote/Helper/Http.hs index 945e5cd99..d4882b8c8 100644 --- a/Remote/Helper/Http.hs +++ b/Remote/Helper/Http.hs @@ -11,7 +11,7 @@ import Common.Annex import Types.StoreRetrieve import Utility.Metered import Remote.Helper.Special -import Network.HTTP.Client (RequestBody(..)) +import Network.HTTP.Client (RequestBody(..), Response, responseBody, BodyReader) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S @@ -35,5 +35,19 @@ httpStorer a = fileStorer $ \k f m -> do pop [] = ([], S.empty) pop (c:cs) = (cs, c) ---httpRetriever :: (Key -> Annex Response) -> Retriever ---httpRetriever a = byteRetriever $ \k sink +-- Reads the http body and stores it to the specified file, updating the +-- meter as it goes. +httpBodyRetriever :: FilePath -> MeterUpdate -> Response BodyReader -> IO () +httpBodyRetriever dest meterupdate resp = + 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 |