better indicate when special remotes do not support renameExport

Avoid a warning message when renameExport is not supported, and just
fallback to deleting with a subsequent re-upload. Especially needed for
importtree remotes, where renameExport needs to be disabled.

This changes the external special remote protocol, but in a
backwards-compatible way. A reply of UNSUPPORTED-REQUEST to an older
version of git-annex will cause it to make renameExport return False.

Command/Export.hs

@@ -379,15 +379,16 @@ startMoveFromTempName r db ek f = do
 	f' = getTopFilePath f
 
 performRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform
-performRename r db ek src dest = do
+performRename r db ek src dest =
-	ifM (renameExport (exportActions r) (asKey ek) src dest)
+	renameExport (exportActions r) (asKey ek) src dest >>= \case
-		( next $ cleanupRename r db ek src dest
+		Just True -> next $ cleanupRename r db ek src dest
-		-- In case the special remote does not support renaming,
+		Just False -> do
-		-- unexport the src instead.
-		, do
 			warning "rename failed; deleting instead"
-			performUnexport r db [ek] src
+			fallbackdelete
-		)
+		-- Remote does not support renaming, so don't warn about it.
+		Nothing -> fallbackdelete
+  where
+	fallbackdelete = performUnexport r db [ek] src
 
 cleanupRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandCleanup
 cleanupRename r db ek src dest = do

Remote/Adb.hs

@@ -222,9 +222,9 @@ checkPresentExportM r serial adir _k loc = checkKey' r serial aloc
   where
 	aloc = androidExportLocation adir loc
 
-renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
-renameExportM serial adir _k old new = liftIO $ adbShellBool serial
+renameExportM serial adir _k old new = liftIO $ Just <$> 
-	[Param "mv", Param "-f", File oldloc, File newloc]
+	adbShellBool serial [Param "mv", Param "-f", File oldloc, File newloc]
   where
 	oldloc = fromAndroidPath $ androidExportLocation adir old
 	newloc = fromAndroidPath $ androidExportLocation adir new

Remote/Directory.hs

@@ -279,13 +279,15 @@ checkPresentExportM :: FilePath -> Key -> ExportLocation -> Annex Bool
 checkPresentExportM d _k loc =
 	checkPresentGeneric d [exportPath d loc]
 
-renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
-renameExportM d _k oldloc newloc = liftIO $ catchBoolIO $ do
+renameExportM d _k oldloc newloc = liftIO $ Just <$> go
-	createDirectoryIfMissing True (takeDirectory dest)
-	renameFile src dest
-	removeExportLocation d oldloc
-	return True
   where
+	go = catchBoolIO $ do
+		createDirectoryIfMissing True (takeDirectory dest)
+		renameFile src dest
+		removeExportLocation d oldloc
+		return True
+	
 	src = exportPath d oldloc
 	dest = exportPath d newloc
 

Remote/External.hs

@@ -307,25 +307,28 @@ removeExportDirectoryM external dir = safely $
   where
 	req = REMOVEEXPORTDIRECTORY dir
 
-renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
-renameExportM external k src dest = safely $
+renameExportM external k src dest = safely' (Just False) $
 	handleRequestExport external src req k Nothing $ \resp -> case resp of
 		RENAMEEXPORT_SUCCESS k'
-			| k' == k -> result True
+			| k' == k -> result (Just True)
 		RENAMEEXPORT_FAILURE k' 
-			| k' == k -> result False
+			| k' == k -> result (Just False)
-		UNSUPPORTED_REQUEST -> result False
+		UNSUPPORTED_REQUEST -> result Nothing
 		_ -> Nothing
   where
 	req sk = RENAMEEXPORT sk dest
 
 safely :: Annex Bool -> Annex Bool
-safely a = go =<< tryNonAsync a
+safely = safely' False
+
+safely' :: a -> Annex a -> Annex a
+safely' onerr a = go =<< tryNonAsync a
   where
 	go (Right r) = return r
 	go (Left e) = do
 		toplevelWarning False (show e)
-		return False
+		return onerr
 
 {- Sends a Request to the external remote, and waits for it to generate
  - a Response. That is fed into the responsehandler, which should return

Remote/Helper/ExportImport.hs

@@ -43,7 +43,7 @@ instance HasExportUnsupported (ExportActions Annex) where
 		, checkPresentExport = \_ _ -> return False
 		, removeExport = \_ _ -> return False
 		, removeExportDirectory = Just $ \_ -> return False
-		, renameExport = \_ _ _ -> return False
+		, renameExport = \_ _ _ -> return Nothing
 		}
 
 -- | Use for remotes that do not support imports.
@@ -170,7 +170,7 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 				-- lose modifications to the file
 				-- (by eg copying and then deleting)
 				-- so don't use it
-				, renameExport = \_ _ _ -> return False
+				, renameExport = \_ _ _ -> return Nothing
 				, checkPresentExport = checkpresent
 				}
 			, checkPresent = if appendonly r'

Remote/Rsync.hs

@@ -293,8 +293,8 @@ removeExportDirectoryM o ed = removeGeneric o (allbelow d : includes d)
 		Nothing -> []
 		Just f' -> includes f'
 
-renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
-renameExportM _ _ _ _ = return False
+renameExportM _ _ _ _ = return Nothing
 
 {- Rsync params to enable resumes of sending files safely,
  - ensure that files are only moved into place once complete

Remote/S3.hs

@@ -398,15 +398,17 @@ checkPresentExportS3 hv r info k loc = withS3Handle hv $ \case
 			giveup "No S3 credentials configured"
 
 -- S3 has no move primitive; copy and delete.
-renameExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
-renameExportS3 hv r info k src dest = withS3Handle hv $ \case
+renameExportS3 hv r info k src dest = Just <$> go
-	Just h -> checkVersioning info (uuid r) k $ 
-		catchNonAsync (go h) (\_ -> return False)
-	Nothing -> do 
-		warning $ needS3Creds (uuid r)
-		return False
   where
-	go h = liftIO $ runResourceT $ do
+	go = withS3Handle hv $ \case
+		Just h -> checkVersioning info (uuid r) k $ 
+			catchNonAsync (go' h) (\_ -> return False)
+		Nothing -> do 
+			warning $ needS3Creds (uuid r)
+			return False
+	
+	go' h = liftIO $ runResourceT $ do
 		let co = S3.copyObject (bucket info) dstobject
 			(S3.ObjectId (bucket info) srcobject Nothing)
 			S3.CopyMetadata
@@ -414,6 +416,7 @@ renameExportS3 hv r info k src dest = withS3Handle hv $ \case
 		void $ sendS3Handle h $ co { S3.coAcl = acl info }
 		void $ sendS3Handle h $ S3.DeleteObject srcobject (bucket info)
 		return True
+	
 	srcobject = T.pack $ bucketExportLocation info src
 	dstobject = T.pack $ bucketExportLocation info dest
 

Remote/WebDAV.hs

@@ -239,19 +239,21 @@ removeExportDirectoryDav r dir = withDAVHandle r $ \mh -> runExport mh $ \_dav -
 	safely (inLocation d delContentM)
 		>>= maybe (return False) (const $ return True)
 
-renameExportDav :: Remote -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportDav :: Remote -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
 renameExportDav r _k src dest = case (exportLocation src, exportLocation dest) of
 	(Right srcl, Right destl) -> withDAVHandle r $ \case
 		Just h
 			-- box.com's DAV endpoint has buggy handling of renames,
 			-- so avoid renaming when using it.
-			| boxComUrl `isPrefixOf` baseURL h -> return False
+			| boxComUrl `isPrefixOf` baseURL h -> return Nothing
-			| otherwise -> runExport (Just h) $ \dav -> do
+			| otherwise -> do
-				maybe noop (void . mkColRecursive) (locationParent destl)
+				v <- runExport (Just h) $ \dav -> do
-				moveDAV (baseURL dav) srcl destl
+					maybe noop (void . mkColRecursive) (locationParent destl)
-				return True
+					moveDAV (baseURL dav) srcl destl
-		Nothing -> return False
+					return True
-	_ -> return False
+				return (Just v)
+		Nothing -> return (Just False)
+	_ -> return (Just False)
 
 runExport :: Maybe DavHandle -> (DavHandle -> DAVT IO Bool) -> Annex Bool
 runExport Nothing _ = return False

Types/Remote.hs

@@ -242,9 +242,9 @@ data ExportActions a = ExportActions
 	-- Throws an exception if the remote cannot be accessed.
 	, checkPresentExport :: Key -> ExportLocation -> a Bool
 	-- Renames an already exported file.
-	-- This may fail, if the file doesn't exist, or the remote does not
+	-- This may fail with False, if the file doesn't exist.
-	-- support renames.
+	-- If the remote does not support renames, it can return Nothing.
-	, renameExport :: Key -> ExportLocation -> ExportLocation -> a Bool
+	, renameExport :: Key -> ExportLocation -> ExportLocation -> a (Maybe Bool)
 	}
 
 data ImportActions a = ImportActions

doc/design/external_special_remote_protocol.mdwn

@@ -211,7 +211,8 @@ replying with `UNSUPPORTED-REQUEST` is acceptable.
   Requests the remote rename a file stored on it from the previously
   provided Name to the NewName.  
   The remote responds with `RENAMEEXPORT-SUCCESS` or
-  `RENAMEEXPORT-FAILURE`.
+  `RENAMEEXPORT-FAILURE` or with `UNSUPPORTED-REQUEST` if renaming is not
+  supported.
 
 To support old external special remote programs that have not been updated
 to support exports, git-annex will need to handle an `ERROR` response
@@ -318,7 +319,8 @@ while it's handling a request.
 * `REMOVEEXPORTDIRECTORY-FAILURE`  
   Indicates that a `REMOVEEXPORTDIRECTORY` failed for whatever reason.
 * `UNSUPPORTED-REQUEST`  
-  Indicates that the special remote does not know how to handle a request.
+  Indicates that the special remote does not know how to handle a request,
+  or cannot handle the request.
 
 ## special remote messages
 

doc/todo/import_tree.mdwn

@@ -10,10 +10,6 @@ this.
 
 ## implementation notes
 
-* renameExport is disabled in a way that makes export tree
-  complain unncessarily verbosely. Perhaps change renameExport
-  to a Maybe so it can know when it's not available.
-
 * Does export of master:subdir update the remote tracking branch right?
 
 * Does sync --content with remote.name.annex-tracking-branch=master:subdir