refactor

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
 

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
 

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

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
+		liftIO $ withMeteredFile f meterupdate $
-			b <- hGetContentsObserved h $ meterupdate . toInteger
+			storeHelper r url user pass
-			storeHelper r url user pass b
 
 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

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

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 ())

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