move: Avoid drops that make bad situations worse, but otherwise allow

See the big comment at the bottom of Command.Drop for the full details.

(The --safe/--unsafe options were never released.)

This commit was sponsored by Jake Vosloo on Patreon.

CHANGELOG

@@ -1,8 +1,12 @@
 git-annex (6.20180410) UNRELEASED; urgency=medium
 
-  * move: Added --safe option, which makes move honor numcopies settings.
+  * move: Now takes numcopies configuration, and required content
-    Also --unsafe enables the default behavior, anticipating that the
+    configuration into account, and refuses to reduce the current
-    default may one day change.
+    number of copies of a file, or remove content that a repository
+    requires. --force can override these checks.
+    Note that it's still allowed to move the content of a file
+    from one repository to another when numcopies is not satisfied, as long
+    as the move does not result in there being fewer copies.
 
  -- Joey Hess <id@joeyh.name>  Mon, 09 Apr 2018 14:03:28 -0400
 

Command/Move.hs

@@ -15,6 +15,7 @@ import qualified Remote
 import Annex.UUID
 import Annex.Transfer
 import Logs.Presence
+import Logs.Trust
 import Annex.NumCopies
 
 import System.Log.Logger (debugM)
@@ -28,7 +29,7 @@ cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMat
 data MoveOptions = MoveOptions
 	{ moveFiles :: CmdParams
 	, fromToOptions :: FromToHereOptions
-	, removeWhenOptions :: RemoveWhen
+	, removeWhen :: RemoveWhen
 	, keyOptions :: Maybe KeyOptions
 	, batchOption :: BatchMode
 	}
@@ -37,7 +38,7 @@ optParser :: CmdParamsDesc -> Parser MoveOptions
 optParser desc = MoveOptions
 	<$> cmdParams desc
 	<*> parseFromToHereOptions
-	<*> parseRemoveWhenOptions
+	<*> pure RemoveSafe
 	<*> optional (parseKeyOptions <|> parseFailedTransfersOption)
 	<*> parseBatchOption
 
@@ -45,34 +46,20 @@ instance DeferredParseClass MoveOptions where
 	finishParse v = MoveOptions
 		<$> pure (moveFiles v)
 		<*> finishParse (fromToOptions v)
-		<*> pure (removeWhenOptions v)
+		<*> pure (removeWhen v)
 		<*> pure (keyOptions v)
 		<*> pure (batchOption v)
 
-data RemoveWhen = RemoveSafe | RemoveUnsafe | RemoveNever
+data RemoveWhen = RemoveSafe | RemoveNever
 	deriving (Show, Eq)
 
-parseRemoveWhenOptions :: Parser RemoveWhen
-parseRemoveWhenOptions = 
-	flag' RemoveSafe
-		( long "safe"
-		<> short 's'
-		<> help "preserve numcopies"
-		)
-	<|> flag' RemoveUnsafe
-		(long "unsafe"
-		<> short 'u'
-		<> help "do not preserve numcopies (default)"
-		)
-	<|> pure RemoveUnsafe
-
 seek :: MoveOptions -> CommandSeek
 seek o = allowConcurrentOutput $ do
-	let go = whenAnnexed $ start (fromToOptions o) (removeWhenOptions o)
+	let go = whenAnnexed $ start (fromToOptions o) (removeWhen o)
 	case batchOption o of
 		Batch -> batchInput Right (batchCommandAction . go)
 		NoBatch -> withKeyOptions (keyOptions o) False
-			(startKey (fromToOptions o) (removeWhenOptions o))
+			(startKey (fromToOptions o) (removeWhen o))
 			(withFilesInGit go)
 			=<< workTreeItems (moveFiles o)
 
@@ -141,60 +128,58 @@ toPerform dest removewhen key afile fastcheck isthere =
 				upload (Remote.uuid dest) key afile stdRetry $
 					Remote.storeKey dest key afile
 			if ok
-				then finish $
+				then finish False $
 					Remote.logStatus dest key InfoPresent
 				else do
 					when fastcheck $
 						warning "This could have failed because --fast is enabled."
 					stop
-		Right True -> finish $
+		Right True -> finish True $
 			unlessM (expectedPresent dest key) $
 				Remote.logStatus dest key InfoPresent
   where
-	finish :: Annex () -> CommandPerform
+	finish deststartedwithcopy setpresentremote = case removewhen of
-	finish setpresentremote = case removewhen of
 		RemoveNever -> do
 			setpresentremote
 			next $ return True
-		_ -> lockContentForRemoval key $ \contentlock -> do
+		RemoveSafe -> lockContentForRemoval key $ \contentlock -> do
-			numcopies <- case removewhen of
+			srcuuid <- getUUID
-				RemoveUnsafe -> pure (NumCopies 1)
+			let destuuid = Remote.uuid dest
-				_ -> getAssociatedFileNumCopies afile
+			willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
-			u <- getUUID
+				DropAllowed -> drophere setpresentremote contentlock "moved"
-			let drophere proof = do
+				DropCheckNumCopies -> do
-				liftIO $ debugM "drop" $ unwords
+					numcopies <- getAssociatedFileNumCopies afile
-					[ "Dropping from here"
+					(tocheck, verified) <- verifiableCopies key [srcuuid]
-					, "proof:"
+					verifyEnoughCopiesToDrop "" key (Just contentlock)
-					, show proof
+						 numcopies [srcuuid] verified
-					]
+						 (UnVerifiedRemote dest : tocheck)
-				-- Drop content before updating location logs,
+						 (drophere setpresentremote contentlock . showproof)
-				-- in case disk space is very low this frees
+						 (faileddrophere setpresentremote)
-				-- up space before writing data to disk.
+				DropWorse -> faileddrophere setpresentremote
-				removeAnnex contentlock
+	showproof proof = "proof: " ++ show proof
-				next $ do
+	drophere setpresentremote contentlock reason = do
-					setpresentremote
+		liftIO $ debugM "move" $ unwords
-					Command.Drop.cleanupLocal key
+			[ "Dropping from here"
-			let faileddrophere = do
+			, "(" ++ reason ++ ")"
-				warning "Not enough copies exist to drop from here (use --unsafe to avoid this check)"
+			]
-				next $ do
+		-- Drop content before updating location logs,
-					setpresentremote
+		-- in case disk space is very low this frees
-					return True
+		-- up space before writing data to disk.
-			(tocheck, verified) <- verifiableCopies key [u]
+		removeAnnex contentlock
-			verifyEnoughCopiesToDrop "" key (Just contentlock)
+		next $ do
-				 numcopies [] verified
+			() <- setpresentremote
-				 (UnVerifiedRemote dest : tocheck)
+			Command.Drop.cleanupLocal key
-				 drophere faileddrophere
+	faileddrophere setpresentremote = do
+		showLongNote "(Use --force to override this check, or adjust numcopies.)"
+		showLongNote "Content not dropped from here."
+		next $ do
+			() <- setpresentremote
+			return False
 
-{- Moves (or copies) the content of an annexed file from a remote
- - to the current repository.
- -
- - If the current repository already has the content, it is still removed
- - from the remote.
- -}
 fromStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
-fromStart removewhen afile key ai src
+fromStart removewhen afile key ai src = case removewhen of
-	| removewhen == RemoveNever = stopUnless (not <$> inAnnex key) go
+	RemoveNever -> stopUnless (not <$> inAnnex key) go
-	| otherwise = go
+	RemoveSafe -> go
   where
 	go = stopUnless (fromOk src key) $ do
 		showMoveAction removewhen key ai
@@ -218,49 +203,50 @@ fromPerform :: Remote -> RemoveWhen -> Key -> AssociatedFile -> CommandPerform
 fromPerform src removewhen key afile = do
 	showAction $ "from " ++ Remote.name src
 	ifM (inAnnex key)
-		( dispatch removewhen True
+		( dispatch removewhen True True
-		, dispatch removewhen =<< go
+		, dispatch removewhen False =<< go
 		)
   where
 	go = notifyTransfer Download afile $ 
 		download (Remote.uuid src) key afile stdRetry $ \p ->
 			getViaTmp (RemoteVerify src) key $ \t ->
 				Remote.retrieveKeyFile src key afile t p
-	dispatch _ False = stop -- failed
+	dispatch _ _ False = stop -- failed
-	dispatch RemoveNever True = next $ return True -- copy complete
+	dispatch RemoveNever _ True = next $ return True -- copy complete
-	-- Finish move by dropping from remote, when verified 
+	dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do
-	-- numcopies or RemoveUnsafe allows.
+		let srcuuid = Remote.uuid src
-	dispatch _ True = do
+		destuuid <- getUUID
-		numcopies <- case removewhen of
+		willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
-			RemoveUnsafe -> pure (NumCopies 1)
+			DropAllowed -> dropremote "moved"
-			_ -> getAssociatedFileNumCopies afile
+			DropCheckNumCopies -> do
-		(tocheck, verified) <- verifiableCopies key [Remote.uuid src]
+				numcopies <- getAssociatedFileNumCopies afile
-		verifyEnoughCopiesToDrop "" key Nothing numcopies [] verified
+				(tocheck, verified) <- verifiableCopies key [Remote.uuid src]
-			tocheck dropremote faileddropremote
+				verifyEnoughCopiesToDrop "" key Nothing numcopies [Remote.uuid src] verified
-	dropremote proof = do
+					tocheck (dropremote . showproof) faileddropremote
-		liftIO $ debugM "drop" $ unwords
+			DropWorse -> faileddropremote		
+	showproof proof = "proof: " ++ show proof
+	dropremote reason = do
+		liftIO $ debugM "move" $ unwords
 			[ "Dropping from remote"
 			, show src
-			, "proof:"
+			, "(" ++ reason ++ ")"
-			, show proof
 			]
 		ok <- Remote.removeKey src key
 		next $ Command.Drop.cleanupRemote key src ok
-	faileddropremote = case removewhen of
+	faileddropremote = do
-		RemoveUnsafe -> giveup "Unable to drop from remote."
+		showLongNote "(Use --force to override this check, or adjust numcopies.)"
-		RemoveSafe -> do
+		showLongNote $ "Content not dropped from " ++ Remote.name src ++ "."
-			warning "Not enough copies exist to drop from remote (use --unsafe to avoid this check)"
+		next $ return False
-			next $ return True
-		RemoveNever -> next $ return True
 
 {- Moves (or copies) the content of an annexed file from reachable remotes
  - to the current repository.
  -
- - When moving, the content is removed from all the reachable remotes. -}
+ - When moving, the content is removed from all the reachable remotes that
+ - it can safely be removed from. -}
 toHereStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
-toHereStart removewhen afile key ai
+toHereStart removewhen afile key ai = case removewhen of
-	| removewhen == RemoveNever = stopUnless (not <$> inAnnex key) go
+	RemoveNever -> stopUnless (not <$> inAnnex key) go
-	| otherwise = go
+	RemoveSafe -> go
   where
 	go = do
 		rs <- Remote.keyPossibilities key
@@ -269,3 +255,51 @@ toHereStart removewhen afile key ai
 				showMoveAction removewhen key ai
 				next $ fromPerform r removewhen key afile
 		stop
+
+{- The goal of this command is to allow the user maximum freedom to move
+ - files as they like, while avoiding making bad situations any worse
+ - than they already were.
+ -
+ - When the destination repository already had a copy of a file
+ - before the move operation began, dropping it from the source
+ - repository reduces the number of copies, and should fail if
+ - that would violate numcopies settings.
+ -
+ - On the other hand, when the destiation repository does not already
+ - have a copy of a file, it can be dropped without making numcopies
+ - worse, so the move is allowed even if numcopies is not met.
+ -
+ - Similarly, a file can move from an untrusted repository to another
+ - untrusted repository, even if that is the only copy of the file.
+ -
+ - But, moving a file from a repository with higher trust to an untrusted
+ - repository must still check that there are enough other copies to be
+ - safe.
+ -
+ - Also, required content settings should not be violated.
+ -
+ - This function checks all that. It needs to know if the destination
+ - repository already had a copy of the file before the move began.
+ -}
+willDropMakeItWorse :: UUID -> UUID -> Bool -> Key -> AssociatedFile -> Annex DropCheck
+willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile =
+	ifM (Command.Drop.checkRequiredContent srcuuid key afile)
+		( if deststartedwithcopy
+			then unlessforced DropCheckNumCopies
+			else ifM checktrustlevel
+				( return DropAllowed
+				, unlessforced DropCheckNumCopies
+				)
+		, unlessforced DropWorse
+		)
+  where
+	unlessforced r = ifM (Annex.getState Annex.force)
+		( return DropAllowed
+		, return r
+		)
+	checktrustlevel = do
+		desttrust <- lookupTrust destuuid
+		srctrust <- lookupTrust srcuuid
+		return (desttrust <= srctrust || desttrust < UnTrusted)
+
+data DropCheck = DropWorse | DropAllowed | DropCheckNumCopies

doc/bugs/move_violates_numcopies.mdwn

@@ -23,3 +23,5 @@ There could be a transition period where move warns when run w/o
 --safe/--unsafe.
 
 --[[Joey]]
+
+> [[done]], using the "don't make it worse" approach. --[[Joey]]

doc/git-annex-move.mdwn

@@ -10,10 +10,6 @@ git annex move `[path ...] [--from=remote|--to=remote|--to=here]`
 
 Moves the content of files from or to another remote.
 
-Note that by default, this command does not try to preserve the configured
-minimum number of copies of files. It is the only git-annex command to not
-do so.
-
 # OPTIONS
 
 * `--from=remote`
@@ -29,16 +25,15 @@ do so.
   Move the content of files from all reachable remotes to the local
   repository.
 
-* `--safe` `-s`
+* `--force`
 
-  Preserve the configured minimum number of copies of files, by only
+  Override numcopies and required content checking, and always remove
-  dropping content when there are enough other copies, and otherwise
+  files from the source repository once the destination repository has a
-  only copying to the destination.
+  copy.
 
-* `--unsafe` `-u`
+  Note that, even without this option, you can move the content of a file
-
+  from one repository to another when numcopies is not satisfied, as long
-  Do not preserve the configured minimum number of copies of files;
+  as the move does not result in there being fewer copies.
-  always move the content between repositories. Currently the default.
 
 * `--jobs=N` `-JN`