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:
parent
a6ea057f6b
commit
158d7bc933
5 changed files with 31 additions and 23 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue