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

WIP 2

Browse source
This commit is contained in:
Joey Hess 2014-11-03 19:50:33 -04:00
parent 5360417436
commit d16382e99f
2 changed files with 23 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Remote/Helper/Http.hs
View file

@ -11,7 +11,7 @@ import Common.Annex
import Types.StoreRetrieve
import Utility.Metered
import Remote.Helper.Special
import Network.HTTP.Client (RequestBody(..), Response, responseStatus, responseBody, BodyReader)
import Network.HTTP.Client (RequestBody(..), Response, responseStatus, responseBody, BodyReader, NeedsPopper)
import Network.HTTP.Types
import qualified Data.ByteString.Lazy as L
@ -31,11 +31,14 @@ httpStorer a = fileStorer $ \k f m -> a k =<< liftIO (httpBodyStorer f m)
httpBodyStorer :: FilePath -> MeterUpdate -> IO RequestBody
httpBodyStorer src m = do
size <- fromIntegral . fileSize <$> getFileStatus src :: IO Integer
let streamer sink = withMeteredFile src m $ \b -> do
mvar <- newMVar $ L.toChunks b
let getnextchunk = modifyMVar mvar $ pure . pop
sink getnextchunk
let streamer sink = withMeteredFile src m $ \b -> mkPopper b sink
return $ RequestBodyStream (fromInteger size) streamer
mkPopper :: L.ByteString -> NeedsPopper () -> IO ()
mkPopper b sink = do
mvar <- newMVar $ L.toChunks b
let getnextchunk = modifyMVar mvar $ pure . pop
sink getnextchunk
where
pop [] = ([], S.empty)
pop (c:cs) = (cs, c)