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.

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 serial adir _k old new = liftIO $ adbShellBool serial
-	[Param "mv", Param "-f", File oldloc, File newloc]
+renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+renameExportM serial adir _k old new = liftIO $ Just <$> 
+	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 d _k oldloc newloc = liftIO $ catchBoolIO $ do
-	createDirectoryIfMissing True (takeDirectory dest)
-	renameFile src dest
-	removeExportLocation d oldloc
-	return True
+renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+renameExportM d _k oldloc newloc = liftIO $ Just <$> go
   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 k src dest = safely $
+renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+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
-		UNSUPPORTED_REQUEST -> result False
+			| k' == k -> result (Just 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 _ _ _ _ = return False
+renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+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 hv r info k src dest = withS3Handle hv $ \case
-	Just h -> checkVersioning info (uuid r) k $ 
-		catchNonAsync (go h) (\_ -> return False)
-	Nothing -> do 
-		warning $ needS3Creds (uuid r)
-		return False
+renameExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+renameExportS3 hv r info k src dest = Just <$> go
   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
-			| otherwise -> runExport (Just h) $ \dav -> do
-				maybe noop (void . mkColRecursive) (locationParent destl)
-				moveDAV (baseURL dav) srcl destl
-				return True
-		Nothing -> return False
-	_ -> return False
+			| boxComUrl `isPrefixOf` baseURL h -> return Nothing
+			| otherwise -> do
+				v <- runExport (Just h) $ \dav -> do
+					maybe noop (void . mkColRecursive) (locationParent destl)
+					moveDAV (baseURL dav) srcl destl
+					return True
+				return (Just v)
+		Nothing -> return (Just False)
+	_ -> return (Just False)
 
 runExport :: Maybe DavHandle -> (DavHandle -> DAVT IO Bool) -> Annex Bool
 runExport Nothing _ = return False