fix handling of ERROR in response to REMOVE

This allows an error message from a proxied special remote to be
displayed to the client.

In the case where removal from several nodes of a cluster fails,
there can be several errors. What to do? I decided to only show
the first error to the user. Probably in this case the user is not in a
position to do anything about an error message, so best keep it simple.
If the problem with the first node is fixed, they'll see the error from
the next node.
This commit is contained in:
Joey Hess 2024-06-28 14:07:23 -04:00
parent a6ea057f6b
commit 158d7bc933
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 31 additions and 23 deletions

View file

@ -378,7 +378,7 @@ lockContentWhile runproto key a = bracket setup cleanup a
cleanup True = runproto () $ net $ sendMessage UNLOCKCONTENT
cleanup False = return ()
remove :: Key -> Proto (Bool, Maybe [UUID])
remove :: Key -> Proto (Either String Bool, Maybe [UUID])
remove key = do
net $ sendMessage (REMOVE key)
checkSuccessFailurePlus
@ -644,28 +644,30 @@ checkSuccess' = do
checkSuccessPlus :: Proto (Maybe [UUID])
checkSuccessPlus =
checkSuccessFailurePlus >>= return . \case
(True, v) -> v
(False, _) -> Nothing
(Right True, v) -> v
(Right False, _) -> Nothing
(Left _, _) -> Nothing
checkSuccessFailurePlus :: Proto (Bool, Maybe [UUID])
checkSuccessFailurePlus :: Proto (Either String Bool, Maybe [UUID])
checkSuccessFailurePlus = do
ver <- net getProtocolVersion
if ver >= ProtocolVersion 2
then do
ack <- net receiveMessage
case ack of
Just SUCCESS -> return (True, Just [])
Just (SUCCESS_PLUS l) -> return (True, Just l)
Just FAILURE -> return (False, Nothing)
Just (FAILURE_PLUS l) -> return (False, Just l)
Just SUCCESS -> return (Right True, Just [])
Just (SUCCESS_PLUS l) -> return (Right True, Just l)
Just FAILURE -> return (Right False, Nothing)
Just (FAILURE_PLUS l) -> return (Right False, Just l)
Just (ERROR err) -> return (Left err, Nothing)
_ -> do
net $ sendMessage (ERROR "expected SUCCESS or SUCCESS-PLUS or FAILURE or FAILURE-PLUS")
return (False, Nothing)
return (Right False, Nothing)
else do
ok <- checkSuccess
if ok
then return (True, Just [])
else return (False, Nothing)
then return (Right True, Just [])
else return (Right False, Nothing)
sendSuccess :: Bool -> Proto ()
sendSuccess True = net $ sendMessage SUCCESS