better dup key with -J fix

This avoids all the complication about redundant work discussed in
the previous try at fixing this. At the expense of needing each command
that could have the problem to be patched to simply wrap the action in
onlyActionOn once the key is known. But there do not seem to be many
such commands.

onlyActionOn' should not be used with a CommandStart (or CommandPerform),
although the types do allow it. onlyActionOn handles running the whole
CommandStart chain. I couldn't immediately see a way to avoid mistken
use of onlyActionOn'.

This commit was supported by the NSF-funded DataLad project.

4 files changed, 11 insertions, 15 deletions

diff --git a/Command/Get.hs b/Command/Get.hs
index e91798eba..a412b2cb3 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -62,8 +62,8 @@ startKeys from key ai = checkFailedTransferDirection ai Download $
 	start' (return True) from key (AssociatedFile Nothing) ai
 
 start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
-start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $
-	stopUnless expensivecheck $
+start' expensivecheck from key afile ai = onlyActionOn key $
+	stopUnless (not <$> inAnnex key) $ stopUnless expensivecheck $
 		case from of
 			Nothing -> go $ perform key afile
 			Just src ->
@@ -109,10 +109,9 @@ getKey' key afile = dispatch
 		| Remote.hasKeyCheap r =
 			either (const False) id <$> Remote.hasKey r key
 		| otherwise = return True
-	docopy r = download (Remote.uuid r) key afile forwardRetry $ \p ->
-		ifM (inAnnex key)
-			( return True
-			, getViaTmp (RemoteVerify r) key $ \dest -> do
+	docopy r witness = getViaTmp (RemoteVerify r) key $ \dest ->
+		download (Remote.uuid r) key afile forwardRetry
+			(\p -> do
 				showAction $ "from " ++ Remote.name r
 				Remote.retrieveKeyFile r key afile dest p
-			)
+			) witness
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index a8f4307a2..941e397a4 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -53,7 +53,7 @@ start o file k = startKey o afile k (mkActionItem afile)
 	afile = AssociatedFile (Just file)
 
 startKey :: MirrorOptions -> AssociatedFile -> Key -> ActionItem -> CommandStart
-startKey o afile key ai = case fromToOptions o of
+startKey o afile key ai = onlyActionOn key $ case fromToOptions o of
 	ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
 		( Command.Move.toStart False afile key ai =<< getParsed r
 		, do
diff --git a/Command/Move.hs b/Command/Move.hs
index 9e6c03e3b..04e6aa384 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -74,7 +74,7 @@ startKey :: MoveOptions -> Bool -> Key -> ActionItem -> CommandStart
 startKey o move = start' o move (AssociatedFile Nothing)
 
 start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
-start' o move afile key ai = 
+start' o move afile key ai = onlyActionOn key $
 	case fromToOptions o of
 		Right (FromRemote src) ->
 			checkFailedTransferDirection ai Download $
@@ -200,11 +200,8 @@ fromPerform src move key afile = do
   where
 	go = notifyTransfer Download afile $ 
 		download (Remote.uuid src) key afile forwardRetry $ \p ->
-			ifM (inAnnex key)
-				( return True
-				, getViaTmp (RemoteVerify src) key $ \t ->
-					Remote.retrieveKeyFile src key afile t p
-				)
+			getViaTmp (RemoteVerify src) key $ \t ->
+				Remote.retrieveKeyFile src key afile t p
 	dispatch _ False = stop -- failed
 	dispatch False True = next $ return True -- copy complete
 	-- Finish by dropping from remote, taking care to verify that
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 1bd8e623c..b2d0bd275 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -609,7 +609,7 @@ seekSyncContent o rs = do
  - Returns True if any file transfers were made.
  -}
 syncFile :: Either (Maybe (Bloom Key)) (Key -> Annex ()) -> [Remote] -> AssociatedFile -> Key -> Annex Bool
-syncFile ebloom rs af k = do
+syncFile ebloom rs af k = onlyActionOn' k $ do
 	locs <- Remote.keyLocations k
 	let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs