Merge pull request #207 from well-typed/edsko/error-response-body

Ensure we include response body for server errors
well-typed · Jul 26, 2024 · a2133e9 · a2133e9
2 parents e991d40 + 3e634f4
commit a2133e9
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 3 deletions.
diff --git a/src/Network/GRPC/Spec/Serialization/Headers/Response.hs b/src/Network/GRPC/Spec/Serialization/Headers/Response.hs
@@ -122,7 +122,9 @@ classifyServerResponse rpc status headers mBody
             -- almost certainly not be a content-type header present in the
             -- case of a non-200 HTTP status. We don't want to synthesize /that/
             -- error, so we override it.
-            Right Nothing
+            case trailersOnlyContentType parsed of
+              Left  _err   -> Right Nothing
+              Right mCType -> Right mCType
         , trailersOnlyProper = parsedTrailers {
               properTrailersGrpcStatus = Right $
                 GrpcError err
@@ -132,7 +134,6 @@ classifyServerResponse rpc status headers mBody
                   _otherwise       -> Just defaultMsg
             }
         }
-
       where
         parsed :: TrailersOnly' GrpcException
         parsed = parseTrailersOnly' rpc headers

diff --git a/test-grapesy/Test/Sanity/BrokenDeployments.hs b/test-grapesy/Test/Sanity/BrokenDeployments.hs
@@ -26,7 +26,10 @@ import Proto.API.Ping
 
 tests :: TestTree
 tests = testGroup "Test.Sanity.BrokenDeployments" [
-      testCase "statusNon200" test_statusNon200
+      testGroup "status" [
+          testCase "non200"     test_statusNon200
+        , testCase "non200Body" test_statusNon200Body
+        ]
     , testGroup "ContentType" [
           testCase "nonGrpcRegular"      test_nonGrpcContentTypeRegular
         , testCase "missingRegular"      test_missingContentTypeRegular
@@ -66,6 +69,29 @@ test_statusNon200 = respondWith response $ \addr -> do
           responseStatus = HTTP.badRequest400
         }
 
+-- | Ensure that we include the response body for errors, if any
+test_statusNon200Body :: Assertion
+test_statusNon200Body = respondWith response $ \addr -> do
+    mResp :: Either GrpcException (Proto PongMessage) <- try $
+      Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
+        Client.withRPC conn def (Proxy @Ping) $ \call -> do
+          Client.sendFinalInput call defMessage
+          fst <$> Client.recvFinalOutput call
+    case mResp of
+      Left err
+        | grpcError err == GrpcInternal
+        , Just msg <- grpcErrorMessage err
+        , "Server supplied custom error" `Text.isInfixOf` msg ->
+        return ()
+      _otherwise ->
+        assertFailure $ "Unexpected response: " ++ show mResp
+  where
+    response :: Response
+    response = def {
+          responseStatus = HTTP.badRequest400
+        , responseBody   = "Server supplied custom error"
+        }
+
 {-------------------------------------------------------------------------------
   Content-type
 -------------------------------------------------------------------------------}