WebDAV: Avoid buffering whole file in memory when uploading.
The httpStorer will later also be used by S3. This commit was sponsored by Torbjørn Thorsen.
This commit is contained in:
parent
fc4b3cdcce
commit
2dd8dab314
3 changed files with 62 additions and 21 deletions
39
Remote/Helper/Http.hs
Normal file
39
Remote/Helper/Http.hs
Normal file
|
@ -0,0 +1,39 @@
|
|||
{- helpers for remotes using http
|
||||
-
|
||||
- Copyright 2014 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Remote.Helper.Http where
|
||||
|
||||
import Common.Annex
|
||||
import Types.StoreRetrieve
|
||||
import Utility.Metered
|
||||
import Remote.Helper.Special
|
||||
import Network.HTTP.Client (RequestBody(..))
|
||||
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString as S
|
||||
import Control.Concurrent
|
||||
|
||||
-- A storer that expects to be provided with a http RequestBody containing
|
||||
-- the content to store.
|
||||
--
|
||||
-- Implemented as a fileStorer, so that the content can be streamed
|
||||
-- from the file in constant space.
|
||||
httpStorer :: (Key -> RequestBody -> Annex Bool) -> Storer
|
||||
httpStorer a = fileStorer $ \k f m -> do
|
||||
size <- liftIO $ (fromIntegral . fileSize <$> getFileStatus f :: IO Integer)
|
||||
let streamer sink = withMeteredFile f m $ \b -> do
|
||||
mvar <- newMVar $ L.toChunks b
|
||||
let getnextchunk = modifyMVar mvar $ pure . pop
|
||||
sink getnextchunk
|
||||
let body = RequestBodyStream (fromInteger size) streamer
|
||||
a k body
|
||||
where
|
||||
pop [] = ([], S.empty)
|
||||
pop (c:cs) = (cs, c)
|
||||
|
||||
--httpRetriever :: (Key -> Annex Response) -> Retriever
|
||||
--httpRetriever a = byteRetriever $ \k sink
|
Loading…
Add table
Add a link
Reference in a new issue