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.

Annex/Proxy.hs

@@ -76,7 +76,6 @@ proxySpecialRemote
 proxySpecialRemote protoversion r ihdl ohdl endv = go
   where
 	go = receivemessage >>= \case
-		Just (BYPASS _) -> go
 		Just (CHECKPRESENT k) -> do
 			tryNonAsync (Remote.checkPresent r k) >>= \case
 				Right True -> sendmessage SUCCESS
@@ -90,10 +89,11 @@ proxySpecialRemote protoversion r ihdl ohdl endv = go
 		Just (REMOVE k) -> do
 			tryNonAsync (Remote.removeKey r k) >>= \case
 				Right () -> sendmessage SUCCESS
-				Left _ -> sendmessage FAILURE
+				Left err -> propagateerror err
 			go
 		Just (PUT af k) -> giveup "TODO PUT" -- XXX
 		Just (GET offset af k) -> giveup "TODO GET" -- XXX
+		Just (BYPASS _) -> go
 		Just (CONNECT _) -> 
 			-- Not supported and the protocol ends here.
 			sendmessage $ CONNECTDONE (ExitFailure 1)	

P2P/Protocol.hs

@@ -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
+		(Right True, v) -> v
-		(False, _) -> Nothing
+		(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 -> return (Right True, Just [])
-				Just (SUCCESS_PLUS l) -> return (True, Just l)
+				Just (SUCCESS_PLUS l) -> return (Right True, Just l)
-				Just FAILURE -> return (False, Nothing)
+				Just FAILURE -> return (Right False, Nothing)
-				Just (FAILURE_PLUS l) -> return (False, Just l)
+				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 [])
+				then return (Right True, Just [])
-				else return (False, Nothing)
+				else return (Right False, Nothing)
 
 sendSuccess :: Bool -> Proto ()
 sendSuccess True = net $ sendMessage SUCCESS

P2P/Proxy.hs

@@ -329,13 +329,15 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
 				net $ sendMessage message
 				net receiveMessage >>= return . \case
 					Just SUCCESS ->
-						Just (True, [Remote.uuid (remote r)])
+						Just ((True, Nothing), [Remote.uuid (remote r)])
 					Just (SUCCESS_PLUS us) -> 
-						Just (True, Remote.uuid (remote r):us)
+						Just ((True, Nothing), Remote.uuid (remote r):us)
 					Just FAILURE ->
-						Just (False, [])
+						Just ((False, Nothing), [])
 					Just (FAILURE_PLUS us) ->
-						Just (False, us)
+						Just ((False, Nothing), us)
+					Just (ERROR err) ->
+						Just ((False, Just err), [])
 					_ -> Nothing
 		let v' = map join v
 		let us = concatMap snd $ catMaybes v'
@@ -344,12 +346,14 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
 			client $ net $ sendMessage $
 				let nonplussed = all (== remoteuuid) us 
 					|| protocolversion < 2
-				in if all (maybe False fst) v'
+				in if all (maybe False (fst . fst)) v'
 					then if nonplussed
 						then SUCCESS
 						else SUCCESS_PLUS us
 					else if nonplussed
-						then FAILURE
+						then case mapMaybe (snd . fst) (catMaybes v') of
+							[] -> FAILURE
+							(err:_) -> ERROR err
 						else FAILURE_PLUS us
 
 	handleGET remoteside message = getresponse (runRemoteSide remoteside) message $

Remote/Git.hs

@@ -456,7 +456,7 @@ dropKey' repo r st@(State connpool duc _ _ _) key
 		)
 	| Git.repoIsHttp repo = giveup "dropping from http remote not supported"
 	| otherwise = P2PHelper.remove (uuid r) 
-		(Ssh.runProto r connpool (return (False, Nothing))) key
+		(Ssh.runProto r connpool (return (Right False, Nothing))) key
 
 lockKey :: Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
 lockKey r st key callback = do

Remote/Helper/P2P.hs

@@ -60,12 +60,14 @@ retrieve gc runner k af dest p verifyconfig = do
 			Just (False, _) -> giveup "Transfer failed"
 			Nothing -> remoteUnavail
 
-remove :: UUID -> ProtoRunner (Bool, Maybe [UUID]) -> Key -> Annex ()
+remove :: UUID -> ProtoRunner (Either String Bool, Maybe [UUID]) -> Key -> Annex ()
 remove remoteuuid runner k = runner (P2P.remove k) >>= \case
-	Just (True, alsoremoveduuids) -> note alsoremoveduuids
+	Just (Right True, alsoremoveduuids) -> note alsoremoveduuids
-	Just (False, alsoremoveduuids) -> do
+	Just (Right False, alsoremoveduuids) -> do
 		note alsoremoveduuids
 		giveup "removing content from remote failed"
+	Just (Left err, _) -> do
+		giveup (safeOutput err)
 	Nothing -> remoteUnavail
   where
 	-- The remote reports removal from other UUIDs than its own,