diff options
| -rw-r--r-- | Crypto.hs | 8 | ||||
| -rw-r--r-- | Messages.hs | 1 | ||||
| -rw-r--r-- | Meters.hs | 25 | ||||
| -rw-r--r-- | Remote/WebDAV.hs | 9 | ||||
| -rw-r--r-- | Types.hs | 4 | ||||
| -rw-r--r-- | Types/Meters.hs | 12 | ||||
| -rw-r--r-- | Types/Remote.hs | 5 |
7 files changed, 45 insertions, 19 deletions
@@ -19,7 +19,6 @@ module Crypto ( decryptCipher, encryptKey, feedFile, - feedFileMetered, feedBytes, readBytes, encrypt, @@ -37,8 +36,6 @@ import Common.Annex import qualified Utility.Gpg as Gpg import Types.Key import Types.Crypto -import Types.Remote -import Utility.Observed {- The first half of a Cipher is used for HMAC; the remainder - is used as the GPG symmetric encryption passphrase. @@ -125,11 +122,6 @@ type Reader a = Handle -> IO a feedFile :: FilePath -> Feeder feedFile f h = L.hPut h =<< L.readFile f -feedFileMetered :: FilePath -> MeterUpdate -> Feeder -feedFileMetered f m to = withBinaryFile f ReadMode $ \h -> do - b <- hGetContentsObserved h $ m . toInteger - L.hPut to b - feedBytes :: L.ByteString -> Feeder feedBytes = flip L.hPut diff --git a/Messages.hs b/Messages.hs index f3cd9fc0e..055b561dd 100644 --- a/Messages.hs +++ b/Messages.hs @@ -41,7 +41,6 @@ import Common import Types import Types.Messages import Types.Key -import Types.Remote import qualified Annex import qualified Messages.JSON as JSON diff --git a/Meters.hs b/Meters.hs new file mode 100644 index 000000000..0ea5d3af6 --- /dev/null +++ b/Meters.hs @@ -0,0 +1,25 @@ +{- git-annex meters + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Meters where + +import Common +import Types.Meters +import Utility.Observed + +import qualified Data.ByteString.Lazy as L + +{- Sends the content of a file to an action, updating the meter as it's + - consumed. -} +withMeteredFile :: FilePath -> MeterUpdate -> (L.ByteString -> IO a) -> IO a +withMeteredFile f meterupdate a = withBinaryFile f ReadMode $ \h -> + hGetContentsObserved h (meterupdate . toInteger) >>= a + +{- Sends the content of a file to a Handle, updating the meter as it's + - written. -} +sendMeteredFile :: FilePath -> MeterUpdate -> Handle -> IO () +sendMeteredFile f meterupdate h = withMeteredFile f meterupdate $ L.hPut h diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 2dce15499..e7da3af19 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -31,7 +31,7 @@ import Remote.Helper.Encryptable import Remote.Helper.Chunked import Crypto import Creds -import Utility.Observed +import Meters type DavUrl = String type DavUser = B8.ByteString @@ -89,16 +89,15 @@ 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 + liftIO $ withMeteredFile f meterupdate $ + storeHelper r url user pass storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool 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) $ + liftIO $ encrypt cipher (sendMeteredFile f meterupdate) $ readBytes $ storeHelper r url user pass storeHelper :: Remote -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool @@ -12,7 +12,8 @@ module Types ( UUID(..), Remote, RemoteType, - Option + Option, + MeterUpdate ) where import Annex @@ -21,6 +22,7 @@ import Types.Key import Types.UUID import Types.Remote import Types.Option +import Types.Meters type Backend = BackendA Annex type Remote = RemoteA Annex diff --git a/Types/Meters.hs b/Types/Meters.hs new file mode 100644 index 000000000..ef304d1ae --- /dev/null +++ b/Types/Meters.hs @@ -0,0 +1,12 @@ +{- git-annex meter types + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.Meters where + +{- An action that can be run repeatedly, feeding it the number of + - bytes sent or retrieved so far. -} +type MeterUpdate = (Integer -> IO ()) diff --git a/Types/Remote.hs b/Types/Remote.hs index 572240de0..271676d0e 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -15,6 +15,7 @@ import Data.Ord import qualified Git import Types.Key import Types.UUID +import Types.Meters type RemoteConfigKey = String type RemoteConfig = M.Map RemoteConfigKey String @@ -37,10 +38,6 @@ instance Eq (RemoteTypeA a) where {- A filename associated with a Key, for display to user. -} type AssociatedFile = Maybe FilePath -{- An action that can be run repeatedly, feeding it the number of - - bytes sent or retrieved so far. -} -type MeterUpdate = (Integer -> IO ()) - {- An individual remote. -} data RemoteA a = Remote { -- each Remote has a unique uuid |