summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-04-14 16:35:10 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-04-14 16:35:10 -0400
commitefec2521cc14b3dec895066c9e7c16e740ab12ec (patch)
treeb60412fe4c371871f334e33bbb5e3f52b1ba0945 /Remote
parentdc367b090adec9f2fc5f37cba5e9b5d5f2decbce (diff)
add filename to progress bar, and display ok/failed at end
This needed plumbing an AssociatedFile through retrieveKeyFileCheap.
Diffstat (limited to 'Remote')
-rw-r--r--Remote/BitTorrent.hs4
-rw-r--r--Remote/Bup.hs4
-rw-r--r--Remote/Ddar.hs4
-rw-r--r--Remote/Directory.hs10
-rw-r--r--Remote/External.hs2
-rw-r--r--Remote/GCrypt.hs2
-rw-r--r--Remote/Git.hs13
-rw-r--r--Remote/Glacier.hs4
-rw-r--r--Remote/Helper/Hooks.hs2
-rw-r--r--Remote/Helper/Special.hs20
-rw-r--r--Remote/Hook.hs4
-rw-r--r--Remote/Rsync.hs4
-rw-r--r--Remote/S3.hs4
-rw-r--r--Remote/Tahoe.hs2
-rw-r--r--Remote/Web.hs4
-rw-r--r--Remote/WebDAV.hs4
16 files changed, 44 insertions, 43 deletions
diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index baba2e23e..05326e390 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -93,8 +93,8 @@ downloadKey key _file dest p =
, return False
)
-downloadKeyCheap :: Key -> FilePath -> Annex Bool
-downloadKeyCheap _ _ = return False
+downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+downloadKeyCheap _ _ _ = return False
uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
uploadKey _ _ _ = do
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 42f17e921..b3152afcf 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -148,8 +148,8 @@ retrieve buprepo = byteRetriever $ \k sink -> do
liftIO (hClose h >> forceSuccessProcess p pid)
`after` (sink =<< liftIO (L.hGetContents h))
-retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
+retrieveCheap :: BupRepo -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ _ = return False
{- Cannot revert having stored a key in bup, but at least the data for the
- key will be used for deltaing data of other keys stored later.
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 7495fcd42..a24960935 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -142,8 +142,8 @@ retrieve ddarrepo = byteRetriever $ \k sink -> do
liftIO (hClose h >> forceSuccessProcess p pid)
`after` (sink =<< liftIO (L.hGetContents h))
-retrieveCheap :: Key -> FilePath -> Annex Bool
-retrieveCheap _ _ = return False
+retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
remove :: DdarRepo -> Remover
remove ddarrepo key = do
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 2eeb79317..f210f557d 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -156,17 +156,17 @@ retrieve d (LegacyChunks _) = Legacy.retrieve locations d
retrieve d _ = simplyPrepare $ byteRetriever $ \k sink ->
sink =<< liftIO (L.readFile =<< getLocation d k)
-retrieveCheap :: FilePath -> ChunkConfig -> Key -> FilePath -> Annex Bool
+retrieveCheap :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Annex Bool
-- no cheap retrieval possible for chunks
-retrieveCheap _ (UnpaddedChunks _) _ _ = return False
-retrieveCheap _ (LegacyChunks _) _ _ = return False
+retrieveCheap _ (UnpaddedChunks _) _ _ _ = return False
+retrieveCheap _ (LegacyChunks _) _ _ _ = return False
#ifndef mingw32_HOST_OS
-retrieveCheap d NoChunks k f = liftIO $ catchBoolIO $ do
+retrieveCheap d NoChunks k _af f = liftIO $ catchBoolIO $ do
file <- getLocation d k
createSymbolicLink file f
return True
#else
-retrieveCheap _ _ _ _ = return False
+retrieveCheap _ _ _ _ _ = return False
#endif
remove :: FilePath -> Remover
diff --git a/Remote/External.hs b/Remote/External.hs
index adfd79113..d09e1f9b3 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -56,7 +56,7 @@ gen r u c gc = do
, name = Git.repoDescribe r
, storeKey = storeKeyDummy
, retrieveKeyFile = retreiveKeyFileDummy
- , retrieveKeyFileCheap = \_ _ -> return False
+ , retrieveKeyFileCheap = \_ _ _ -> return False
, removeKey = removeKeyDummy
, checkPresent = checkPresentDummy
, checkPresentCheap = False
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index c27519825..7685418b0 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -108,7 +108,7 @@ gen' r u c gc = do
, name = Git.repoDescribe r
, storeKey = storeKeyDummy
, retrieveKeyFile = retreiveKeyFileDummy
- , retrieveKeyFileCheap = \_ _ -> return False
+ , retrieveKeyFileCheap = \_ _ _ -> return False
, removeKey = removeKeyDummy
, checkPresent = checkPresentDummy
, checkPresentCheap = repoCheap r
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 373299c2d..2807c62fb 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -355,7 +355,7 @@ dropKey r key
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
-copyFromRemote r key file dest p = parallelMetered (Just p) key $
+copyFromRemote r key file dest p = parallelMetered (Just p) key file $
copyFromRemote' r key file dest
copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
@@ -447,26 +447,27 @@ copyFromRemote' r key file dest meterupdate
=<< tryTakeMVar pidv
bracketIO noop (const cleanup) (const $ a feeder)
-copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool
+copyFromRemoteCheap :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
#ifndef mingw32_HOST_OS
-copyFromRemoteCheap r key file
+copyFromRemoteCheap r key af file
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $ do
loc <- liftIO $ gitAnnexLocation key (repo r) $
fromJust $ remoteGitConfig $ gitconfig r
liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
| Git.repoIsSsh (repo r) =
ifM (Annex.Content.preseedTmp key file)
- ( parallelMetered Nothing key $ copyFromRemote' r key Nothing file
+ ( parallelMetered Nothing key af $
+ copyFromRemote' r key af file
, return False
)
| otherwise = return False
#else
-copyFromRemoteCheap _ _ _ = return False
+copyFromRemoteCheap _ _ _ _ = return False
#endif
{- Tries to copy a key's content to a remote's annex. -}
copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-copyToRemote r key file p = parallelMetered (Just p) key $ copyToRemote' r key file
+copyToRemote r key file p = parallelMetered (Just p) key file $ copyToRemote' r key file
copyToRemote' :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
copyToRemote' r key file p
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 289008266..75b264bac 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -162,8 +162,8 @@ retrieve r k sink = go =<< glacierEnv c u
showLongNote "Recommend you wait up to 4 hours, and then run this command again."
return ok
-retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
+retrieveCheap :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ _ = return False
remove :: Remote -> Remover
remove r k = glacierAction r
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index 3765281be..53bb370a6 100644
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -36,7 +36,7 @@ addHooks' r starthook stophook = r'
r' = r
{ storeKey = \k f p -> wrapper $ storeKey r k f p
, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p
- , retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
+ , retrieveKeyFileCheap = \k af f -> wrapper $ retrieveKeyFileCheap r k af f
, removeKey = wrapper . removeKey r
, checkPresent = wrapper . checkPresent r
}
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 696a43a7a..c11584bb8 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -157,10 +157,10 @@ specialRemote' :: SpecialRemoteCfg -> RemoteModifier
specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckpresent baser = encr
where
encr = baser
- { storeKey = \k _f p -> cip >>= storeKeyGen k p
- , retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
- , retrieveKeyFileCheap = \k d -> cip >>= maybe
- (retrieveKeyFileCheap baser k d)
+ { storeKey = \k f p -> cip >>= storeKeyGen k f p
+ , retrieveKeyFile = \k f d p -> cip >>= retrieveKeyFileGen k f d p
+ , retrieveKeyFileCheap = \k f d -> cip >>= maybe
+ (retrieveKeyFileCheap baser k f d)
-- retrieval of encrypted keys is never cheap
(\_ -> return False)
, removeKey = \k -> cip >>= removeKeyGen k
@@ -182,10 +182,10 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
safely a = catchNonAsync a (\e -> warning (show e) >> return False)
-- chunk, then encrypt, then feed to the storer
- storeKeyGen k p enc = safely $ preparestorer k $ safely . go
+ storeKeyGen k f p enc = safely $ preparestorer k $ safely . go
where
go (Just storer) = sendAnnex k rollback $ \src ->
- displayprogress p k $ \p' ->
+ displayprogress p k f $ \p' ->
storeChunks (uuid baser) chunkconfig k src p'
(storechunk enc storer)
(checkPresent baser)
@@ -200,10 +200,10 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
storer (enck k) (ByteContent encb) p
-- call retrieve-r to get chunks; decrypt them; stream to dest file
- retrieveKeyFileGen k dest p enc =
+ retrieveKeyFileGen k f dest p enc =
safely $ prepareretriever k $ safely . go
where
- go (Just retriever) = displayprogress p k $ \p' ->
+ go (Just retriever) = displayprogress p k f $ \p' ->
retrieveChunks retriever (uuid baser) chunkconfig
enck k dest p' (sink dest enc)
go Nothing = return False
@@ -223,8 +223,8 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
chunkconfig = chunkConfig cfg
- displayprogress p k a
- | displayProgress cfg = metered (Just p) k a
+ displayprogress p k f a
+ | displayProgress cfg = metered (Just p) k f a
| otherwise = a p
{- Sink callback for retrieveChunks. Stores the file content into the
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 6df326295..9abc4e303 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -130,8 +130,8 @@ retrieve h = fileRetriever $ \d k _p ->
unlessM (runHook h "retrieve" k (Just d) $ return True) $
error "failed to retrieve content"
-retrieveCheap :: HookName -> Key -> FilePath -> Annex Bool
-retrieveCheap _ _ _ = return False
+retrieveCheap :: HookName -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ _ = return False
remove :: HookName -> Remover
remove h k = runHook h "remove" k Nothing $ return True
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index a882e081d..2c8b17884 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -191,8 +191,8 @@ retrieve o f k p =
unlessM (rsyncRetrieve o k f (Just p)) $
error "rsync failed"
-retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool
-retrieveCheap o k f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False )
+retrieveCheap :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap o k _af f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False )
remove :: RsyncOpts -> Remover
remove o k = do
diff --git a/Remote/S3.hs b/Remote/S3.hs
index b0c1de114..83d35035e 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -241,8 +241,8 @@ retrieve h = fileRetriever $ \f k p -> liftIO $ runResourceT $ do
S.hPut fh bs
sinkprogressfile fh meterupdate sofar'
-retrieveCheap :: Key -> FilePath -> Annex Bool
-retrieveCheap _ _ = return False
+retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
{- Internet Archive doesn't easily allow removing content.
- While it may remove the file, there are generally other files
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index 56bf66427..ca822d4fd 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -70,7 +70,7 @@ gen r u c gc = do
, name = Git.repoDescribe r
, storeKey = store u hdl
, retrieveKeyFile = retrieve u hdl
- , retrieveKeyFileCheap = \_ _ -> return False
+ , retrieveKeyFileCheap = \_ _ _ -> return False
, removeKey = remove
, checkPresent = checkKey u hdl
, checkPresentCheap = False
diff --git a/Remote/Web.hs b/Remote/Web.hs
index a4a484ca3..102972b02 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -90,8 +90,8 @@ downloadKey key _file dest _p = get =<< getWebUrls key
#endif
_ -> downloadUrl [u'] dest
-downloadKeyCheap :: Key -> FilePath -> Annex Bool
-downloadKeyCheap _ _ = return False
+downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+downloadKeyCheap _ _ _ = return False
uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
uploadKey _ _ _ = do
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index aaebecf41..3c414f003 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -116,8 +116,8 @@ finalizeStore baseurl tmp dest = do
maybe noop (void . mkColRecursive) (locationParent dest)
moveDAV baseurl tmp dest
-retrieveCheap :: Key -> FilePath -> Annex Bool
-retrieveCheap _ _ = return False
+retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveCheap _ _ _ = return False
retrieve :: ChunkConfig -> Maybe DavHandle -> Retriever
retrieve _ Nothing = error "unable to connect"