From 8503c0f288201223776f9962438c577241f08c9d Mon Sep 17 00:00:00 2001 From: Dmitrii Skurikhin Date: Fri, 11 Feb 2022 22:50:53 +0300 Subject: [PATCH] enhance query errors --- CHANGELOG.md | 1 + src/Language/GraphQL/AST/Document.hs | 8 ++++ src/Language/GraphQL/Execute.hs | 39 +++++++++++------ tests/Language/GraphQL/ExecuteSpec.hs | 62 ++++++++++++++++++++++++--- 4 files changed, 91 insertions(+), 19 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2d54639..1231a61 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ and this project adheres to ### Added - quickCheck Parser test for arguments. Arbitrary instances for Language.GraphQL.AST.Document. +- Enhanced query error messages. Add tests for these cases. ## [1.0.2.0] - 2021-12-26 ### Added diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index a698d2e..ea640df 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -49,6 +49,8 @@ module Language.GraphQL.AST.Document , Value(..) , VariableDefinition(..) , escape + , showVariableName + , showVariable ) where import Data.Char (ord) @@ -339,6 +341,12 @@ data VariableDefinition = VariableDefinition Name Type (Maybe (Node ConstValue)) Location deriving (Eq, Show) +showVariableName :: VariableDefinition -> String +showVariableName (VariableDefinition name _ _ _) = "$" <> Text.unpack name + +showVariable :: VariableDefinition -> String +showVariable var@(VariableDefinition _ type' _ _) = showVariableName var <> ":" <> " " <> show type' + -- ** Type References -- | Type representation. diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 3faee5b..5ceb616 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -61,6 +61,7 @@ import Language.GraphQL.Error , ResponseEventStream ) import Prelude hiding (null) +import Language.GraphQL.AST.Document (showVariableName) newtype ExecutorT m a = ExecutorT { runExecutorT :: ReaderT (HashMap Full.Name (Type m)) (WriterT (Seq Error) m) a @@ -190,32 +191,42 @@ data QueryError tell :: Monad m => Seq Error -> ExecutorT m () tell = ExecutorT . lift . Writer.tell +operationNameErrorText :: Text +operationNameErrorText = Text.unlines + [ "Named operations must be provided with the name of the desired operation." + , "See https://spec.graphql.org/June2018/#sec-Language.Document description." + ] + queryError :: QueryError -> Error queryError OperationNameRequired = - Error{ message = "Operation name is required.", locations = [], path = [] } + let queryErrorMessage = "Operation name is required. " <> operationNameErrorText + in Error{ message = queryErrorMessage, locations = [], path = [] } queryError (OperationNotFound operationName) = - let queryErrorMessage = Text.concat - [ "Operation \"" - , Text.pack operationName - , "\" not found." + let queryErrorMessage = Text.unlines + [ Text.concat + [ "Operation \"" + , Text.pack operationName + , "\" is not found in the named operations you've provided. " + ] + , operationNameErrorText ] in Error{ message = queryErrorMessage, locations = [], path = [] } queryError (CoercionError variableDefinition) = - let Full.VariableDefinition variableName _ _ location = variableDefinition + let (Full.VariableDefinition _ _ _ location) = variableDefinition queryErrorMessage = Text.concat - [ "Failed to coerce the variable \"" - , variableName - , "\"." + [ "Failed to coerce the variable " + , Text.pack $ Full.showVariable variableDefinition + , "." ] in Error{ message = queryErrorMessage, locations = [location], path = [] } queryError (UnknownInputType variableDefinition) = - let Full.VariableDefinition variableName variableTypeName _ location = variableDefinition + let Full.VariableDefinition _ variableTypeName _ location = variableDefinition queryErrorMessage = Text.concat - [ "Variable \"" - , variableName - , "\" has unknown type \"" + [ "Variable " + , Text.pack $ showVariableName variableDefinition + , " has unknown type " , Text.pack $ show variableTypeName - , "\"." + , "." ] in Error{ message = queryErrorMessage, locations = [location], path = [] } diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index f4e599a..73d62b4 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -21,6 +21,7 @@ import Language.GraphQL.Error import Language.GraphQL.Execute (execute) import Language.GraphQL.TH import qualified Language.GraphQL.Type.Schema as Schema +import qualified Language.GraphQL.Type as Type import Language.GraphQL.Type import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out @@ -30,6 +31,7 @@ import Text.Megaparsec (parse) import Schemas.HeroSchema (heroSchema) import Data.Maybe (fromJust) import qualified Data.Sequence as Seq +import qualified Data.Text as Text data PhilosopherException = PhilosopherException deriving Show @@ -182,7 +184,7 @@ quoteType = Out.ObjectType "Quote" Nothing [] quoteField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty -schoolType :: EnumType +schoolType :: Type.EnumType schoolType = EnumType "School" Nothing $ HashMap.fromList [ ("NOMINALISM", EnumValue Nothing) , ("REALISM", EnumValue Nothing) @@ -190,12 +192,12 @@ schoolType = EnumType "School" Nothing $ HashMap.fromList ] type EitherStreamOrValue = Either - (ResponseEventStream (Either SomeException) Value) - (Response Value) + (ResponseEventStream (Either SomeException) Type.Value) + (Response Type.Value) execute' :: Document -> Either SomeException EitherStreamOrValue execute' = - execute philosopherSchema Nothing (mempty :: HashMap Name Value) + execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value) spec :: Spec spec = @@ -339,9 +341,59 @@ spec = $ parse document "" "{ philosopher(id: \"1\") { firstLanguage } }" in actual `shouldBe` expected + context "queryError" $ do + let + namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }" + twoQueries = namedQuery "A" <> " " <> namedQuery "B" + startsWith :: Text.Text -> Text.Text -> Bool + startsWith xs ys = Text.take (Text.length ys) xs == ys + + it "throws operation name is required error" $ + let expectedErrorMessage :: Text.Text + expectedErrorMessage = "Operation name is required" + Right (Right (Response _ executionErrors)) = either (pure . parseError) execute' $ parse document "" twoQueries + Error msg _ _ = Seq.index executionErrors 0 + in msg `startsWith` expectedErrorMessage `shouldBe` True + + it "throws operation not found error" $ + let expectedErrorMessage :: Text.Text + expectedErrorMessage = "Operation \"C\" is not found" + execute'' :: Document -> Either SomeException EitherStreamOrValue + execute'' = execute philosopherSchema (Just "C") (mempty :: HashMap Name Type.Value) + Right (Right (Response _ executionErrors)) = either (pure . parseError) execute'' + $ parse document "" twoQueries + Error msg _ _ = Seq.index executionErrors 0 + in msg `startsWith` expectedErrorMessage `shouldBe` True + + it "throws variable coercion error" $ + let data'' = Null + executionErrors = pure $ Error + { message = "Failed to coerce the variable $id: String." + , locations =[Location 1 7] + , path = [] + } + expected = Response data'' executionErrors + executeWithVars :: Document -> Either SomeException EitherStreamOrValue + executeWithVars = execute philosopherSchema Nothing (HashMap.singleton "id" (Type.Int 1)) + Right (Right actual) = either (pure . parseError) executeWithVars + $ parse document "" "query($id: String) { philosopher(id: \"1\") { firstLanguage } }" + in actual `shouldBe` expected + + it "throws variable unkown input type error" $ + let data'' = Null + executionErrors = pure $ Error + { message = "Variable $id has unknown type Cat." + , locations =[Location 1 7] + , path = [] + } + expected = Response data'' executionErrors + Right (Right actual) = either (pure . parseError) execute' + $ parse document "" "query($id: Cat) { philosopher(id: \"1\") { firstLanguage } }" + in actual `shouldBe` expected + context "Error path" $ do let executeHero :: Document -> Either SomeException EitherStreamOrValue - executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Value) + executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Type.Value) it "at the beggining of the list" $ let Right (Right actual) = either (pure . parseError) executeHero