Data Connectors API 400 error response - GDC-619

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6839
GitOrigin-RevId: 813ea5e976ff41754e7500abf6bcd0c8b70c960e

dc-agents/README.md

@@ -1513,7 +1513,7 @@ However, this endpoint can also be used to check whether the ability of the agen
 
 ### Reporting Errors
 
-Any non-200 response code from an Agent (except for the `/health` endpoint) will be interpreted as an error. These should be handled gracefully by `graphql-engine` but provide limited details to users. If you wish to return structured error information to users you can return a status of `500` from the `/capabilities`, `/schema`, and `/query` endpoints with the following JSON format:
+Any non-200 response code from an Agent (except for the `/health` endpoint) will be interpreted as an error. These should be handled gracefully by `graphql-engine` but provide limited details to users. If you wish to return structured error information to users you can return a status of `500`, or `400` from the `/capabilities`, `/schema`, and `/query` endpoints with the following JSON format:
 
 ```
 {

server/lib/dc-api/src/Hasura/Backends/DataConnector/API.hs

@@ -25,6 +25,7 @@ where
 import Control.Arrow (left)
 import Data.ByteString.Lazy as BL
 import Data.Data (Proxy (..))
+import Data.Foldable (for_)
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.OpenApi (OpenApi)
 import Data.Text (Text)
@@ -47,12 +48,14 @@ capabilitiesCase :: a -> (CapabilitiesResponse -> a) -> (ErrorResponse -> a) ->
 capabilitiesCase defaultAction capabilitiesAction errorAction union = do
   let capabilitiesM = matchUnion @CapabilitiesResponse union
   let errorM = matchUnion @ErrorResponse union
-  case (capabilitiesM, errorM) of
-    (Just c, Nothing) -> capabilitiesAction c
-    (Nothing, Just e) -> errorAction e
-    _ -> defaultAction -- Note, this could technically include the (Just _, Just _) scenario which is not possible.
+  let errorM400 = matchUnion @ErrorResponse400 union
+  case (capabilitiesM, errorM, errorM400) of
+    (Nothing, Nothing, Nothing) -> defaultAction
+    (Just c, _, _) -> capabilitiesAction c
+    (_, Just e, _) -> errorAction e
+    (_, _, Just (WithStatus e)) -> errorAction e
 
-type CapabilitiesResponses = '[V0.CapabilitiesResponse, V0.ErrorResponse]
+type CapabilitiesResponses = '[V0.CapabilitiesResponse, V0.ErrorResponse, V0.ErrorResponse400]
 
 type CapabilitiesApi =
   "capabilities"
@@ -60,16 +63,19 @@ type CapabilitiesApi =
 
 -- | This function defines a central place to ensure that all cases are covered for schema and error responses.
 --   When additional responses are added to the Union, this should be updated to ensure that all responses have been considered.
-schemaCase :: Monad m => m a -> (SchemaResponse -> m a) -> (ErrorResponse -> m a) -> Union SchemaResponses -> m a
+schemaCase :: a -> (SchemaResponse -> a) -> (ErrorResponse -> a) -> Union SchemaResponses -> a
 schemaCase defaultAction schemaAction errorAction union = do
   let schemaM = matchUnion @SchemaResponse union
   let errorM = matchUnion @ErrorResponse union
-  case (schemaM, errorM) of
-    (Just c, Nothing) -> schemaAction c
-    (Nothing, Just e) -> errorAction e
-    _ -> defaultAction -- Note, this could technically include the (Just _, Just _) scenario which is not possible.
+  let errorM400 = matchUnion @ErrorResponse400 union
+  case (schemaM, errorM, errorM400) of
+    -- Note, this could technically include the ...Just _, Just _... scenario, but won't occurr due to matchUnion
+    (Nothing, Nothing, Nothing) -> defaultAction
+    (Just x, _, _) -> schemaAction x
+    (_, Just x, _) -> errorAction x
+    (_, _, Just (WithStatus x)) -> errorAction x
 
-type SchemaResponses = '[V0.SchemaResponse, V0.ErrorResponse]
+type SchemaResponses = '[V0.SchemaResponse, V0.ErrorResponse, V0.ErrorResponse400]
 
 type SchemaApi =
   "schema"
@@ -79,16 +85,18 @@ type SchemaApi =
 
 -- | This function defines a central place to ensure that all cases are covered for query and error responses.
 --   When additional responses are added to the Union, this should be updated to ensure that all responses have been considered.
-queryCase :: Monad m => m a -> (QueryResponse -> m a) -> (ErrorResponse -> m a) -> Union QueryResponses -> m a
+queryCase :: a -> (QueryResponse -> a) -> (ErrorResponse -> a) -> Union QueryResponses -> a
 queryCase defaultAction queryAction errorAction union = do
   let queryM = matchUnion @QueryResponse union
   let errorM = matchUnion @ErrorResponse union
-  case (queryM, errorM) of
-    (Just c, Nothing) -> queryAction c
-    (Nothing, Just e) -> errorAction e
-    _ -> defaultAction -- Note, this could technically include the (Just _, Just _) scenario which is not possible.
+  let errorM400 = matchUnion @ErrorResponse400 union
+  case (queryM, errorM, errorM400) of
+    (Nothing, Nothing, Nothing) -> defaultAction
+    (Just c, _, _) -> queryAction c
+    (_, Just e, _) -> errorAction e
+    (_, _, Just (WithStatus e)) -> errorAction e
 
-type QueryResponses = '[V0.QueryResponse, V0.ErrorResponse]
+type QueryResponses = '[V0.QueryResponse, V0.ErrorResponse, V0.ErrorResponse400]
 
 type QueryApi =
   "query"

server/lib/dc-api/src/Hasura/Backends/DataConnector/API/V0/ErrorResponse.hs

@@ -3,6 +3,7 @@
 
 module Hasura.Backends.DataConnector.API.V0.ErrorResponse
   ( ErrorResponse (..),
+    ErrorResponse400,
     ErrorResponseType (..),
     errorResponseJsonText,
     errorResponseSummary,
@@ -54,6 +55,8 @@ data ErrorResponse = ErrorResponse
 instance HasStatus ErrorResponse where
   type StatusOf ErrorResponse = 500
 
+type ErrorResponse400 = Servant.WithStatus 400 ErrorResponse
+
 {-# HLINT ignore "Use tshow" #-}
 errorResponseSummary :: ErrorResponse -> Text
 errorResponseSummary ErrorResponse {..} = pack (show _crType) <> ": " <> _crMessage

server/src-lib/Hasura/RQL/DDL/Schema/Source.hs

@@ -435,7 +435,7 @@ runGetTableInfo GetTableInfo {..} = do
         pure $ EncJSON.encJFromJValue table
       backend -> Error.throw500 ("Schema fetching is not supported for '" <> Text.E.toTxt backend <> "'")
 
-schemaGuard :: MonadError QErr m => Union '[API.SchemaResponse, API.ErrorResponse] -> m API.SchemaResponse
+schemaGuard :: MonadError QErr m => Union API.SchemaResponses -> m API.SchemaResponse
 schemaGuard = schemaCase defaultAction pure errorAction
   where
     defaultAction = throw400 DataConnectorError "Error resolving source schema"