summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Crypto.hs8
-rw-r--r--Messages.hs1
-rw-r--r--Meters.hs25
-rw-r--r--Remote/WebDAV.hs9
-rw-r--r--Types.hs4
-rw-r--r--Types/Meters.hs12
-rw-r--r--Types/Remote.hs5
7 files changed, 45 insertions, 19 deletions
diff --git a/Crypto.hs b/Crypto.hs
index 99b17ce02..fe6c6d5cb 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -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
diff --git a/Types.hs b/Types.hs
index 4c16fb8f4..eb77826cb 100644
--- a/Types.hs
+++ b/Types.hs
@@ -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