fix display when proxied GET yields ERROR

The error message is not displayed to the use, but this mirrors the
behavior when a regular get from a special remote fails. At least now
there is not a protocol error.

Annex/Proxy.hs

@@ -114,7 +114,7 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv endv = go
 			liftIO $ sendmessage $
 				ERROR "NOTIFYCHANGE unsupported for a special remote"
 			go
-		Just _ -> giveup "protocol error"
+		Just _ -> giveup "protocol error M"
 		Nothing -> return ()
 
 	getnextmessageorend = 
@@ -167,9 +167,9 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv endv = go
 								store
 							Just (VALIDITY Invalid) ->
 								return ()
-							_ -> giveup "protocol error"
+							_ -> giveup "protocol error N"
 						else store
-				_ -> giveup "protocol error"
+				_ -> giveup "protocol error O"
 
 	proxyget offset af k = withproxytmpfile k $ \tmpfile -> do
 		-- Don't verify the content from the remote,
@@ -206,6 +206,6 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv endv = go
 			receivemessage >>= \case
 				Just SUCCESS -> return ()
 				Just FAILURE -> return ()
-				Just _ -> giveup "protocol error"
+				Just _ -> giveup "protocol error P"
 				Nothing -> return ()
 						

P2P/IO.hs

@@ -216,7 +216,7 @@ runNet runst conn runner f = case f of
 			Right () -> runner next
 	ReceiveMessage next ->
 		let protoerr = return $ Left $
-			ProtoFailureMessage "protocol error"
+			ProtoFailureMessage "protocol error 1"
 		    gotmessage m = do
 			liftIO $ debugMessage conn "P2P <" m
 			runner (next (Just m))
@@ -263,7 +263,7 @@ runNet runst conn runner f = case f of
 				liftIO (atomically (takeTMVar mv)) >>= \case
 					Left b -> runner (next b)
 					Right _ -> return $ Left $
-						ProtoFailureMessage "protocol error"
+						ProtoFailureMessage "protocol error 2"
 	CheckAuthToken _u t next -> do
 		let authed = connCheckAuth conn t
 		runner (next authed)

P2P/Protocol.hs

@@ -623,6 +623,8 @@ receiveContent mm p sizer storer mkmsg = do
 				validitycheck
 			sendSuccess (observeBool v)
 			return v
+		Just (ERROR _err) ->
+			return observeFailure
 		_ -> do
 			net $ sendMessage (ERROR "expected DATA")
 			return observeFailure

P2P/Proxy.hs

@@ -315,8 +315,8 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
 					to $ net $ sendMessage message
 	
 	protoerr = do
-		_ <- client $ net $ sendMessage (ERROR "protocol error")
+		_ <- client $ net $ sendMessage (ERROR "protocol error X")
-		giveup "protocol error"
+		giveup "protocol error M"
 	
 	handleREMOVE [] _ _ =
 		-- When no places are provided to remove from,
@@ -357,7 +357,10 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
 						else FAILURE_PLUS us
 
 	handleGET remoteside message = getresponse (runRemoteSide remoteside) message $
-		withDATA (relayGET remoteside)
+		withDATA (relayGET remoteside) $ \case
+			ERROR err -> protoerrhandler proxynextclientmessage $
+				client $ net $ sendMessage (ERROR err)
+			_ -> protoerr
 
 	handlePUT (remoteside:[]) k message
 		| Remote.uuid (remote remoteside) == remoteuuid =
@@ -368,7 +371,9 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
 					client $ net $ sendMessage resp
 				PUT_FROM _ -> 
 					getresponse client resp $ 
-						withDATA (relayPUT remoteside k)
+						withDATA
+							(relayPUT remoteside k)
+							(const protoerr)
 				_ -> protoerr
 	handlePUT [] _ _ = 
 		protoerrhandler proxynextclientmessage $
@@ -376,8 +381,8 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
 	handlePUT remotesides k message = 
 		handlePutMulti remotesides k message
 
-	withDATA a message@(DATA len) = a len message
+	withDATA a _ message@(DATA len) = a len message
-	withDATA _ _ = protoerr
+	withDATA _ a message = a message
 	
 	relayGET remoteside len = relayDATAStart client $
 		relayDATACore len (runRemoteSide remoteside) client $
@@ -438,7 +443,8 @@ proxy proxydone proxymethods servermode (ClientSide clientrunst clientconn) remo
 					let l' = rights (rights l)
 					let minoffset = minimum (map snd l')
 					getresponse client (PUT_FROM (Offset minoffset)) $
-						withDATA (relayPUTMulti minoffset l' k)	
+						withDATA (relayPUTMulti minoffset l' k)
+							(const protoerr)
 	
 	relayPUTMulti minoffset remotes k (Len datalen) _ = do
 		let totallen = datalen + minoffset

doc/todo/git-annex_proxies.mdwn

@@ -31,9 +31,6 @@ For June's work on [[design/passthrough_proxy]], remaining todos:
   needs some disk. And it could minimize to eg, the last 2 or so.
   The design doc has some more thoughts about this.
 
-* If GET from a proxied special remote sends an ERROR with a message
-  from the special remote, currently the user sees "protocol error".
-
 * Streaming download from proxied special remotes. See design.
 
 * Check annex.diskreserve when proxying for special remotes.