convert renameExport to throw exception

Finishes the transition to make remote methods throw exceptions, rather
than silently hide them.

A bit on the fence about this one, because when renameExport fails,
it falls back to deleting instead, and so does the user care why it failed?

However, it did let me clean up several places in the code.

This commit was sponsored by Ethan Aubin.

Command/Export.hs

@@ -396,13 +396,13 @@ startMoveFromTempName r db ek f = do
 
 performRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform
 performRename r db ek src dest =
-	renameExport (exportActions r) (asKey ek) src dest >>= \case
+	tryNonAsync (renameExport (exportActions r) (asKey ek) src dest) >>= \case
-		Just True -> next $ cleanupRename r db ek src dest
+		Right (Just ()) -> next $ cleanupRename r db ek src dest
-		Just False -> do
+		Left err -> do
-			warning "rename failed; deleting instead"
+			warning $ "rename failed (" ++ show err ++ "); deleting instead"
 			fallbackdelete
-		-- Remote does not support renaming, so don't warn about it.
+		-- remote does not support renaming
-		Nothing -> fallbackdelete
+		Right Nothing -> fallbackdelete
   where
 	fallbackdelete = performUnexport r db [ek] src
 

Remote/Adb.hs

@@ -269,8 +269,11 @@ checkPresentExportM r serial adir _k loc = checkKey' r serial aloc
   where
 	aloc = androidExportLocation adir loc
 
-renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())
-renameExportM serial adir _k old new = Just <$> adbShellBool serial ps
+renameExportM serial adir _k old new = do
+	unlessM (adbShellBool serial ps) $
+		giveup "adb failed"
+	return (Just ())
   where
 	oldloc = fromAndroidPath $ androidExportLocation adir old
 	newloc = fromAndroidPath $ androidExportLocation adir new

Remote/Directory.hs

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

Remote/External.hs

@@ -342,26 +342,18 @@ removeExportDirectoryM external dir = either giveup return =<< go
 		_ -> Nothing
 	req = REMOVEEXPORTDIRECTORY dir
 
-renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())
-renameExportM external k src dest = safely (Just False) $
+renameExportM external k src dest = either giveup return =<< go
-	handleRequestExport external src req k Nothing $ \resp -> case resp of
+  where
+	go = handleRequestExport external src req k Nothing $ \resp -> case resp of
 		RENAMEEXPORT_SUCCESS k'
-			| k' == k -> result (Just True)
+			| k' == k -> result $ Right (Just ())
 		RENAMEEXPORT_FAILURE k' 
-			| k' == k -> result (Just False)
+			| k' == k -> result $ Left "failed to rename exported file"
-		UNSUPPORTED_REQUEST -> result Nothing
+		UNSUPPORTED_REQUEST -> result (Right Nothing)
 		_ -> Nothing
-  where
 	req sk = RENAMEEXPORT sk dest
 
-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 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
  - the action to run for it (or Nothing if there's a protocol error).

Remote/Helper/ReadOnly.hs

@@ -62,7 +62,7 @@ readonlyRemoveExport _ _ = readonlyFail
 readonlyRemoveExportDirectory :: ExportDirectory -> Annex ()
 readonlyRemoveExportDirectory _ = readonlyFail
 
-readonlyRenameExport :: Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+readonlyRenameExport :: Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())
 readonlyRenameExport _ _ _ = return Nothing
 
 readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier

Remote/Rsync.hs

@@ -327,7 +327,7 @@ removeExportDirectoryM o ed = removeGeneric o (allbelow d : includes d)
 		Nothing -> []
 		Just f' -> includes f'
 
-renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())
 renameExportM _ _ _ _ = return Nothing
 
 {- Rsync params to enable resumes of sending files safely,

Remote/S3.hs

@@ -508,15 +508,14 @@ 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 -> RemoteStateHandle -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+renameExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())
 renameExportS3 hv r rs info k src dest = Just <$> go
   where
 	go = withS3Handle hv $ \case
-		Just h -> checkVersioning' info rs k $ 
+		Just h -> do
-			catchNonAsync (go' h) (\_ -> return False)
+			checkVersioning info rs k
-		Nothing -> do 
+			go' h
-			warning $ needS3Creds (uuid r)
+		Nothing -> giveup $ needS3Creds (uuid r)
-			return False
 	
 	go' h = liftIO $ runResourceT $ do
 		let co = S3.copyObject (bucket info) dstobject
@@ -525,7 +524,6 @@ renameExportS3 hv r rs info k src dest = Just <$> go
 		-- ACL is not preserved by copy.
 		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
@@ -1291,13 +1289,3 @@ checkVersioning info rs k
 		[] -> giveup "Remote is configured to use versioning, but no S3 version ID is recorded for this key, so it cannot safely be modified."
 		_ -> return ()
 	| otherwise = return ()
-
-checkVersioning' :: S3Info -> RemoteStateHandle -> Key -> Annex Bool -> Annex Bool
-checkVersioning' info rs k a
-	| versioning info = getS3VersionID rs k >>= \case
-		[] -> do
-			warning $ "Remote is configured to use versioning, but no S3 version ID is recorded for this key, so it cannot safely be modified."
-			return False
-		_ -> a
-	| otherwise = a
-

Remote/WebDAV.hs

@@ -176,12 +176,10 @@ retrieveHelper loc d p = do
 		withContentM $ httpBodyRetriever d p
 
 remove :: DavHandleVar -> Remover
-remove hv k = withDavHandle' hv $ \case
+remove hv k = withDavHandle hv $ \dav -> liftIO $ goDAV dav $
-	Right dav -> liftIO $ goDAV dav $
 	-- Delete the key's whole directory, including any
 	-- legacy chunked files, etc, in a single action.
 	removeHelper (keyDir k)
-	Left e -> giveup e
 
 removeHelper :: DavLocation -> DAVT IO ()
 removeHelper d = do
@@ -220,9 +218,7 @@ retrieveExportDav hdl  _k loc d p = case exportLocation loc of
 
 checkPresentExportDav :: DavHandleVar -> Remote -> Key -> ExportLocation -> Annex Bool
 checkPresentExportDav hdl _ _k loc = case exportLocation loc of
-	Right p -> withDavHandle' hdl $ \case
+	Right p -> withDavHandle hdl $ \h -> liftIO $ do
-		Left e -> giveup e
-		Right h -> liftIO $ do
 		v <- goDAV h $ existsDAV p
 		either giveup return v
 	Left err -> giveup err
@@ -244,25 +240,19 @@ removeExportDirectoryDav hdl dir = withDavHandle hdl $ \h -> runExport h $ \_dav
 	debugDav $ "delContent " ++ d
 	inLocation d delContentM
 
-renameExportDav :: DavHandleVar -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
+renameExportDav :: DavHandleVar -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())
 renameExportDav hdl _k src dest = case (exportLocation src, exportLocation dest) of
-	(Right srcl, Right destl) -> withDavHandle' hdl $ \case
+	(Right srcl, Right destl) -> withDavHandle hdl $ \h -> 
-		Right h
 		-- box.com's DAV endpoint has buggy handling of renames,
 		-- so avoid renaming when using it.
-			| boxComUrl `isPrefixOf` baseURL h -> return Nothing
+		if boxComUrl `isPrefixOf` baseURL h 
-			| otherwise -> do
+			then return Nothing
-				v <- runExport' (Right h) $ \dav -> do
+			else runExport h $ \dav -> do
 				maybe noop (void . mkColRecursive) (locationParent destl)
 				moveDAV (baseURL dav) srcl destl
-					return True
+				return (Just ())
-				return (Just v)
+	(Left err, _) -> giveup err
-		Left _e -> return (Just False)
+	(_, Left err) -> giveup err
-	_ -> return (Just False)
-
-runExport' :: Either String DavHandle -> (DavHandle -> DAVT IO Bool) -> Annex Bool
-runExport' (Left _e) _ = return False
-runExport' (Right h) a = fromMaybe False <$> liftIO (goDAV h $ safely (a h))
 
 runExport :: DavHandle -> (DavHandle -> DAVT IO a) -> Annex a
 runExport h a = liftIO (goDAV h (a h))
@@ -426,14 +416,6 @@ withDavHandle hv a = liftIO (readTVarIO hv) >>= \case
 		liftIO $ atomically $ writeTVar hv (Right hdl)
 		either giveup a hdl
 
-withDavHandle' :: DavHandleVar -> (Either String DavHandle -> Annex a) -> Annex a
-withDavHandle' hv a = liftIO (readTVarIO hv) >>= \case
-	Right hdl -> a hdl
-	Left mkhdl -> do
-		hdl <- mkhdl
-		liftIO $ atomically $ writeTVar hv (Right hdl)
-		a hdl
-
 goDAV :: DavHandle -> DAVT IO a -> IO a
 goDAV (DavHandle ctx user pass _) a = choke $ run $ prettifyExceptions $ do
 	prepDAV user pass

Types/Remote.hs

@@ -258,9 +258,12 @@ 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 with False, if the file doesn't exist.
+	--
 	-- If the remote does not support renames, it can return Nothing.
-	, renameExport :: Key -> ExportLocation -> ExportLocation -> a (Maybe Bool)
+	--
+	-- Throws an exception if the remote cannot be accessed, or
+	-- the file doesn't exist or cannot be renamed.
+	, renameExport :: Key -> ExportLocation -> ExportLocation -> a (Maybe ())
 	}
 
 data ImportActions a = ImportActions

doc/bugs/filenames_with_dots_and_spaces_can_not_be_exported.mdwn

@@ -16,3 +16,5 @@ git-annex version: 8.20200309-05df404212, Debian testing
 
 [[!meta title="change exception handling of remotes to avoid ever failing
 without telling the reason why"]]
+
+> [[done]] comprehensively --[[Joey]]

doc/bugs/filenames_with_dots_and_spaces_can_not_be_exported/comment_4_6889c0a21026038431dbe874711f0fe5._comment

@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2020-05-15T18:54:23Z"
+ content="""
+Done with converting all the methods.
+"""]]