summaryrefslogtreecommitdiff
path: root/Remote/Helper
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-08-07 19:32:23 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-08-07 19:32:23 -0400
commit593a317cceb1a2496ebd7bd2c6656c2d669246fc (patch)
treeee2a5d751b4dbefcc1c6317bea32dfdcf589e788 /Remote/Helper
parentdd606f4c5913cebd8840ac1544a7d0acd79e70bb (diff)
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.
Diffstat (limited to 'Remote/Helper')
-rw-r--r--Remote/Helper/Http.hs39
1 files changed, 39 insertions, 0 deletions
diff --git a/Remote/Helper/Http.hs b/Remote/Helper/Http.hs
new file mode 100644
index 000000000..945e5cd99
--- /dev/null
+++ b/Remote/Helper/Http.hs
@@ -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