diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-18 20:06:28 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-18 20:30:05 -0400 |
commit | 6aa68125b6d476f0ad9372a0f0fbaa5c118e7096 (patch) | |
tree | baadc0f86773f86903239e242559df8553bd41fa /Remote/WebDAV.hs | |
parent | ac71b499ac6d53408cfce19a1ddd00bfa4b2645f (diff) |
upload progress bars for webdav!
Diffstat (limited to 'Remote/WebDAV.hs')
-rw-r--r-- | Remote/WebDAV.hs | 23 |
1 files changed, 14 insertions, 9 deletions
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index ed7b82b64..2dce15499 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -31,6 +31,7 @@ import Remote.Helper.Encryptable import Remote.Helper.Chunked import Crypto import Creds +import Utility.Observed type DavUrl = String type DavUser = B8.ByteString @@ -84,17 +85,21 @@ webdavSetup u c = do setRemoteCredPair c' (davCreds u) store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool -store r k _f _p = davAction r False $ \(baseurl, user, pass) -> do - let url = davLocation baseurl k - f <- inRepo $ gitAnnexLocation k - liftIO $ storeHelper r url user pass =<< L.readFile f +store r k _f p = metered (Just p) k $ \meterupdate -> + davAction r False $ \(baseurl, user, pass) -> do + let url = davLocation baseurl k + f <- inRepo $ gitAnnexLocation k + liftIO $ withBinaryFile f ReadMode $ \h -> do + b <- hGetContentsObserved h $ meterupdate . toInteger + storeHelper r url user pass b storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool -storeEncrypted r (cipher, enck) k _p = davAction r False $ \(baseurl, user, pass) -> do - let url = davLocation baseurl enck - f <- inRepo $ gitAnnexLocation k - liftIO $ encrypt cipher (feedFile f) $ - readBytes $ storeHelper r url user pass +storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate -> + davAction r False $ \(baseurl, user, pass) -> do + let url = davLocation baseurl enck + f <- inRepo $ gitAnnexLocation k + liftIO $ encrypt cipher (feedFileMetered f meterupdate) $ + readBytes $ storeHelper r url user pass storeHelper :: Remote -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool storeHelper r urlbase user pass b = catchBoolIO $ do |