diff options
author | Joey Hess <joey@kitenet.net> | 2012-09-19 16:08:37 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-09-19 16:08:37 -0400 |
commit | aff09a1f33be7b3df182a7c85b30a2d3e04833c7 (patch) | |
tree | 6d7cb4ed4e9483c14bdd832c9af848dc1b866789 /Remote | |
parent | 3c81d70c1beccb50571281ef35c9123bac006b7c (diff) |
add a progress callback to storeKey, and threaded it all the way through
Transfer info files are updated when the callback is called, updating
the number of bytes transferred.
Left unused p variables at every place the callback should be used.
Which is rather a lot..
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Bup.hs | 8 | ||||
-rw-r--r-- | Remote/Directory.hs | 8 | ||||
-rw-r--r-- | Remote/Git.hs | 10 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 8 | ||||
-rw-r--r-- | Remote/Helper/Hooks.hs | 2 | ||||
-rw-r--r-- | Remote/Hook.hs | 8 | ||||
-rw-r--r-- | Remote/Rsync.hs | 8 | ||||
-rw-r--r-- | Remote/S3.hs | 8 | ||||
-rw-r--r-- | Remote/Web.hs | 4 |
9 files changed, 32 insertions, 32 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index e3ba7fe9b..fb4e5a48c 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -113,14 +113,14 @@ bupSplitParams r buprepo k src = do return $ bupParams "split" buprepo (os ++ [Param "-n", Param (bupRef k), src]) -store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> Annex Bool -store r buprepo k _f = do +store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +store r buprepo k _f p = do src <- inRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo k (File src) liftIO $ boolSystem "bup" params -storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool -storeEncrypted r buprepo (cipher, enck) k = do +storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool +storeEncrypted r buprepo (cipher, enck) k p = do src <- inRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo enck (Param "-") liftIO $ catchBoolIO $ diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 0ec564ca1..2bf44634d 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -124,8 +124,8 @@ withCheckedFiles check (Just _) d k a = go $ locations d k withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool withStoredFiles = withCheckedFiles doesFileExist -store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> Annex Bool -store d chunksize k _f = do +store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +store d chunksize k _f p = do src <- inRepo $ gitAnnexLocation k metered k $ \meterupdate -> storeHelper d chunksize k $ \dests -> @@ -139,8 +139,8 @@ store d chunksize k _f = do storeSplit meterupdate chunksize dests =<< L.readFile src -storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> Annex Bool -storeEncrypted d chunksize (cipher, enck) k = do +storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool +storeEncrypted d chunksize (cipher, enck) k p = do src <- inRepo $ gitAnnexLocation k metered k $ \meterupdate -> storeHelper d chunksize enck $ \dests -> diff --git a/Remote/Git.hs b/Remote/Git.hs index 626476c18..46f65ac74 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -262,8 +262,8 @@ copyFromRemoteCheap r key file | otherwise = return False {- Tries to copy a key's content to a remote's annex. -} -copyToRemote :: Git.Repo -> Key -> AssociatedFile -> Annex Bool -copyToRemote r key file +copyToRemote :: Git.Repo -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +copyToRemote r key file p | not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ do keysrc <- inRepo $ gitAnnexLocation key params <- rsyncParams r @@ -276,7 +276,7 @@ copyToRemote r key file download u key file $ Annex.Content.saveState True `after` Annex.Content.getViaTmp key - (rsyncOrCopyFile params keysrc) + (\d -> rsyncOrCopyFile params keysrc d p) ) | Git.repoIsSsh r = commitOnCleanup r $ do keysrc <- inRepo $ gitAnnexLocation key @@ -295,8 +295,8 @@ rsyncHelper p = do {- Copys a file with rsync unless both locations are on the same - filesystem. Then cp could be faster. -} -rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> Annex Bool -rsyncOrCopyFile rsyncparams src dest = +rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> ProgressCallback -> Annex Bool +rsyncOrCopyFile rsyncparams src dest p = ifM (sameDeviceIds src dest) ( liftIO $ copyFileExternal src dest , rsyncHelper $ rsyncparams ++ [Param src, Param dest] diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 6d5405d9e..e3cb40df4 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -45,7 +45,7 @@ encryptionSetup c = case (M.lookup "encryption" c, extractCipher c) of - to support storing and retrieving encrypted content. -} encryptableRemote :: Maybe RemoteConfig - -> ((Cipher, Key) -> Key -> Annex Bool) + -> ((Cipher, Key) -> Key -> ProgressCallback -> Annex Bool) -> ((Cipher, Key) -> Key -> FilePath -> Annex Bool) -> Remote -> Remote @@ -59,9 +59,9 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = cost = cost r + encryptedRemoteCostAdj } where - store k f = cip k >>= maybe - (storeKey r k f) - (`storeKeyEncrypted` k) + store k f p = cip k >>= maybe + (storeKey r k f p) + (\enck -> storeKeyEncrypted enck k p) retrieve k f d = cip k >>= maybe (retrieveKeyFile r k f d) (\enck -> retrieveKeyFileEncrypted enck k d) diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 0a6b22081..eb788bc3e 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -27,7 +27,7 @@ addHooks' r Nothing Nothing = r addHooks' r starthook stophook = r' where r' = r - { storeKey = \k f -> wrapper $ storeKey r k f + { storeKey = \k f p -> wrapper $ storeKey r k f p , retrieveKeyFile = \k f d -> wrapper $ retrieveKeyFile r k f d , retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f , removeKey = \k -> wrapper $ removeKey r k diff --git a/Remote/Hook.hs b/Remote/Hook.hs index c73a8deb8..cf0425590 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -103,13 +103,13 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h return False ) -store :: String -> Key -> AssociatedFile -> Annex Bool -store h k _f = do +store :: String -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +store h k _f _p = do src <- inRepo $ gitAnnexLocation k runHook h "store" k (Just src) $ return True -storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool -storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do +storeEncrypted :: String -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool +storeEncrypted h (cipher, enck) k _p = withTmp enck $ \tmp -> do src <- inRepo $ gitAnnexLocation k liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp runHook h "store" enck (Just tmp) $ return True diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 3655ce483..aba427d4b 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -104,11 +104,11 @@ rsyncUrls o k = map use annexHashes use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f) f = keyFile k -store :: RsyncOpts -> Key -> AssociatedFile -> Annex Bool -store o k _f = rsyncSend o k <=< inRepo $ gitAnnexLocation k +store :: RsyncOpts -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +store o k _f p = rsyncSend o k <=< inRepo $ gitAnnexLocation k -storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool -storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do +storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool +storeEncrypted o (cipher, enck) k p = withTmp enck $ \tmp -> do src <- inRepo $ gitAnnexLocation k liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp rsyncSend o enck tmp diff --git a/Remote/S3.hs b/Remote/S3.hs index 4efdb3071..12eb96add 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -115,14 +115,14 @@ s3Setup u c = handlehost $ M.lookup "host" c -- be human-readable M.delete "bucket" defaults -store :: Remote -> Key -> AssociatedFile -> Annex Bool -store r k _f = s3Action r False $ \(conn, bucket) -> do +store :: Remote -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +store r k _f p = s3Action r False $ \(conn, bucket) -> do dest <- inRepo $ gitAnnexLocation k res <- liftIO $ storeHelper (conn, bucket) r k dest s3Bool res -storeEncrypted :: Remote -> (Cipher, Key) -> Key -> Annex Bool -storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) -> +storeEncrypted :: Remote -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool +storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) -> -- To get file size of the encrypted content, have to use a temp file. -- (An alternative would be chunking to to a constant size.) withTmp enck $ \tmp -> do diff --git a/Remote/Web.hs b/Remote/Web.hs index 2001e6ce8..58d95f7f1 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -66,8 +66,8 @@ downloadKey key _file dest = get =<< getUrls key downloadKeyCheap :: Key -> FilePath -> Annex Bool downloadKeyCheap _ _ = return False -uploadKey :: Key -> AssociatedFile -> Annex Bool -uploadKey _ _ = do +uploadKey :: Key -> AssociatedFile -> ProgressCallback -> Annex Bool +uploadKey _ _ _ = do warning "upload to web not supported" return False |