From a8cd01fb7d6f1d7c079af983c815bd25ad73ed5b Mon Sep 17 00:00:00 2001 From: Paul Desmond Parker Date: Wed, 20 Dec 2017 21:29:40 +0800 Subject: [PATCH 1/6] Fix error when single query is anonymous. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ``` "{\"query\":\"query {\\n greeting(who: \\\"Tim\\\")\\n}\"}" ``` Notice that the query (immediately after the start of the JSON field `query:`) has no operationName, i.e. it's anonymous. This gets decoded to: ``` Just (GraphQLPostRequest {query = "query {\n greeting(who: \"Tim\")\n}", operationName = "", variables = fromList []}) ``` by a custom/temporary Aeson parser. :blush: I didn't record it, and now it's gone. Something along the lines of: `Just(Error{"query document error!definition error!query"})` Not exactly, but that was the gist of it. Realized that the parser might be choking on the absence of the `operationName`, so tried to apply `optempty` to `nameParser` but Name was not an instance of Monoid. Changed that and ¡viola! it worked (sounds easy, but I learned something about applying Monoid to a newtype, and also picked up a prior mistake where I forgot to import Data.Text). On a side note, the 'custom/temporary' Aeson parser does not yet solve the ambiguous `variables` problem mentioned here: and here: and obliquely here: --- src/GraphQL/Internal/Name.hs | 15 +++++++++++++++ src/GraphQL/Internal/Syntax/Parser.hs | 2 +- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs index 90c8772..f26f3f1 100644 --- a/src/GraphQL/Internal/Name.hs +++ b/src/GraphQL/Internal/Name.hs @@ -25,6 +25,7 @@ import Data.Text as T (Text) import qualified Data.Attoparsec.Text as A import Test.QuickCheck (Arbitrary(..), elements, listOf) import Data.String (IsString(..)) +import Data.Text as T (Text, append, empty) import GraphQL.Internal.Syntax.Tokens (tok) @@ -35,6 +36,20 @@ import GraphQL.Internal.Syntax.Tokens (tok) -- https://facebook.github.io/graphql/#sec-Names newtype Name = Name { unName :: T.Text } deriving (Eq, Ord, Show) +instance Monoid Name where + mempty = Name T.empty +-- mappend (Name {a}) mempty = Name {a} +-- mappend mempty (Name {b}) = Name {b} + mappend (Name a1) (Name a2) = Name (T.append a1 a2) +-- mappend = append +-- mconcat = concat + +--newtype Any = Any { getAny :: Bool } + +--instance Monoid Any where +-- mempty = Any False +-- (Any b1) `mappend` (Any b2) = Any (b1 || b2) + -- | Create a 'Name', panicking if the given text is invalid. -- -- Prefer 'makeName' to this in all cases. diff --git a/src/GraphQL/Internal/Syntax/Parser.hs b/src/GraphQL/Internal/Syntax/Parser.hs index e6ca994..34b7db6 100644 --- a/src/GraphQL/Internal/Syntax/Parser.hs +++ b/src/GraphQL/Internal/Syntax/Parser.hs @@ -52,7 +52,7 @@ operationDefinition = "operationDefinition error!" node :: Parser AST.Node -node = AST.Node <$> nameParser +node = AST.Node <$> optempty nameParser <*> optempty variableDefinitions <*> optempty directives <*> selectionSet From 0a96e0033c5222b2cc0ed5c9e368f2c63f83f4dc Mon Sep 17 00:00:00 2001 From: Paul Desmond Parker Date: Sat, 23 Dec 2017 12:13:35 +0800 Subject: [PATCH 2/6] Cut commented out code. Comment monoid instance. Following suggestions made at: [pull/139#discussion_r158537349](https://github.com/jml/graphql-api/pull/139#discussion_r158537349) and [pull/139#discussion_r158537230](https://github.com/jml/graphql-api/pull/139#discussion_r158537230) and [pull/139#discussion_r158537382](https://github.com/jml/graphql-api/pull/139#discussion_r158537382) --- src/GraphQL/Internal/Name.hs | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs index f26f3f1..bcd7e01 100644 --- a/src/GraphQL/Internal/Name.hs +++ b/src/GraphQL/Internal/Name.hs @@ -36,19 +36,14 @@ import GraphQL.Internal.Syntax.Tokens (tok) -- https://facebook.github.io/graphql/#sec-Names newtype Name = Name { unName :: T.Text } deriving (Eq, Ord, Show) +-- | Allow Name to be parsed with `optempty` +-- +-- Example: node = AST.Node <$> optempty nameParser +-- I.e. If nameParser fails, the Name field of AST.Node is set +-- mempty rather than propagating a failure. instance Monoid Name where mempty = Name T.empty --- mappend (Name {a}) mempty = Name {a} --- mappend mempty (Name {b}) = Name {b} mappend (Name a1) (Name a2) = Name (T.append a1 a2) --- mappend = append --- mconcat = concat - ---newtype Any = Any { getAny :: Bool } - ---instance Monoid Any where --- mempty = Any False --- (Any b1) `mappend` (Any b2) = Any (b1 || b2) -- | Create a 'Name', panicking if the given text is invalid. -- From 2bf5c01d5b44d812ebd0a9599a49046d578f06c0 Mon Sep 17 00:00:00 2001 From: Paul Desmond Parker Date: Fri, 5 Jan 2018 11:22:07 +0800 Subject: [PATCH 3/6] Remove deriving Monoid from Name. --- src/GraphQL/Internal/Name.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs index bcd7e01..ea2b0c1 100644 --- a/src/GraphQL/Internal/Name.hs +++ b/src/GraphQL/Internal/Name.hs @@ -25,7 +25,6 @@ import Data.Text as T (Text) import qualified Data.Attoparsec.Text as A import Test.QuickCheck (Arbitrary(..), elements, listOf) import Data.String (IsString(..)) -import Data.Text as T (Text, append, empty) import GraphQL.Internal.Syntax.Tokens (tok) @@ -36,14 +35,6 @@ import GraphQL.Internal.Syntax.Tokens (tok) -- https://facebook.github.io/graphql/#sec-Names newtype Name = Name { unName :: T.Text } deriving (Eq, Ord, Show) --- | Allow Name to be parsed with `optempty` --- --- Example: node = AST.Node <$> optempty nameParser --- I.e. If nameParser fails, the Name field of AST.Node is set --- mempty rather than propagating a failure. -instance Monoid Name where - mempty = Name T.empty - mappend (Name a1) (Name a2) = Name (T.append a1 a2) -- | Create a 'Name', panicking if the given text is invalid. -- From 693d0b3583fdfad4b431e5884a88663c559f37b8 Mon Sep 17 00:00:00 2001 From: Paul Desmond Parker Date: Fri, 5 Jan 2018 11:36:43 +0800 Subject: [PATCH 4/6] Revert Node as instance of HasName to getNodeName Majority of code change occurred in Validations.hs because the StateT monad needed to operate on a state of type `Set (Maybe Name)` instead of `Set Name`. This was complicated by the fact that fragments use a raw `Name`, not the wrapped `Maybe Name`. Lifted `Name` with `pure Name` in all places it needed to be used inside StateT`s state. Internal/Syntax/AST.hs: * Clean imports * Change type of Node to replace Name with (Maybe Name) Internal/Syntax/Parser.hs: * Make nameParser optional Internal/Syntax/Encoder.hs: * Self explanatory. Internal/Validations.hs: * Rename variables to clearly reflect that they carry a `Maybe Name` somewhere within rather than a `Name`. * Change `StateT`'s state type to `Set (Maybe Name)` * Wrap any `Name` type that needs to go into `StateT`'s state. Change tests accordingly. --- docs/source/tutorial/tutorial.cabal | 12 ++++--- graphql-wai/graphql-wai.cabal | 30 +++++++++++------- src/GraphQL/Internal/Execution.hs | 2 +- src/GraphQL/Internal/Syntax/AST.hs | 11 ++++--- src/GraphQL/Internal/Syntax/Encoder.hs | 6 +++- src/GraphQL/Internal/Syntax/Parser.hs | 2 +- src/GraphQL/Internal/Validation.hs | 44 +++++++++++++------------- tests/ASTTests.hs | 4 +-- tests/ValidationTests.hs | 4 +-- 9 files changed, 64 insertions(+), 51 deletions(-) diff --git a/docs/source/tutorial/tutorial.cabal b/docs/source/tutorial/tutorial.cabal index 6f3ded8..83e21bf 100644 --- a/docs/source/tutorial/tutorial.cabal +++ b/docs/source/tutorial/tutorial.cabal @@ -1,6 +1,8 @@ --- This file has been generated from package.yaml by hpack version 0.15.0. +-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack +-- +-- hash: b3da6c729f0fa19c9ad82cb7e45f616850463bcc1654b9cd4797e34f6685ebd8 name: tutorial version: 0.0.1 @@ -18,11 +20,11 @@ library other-modules: Paths_tutorial build-depends: - base >= 4.9 && < 5 - , protolude + aeson + , base >=4.9 && <5 , graphql-api + , markdown-unlit >=0.4 + , protolude , random - , markdown-unlit >= 0.4 - , aeson default-language: Haskell2010 ghc-options: -Wall -pgmL markdown-unlit diff --git a/graphql-wai/graphql-wai.cabal b/graphql-wai/graphql-wai.cabal index 16b423a..10caf71 100644 --- a/graphql-wai/graphql-wai.cabal +++ b/graphql-wai/graphql-wai.cabal @@ -1,6 +1,8 @@ --- This file has been generated from package.yaml by hpack version 0.15.0. +-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack +-- +-- hash: 12d030d800c1c036c89a9464dd8de8b05f9f6dc28e0faae9d2b105b2b120460e name: graphql-wai version: 0.1.0 @@ -22,15 +24,17 @@ library default-extensions: NoImplicitPrelude OverloadedStrings RecordWildCards TypeApplications ghc-options: -Wall -fno-warn-redundant-constraints -Werror build-depends: - base >= 4.9 && < 5 - , protolude + aeson + , base >=4.9 && <5 , exceptions - , wai - , http-types , graphql-api - , aeson + , http-types + , protolude + , wai exposed-modules: GraphQL.Wai + other-modules: + Paths_graphql_wai default-language: Haskell2010 test-suite wai-tests @@ -41,13 +45,15 @@ test-suite wai-tests default-extensions: NoImplicitPrelude OverloadedStrings RecordWildCards TypeApplications ghc-options: -Wall -fno-warn-redundant-constraints -Werror build-depends: - base >= 4.9 && < 5 - , protolude + aeson + , base >=4.9 && <5 , exceptions - , wai - , http-types , graphql-api - , aeson - , wai-extra , graphql-wai + , http-types + , protolude + , wai + , wai-extra + other-modules: + Paths_graphql_wai default-language: Haskell2010 diff --git a/src/GraphQL/Internal/Execution.hs b/src/GraphQL/Internal/Execution.hs index f793fae..2203917 100644 --- a/src/GraphQL/Internal/Execution.hs +++ b/src/GraphQL/Internal/Execution.hs @@ -51,7 +51,7 @@ import GraphQL.Internal.Validation -- * Return {operation}. getOperation :: QueryDocument value -> Maybe Name -> Either ExecutionError (Operation value) getOperation (LoneAnonymousOperation op) Nothing = pure op -getOperation (MultipleOperations ops) (Just name) = note (NoSuchOperation name) (Map.lookup name ops) +getOperation (MultipleOperations ops) (Just name) = note (NoSuchOperation name) (Map.lookup (pure name) ops) getOperation (MultipleOperations ops) Nothing = case toList ops of [op] -> pure op diff --git a/src/GraphQL/Internal/Syntax/AST.hs b/src/GraphQL/Internal/Syntax/AST.hs index 82f68e3..71c15b2 100644 --- a/src/GraphQL/Internal/Syntax/AST.hs +++ b/src/GraphQL/Internal/Syntax/AST.hs @@ -49,10 +49,10 @@ module GraphQL.Internal.Syntax.AST import Protolude --import Data.String (IsString(..)) -import Test.QuickCheck (Arbitrary(..), elements, listOf, oneof) +import Test.QuickCheck (Arbitrary(..), listOf, oneof) import GraphQL.Internal.Arbitrary (arbitraryText) -import GraphQL.Internal.Name (HasName(getName), Name(unName, Name), unsafeMakeName) +import GraphQL.Internal.Name (Name) -- * Documents @@ -76,11 +76,12 @@ data OperationDefinition | AnonymousQuery SelectionSet deriving (Eq,Show) -data Node = Node Name [VariableDefinition] [Directive] SelectionSet +data Node = Node (Maybe Name) [VariableDefinition] [Directive] SelectionSet deriving (Eq,Show) -instance HasName Node where - getName (Node name _ _ _) = name +-- +getNodeName :: Node -> Maybe Name +getNodeName (Node maybeName _ _ _) = maybeName data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue) deriving (Eq,Show) diff --git a/src/GraphQL/Internal/Syntax/Encoder.hs b/src/GraphQL/Internal/Syntax/Encoder.hs index 6891790..18fda0f 100644 --- a/src/GraphQL/Internal/Syntax/Encoder.hs +++ b/src/GraphQL/Internal/Syntax/Encoder.hs @@ -30,11 +30,15 @@ operationDefinition (AST.Mutation n) = "mutation " <> node n operationDefinition (AST.AnonymousQuery ss) = selectionSet ss node :: AST.Node -> Text -node (AST.Node name vds ds ss) = +node (AST.Node (Just name) vds ds ss) = unName name <> optempty variableDefinitions vds <> optempty directives ds <> selectionSet ss +node (AST.Node Nothing vds ds ss) = + optempty variableDefinitions vds + <> optempty directives ds + <> selectionSet ss variableDefinitions :: [AST.VariableDefinition] -> Text variableDefinitions = parensCommas variableDefinition diff --git a/src/GraphQL/Internal/Syntax/Parser.hs b/src/GraphQL/Internal/Syntax/Parser.hs index 34b7db6..1c3d6d0 100644 --- a/src/GraphQL/Internal/Syntax/Parser.hs +++ b/src/GraphQL/Internal/Syntax/Parser.hs @@ -52,7 +52,7 @@ operationDefinition = "operationDefinition error!" node :: Parser AST.Node -node = AST.Node <$> optempty nameParser +node = AST.Node <$> optional nameParser <*> optempty variableDefinitions <*> optempty directives <*> selectionSet diff --git a/src/GraphQL/Internal/Validation.hs b/src/GraphQL/Internal/Validation.hs index e7e0372..1c4d7f7 100644 --- a/src/GraphQL/Internal/Validation.hs +++ b/src/GraphQL/Internal/Validation.hs @@ -123,7 +123,7 @@ getSelectionSet (Mutation _ _ ss) = ss -- | Type alias for 'Query' and 'Mutation' constructors of 'Operation'. type OperationType value = VariableDefinitions -> Directives value -> SelectionSetByType value -> Operation value -type Operations value = Map Name (Operation value) +type Operations value = Map (Maybe Name) (Operation value) -- | Turn a parsed document into a known valid one. -- @@ -132,9 +132,9 @@ type Operations value = Map Name (Operation value) validate :: Schema -> AST.QueryDocument -> Either (NonEmpty ValidationError) (QueryDocument VariableValue) validate schema (AST.QueryDocument defns) = runValidator $ do let (operations, fragments) = splitBy splitDefns defns - let (anonymous, named) = splitBy splitOps operations + let (anonymous, maybeNamed) = splitBy splitOps operations (frags, visitedFrags) <- resolveFragmentDefinitions =<< validateFragmentDefinitions schema fragments - case (anonymous, named) of + case (anonymous, maybeNamed) of ([], ops) -> do (validOps, usedFrags) <- runStateT (validateOperations schema frags ops) mempty assertAllFragmentsUsed frags (visitedFrags <> usedFrags) @@ -146,7 +146,7 @@ validate schema (AST.QueryDocument defns) = runValidator $ do validValuesSS <- validateValues ss resolvedValuesSS <- resolveVariables emptyVariableDefinitions validValuesSS pure (LoneAnonymousOperation (Query emptyVariableDefinitions emptyDirectives resolvedValuesSS)) - _ -> throwE (MixedAnonymousOperations (length anonymous) (map fst named)) + _ -> throwE (MixedAnonymousOperations (length anonymous) (map fst maybeNamed)) where splitBy :: (a -> Either b c) -> [a] -> ([b], [c]) @@ -156,17 +156,17 @@ validate schema (AST.QueryDocument defns) = runValidator $ do splitDefns (AST.DefinitionFragment frag) = Right frag splitOps (AST.AnonymousQuery ss) = Left ss - splitOps (AST.Query node@(AST.Node name _ _ _)) = Right (name, (Query, node)) - splitOps (AST.Mutation node@(AST.Node name _ _ _)) = Right (name, (Mutation, node)) + splitOps (AST.Query node@(AST.Node maybeName _ _ _)) = Right (maybeName, (Query, node)) + splitOps (AST.Mutation node@(AST.Node maybeName _ _ _)) = Right (maybeName, (Mutation, node)) - assertAllFragmentsUsed :: Fragments value -> Set Name -> Validation () + assertAllFragmentsUsed :: Fragments value -> Set (Maybe Name) -> Validation () assertAllFragmentsUsed fragments used = - let unused = Map.keysSet fragments `Set.difference` used + let unused = ( Set.map pure (Map.keysSet fragments)) `Set.difference` used in unless (Set.null unused) (throwE (UnusedFragments unused)) -- * Operations -validateOperations :: Schema -> Fragments AST.Value -> [(Name, (OperationType AST.Value, AST.Node))] -> StateT (Set Name) Validation (Operations AST.Value) +validateOperations :: Schema -> Fragments AST.Value -> [(Maybe Name, (OperationType AST.Value, AST.Node))] -> StateT (Set (Maybe Name)) Validation (Operations AST.Value) validateOperations schema fragments ops = do deduped <- lift (mapErrors DuplicateOperation (makeMap ops)) traverse validateNode deduped @@ -219,7 +219,7 @@ validateOperation (Mutation vars directives selectionSet) = do -- We do this /before/ validating the values (since that's much easier once -- everything is in a nice structure and away from the AST), which means we -- can't yet evaluate directives. -validateSelectionSet :: Schema -> Fragments AST.Value -> [AST.Selection] -> StateT (Set Name) Validation (SelectionSetByType AST.Value) +validateSelectionSet :: Schema -> Fragments AST.Value -> [AST.Selection] -> StateT (Set (Maybe Name)) Validation (SelectionSetByType AST.Value) validateSelectionSet schema fragments selections = do unresolved <- lift $ traverse (validateSelection schema) selections resolved <- traverse (resolveSelection fragments) unresolved @@ -508,14 +508,14 @@ validateSelection schema selection = -- We're doing a standard depth-first traversal of fragment references, where -- references are by name, so the set of names can be thought of as a record -- of visited references. -resolveSelection :: Fragments a -> Selection' UnresolvedFragmentSpread a -> StateT (Set Name) Validation (Selection' FragmentSpread a) +resolveSelection :: Fragments a -> Selection' UnresolvedFragmentSpread a -> StateT (Set (Maybe Name)) Validation (Selection' FragmentSpread a) resolveSelection fragments = traverseFragmentSpreads resolveFragmentSpread where resolveFragmentSpread (UnresolvedFragmentSpread name directive) = do case Map.lookup name fragments of Nothing -> lift (throwE (NoSuchFragment name)) Just fragment -> do - modify (Set.insert name) + modify (Set.insert (pure name)) pure (FragmentSpread name directive fragment) -- * Fragment definitions @@ -577,7 +577,7 @@ validateTypeCondition schema (NamedType typeCond) = -- -- -- -resolveFragmentDefinitions :: Map Name (FragmentDefinition UnresolvedFragmentSpread value) -> Validation (Fragments value, Set Name) +resolveFragmentDefinitions :: Map Name (FragmentDefinition UnresolvedFragmentSpread value) -> Validation (Fragments value, Set (Maybe Name)) resolveFragmentDefinitions allFragments = splitResult <$> traverse resolveFragment allFragments where @@ -595,12 +595,12 @@ resolveFragmentDefinitions allFragments = FragmentDefinition name cond directives <$> traverse (traverseFragmentSpreads resolveSpread) ss resolveSpread (UnresolvedFragmentSpread name directives) = do - visited <- Set.member name <$> get + visited <- Set.member (pure name) <$> get when visited (lift (throwE (CircularFragmentSpread name))) case Map.lookup name allFragments of Nothing -> lift (throwE (NoSuchFragment name)) Just definition -> do - modify (Set.insert name) + modify (Set.insert (pure name)) FragmentSpread name directives <$> resolveFragment' definition -- * Arguments @@ -727,12 +727,12 @@ data ValidationError -- with the given name. -- -- - = DuplicateOperation Name + = DuplicateOperation (Maybe Name) -- | 'MixedAnonymousOperations' means there was more than one operation -- defined in a document with an anonymous operation. -- -- - | MixedAnonymousOperations Int [Name] + | MixedAnonymousOperations Int [Maybe Name] -- | 'DuplicateArgument' means that multiple copies of the same argument was -- given to the same field, directive, etc. | DuplicateArgument Name @@ -755,7 +755,7 @@ data ValidationError | CircularFragmentSpread Name -- | 'UnusedFragments' means that fragments were defined that weren't used. -- - | UnusedFragments (Set Name) + | UnusedFragments (Set (Maybe Name)) -- | Variables were defined without being used. -- | UnusedVariables (Set Variable) @@ -777,10 +777,10 @@ data ValidationError deriving (Eq, Show) instance GraphQLError ValidationError where - formatError (DuplicateOperation name) = "More than one operation named '" <> show name <> "'" - formatError (MixedAnonymousOperations n names) - | n > 1 && null names = "Multiple anonymous operations defined. Found " <> show n - | otherwise = "Document contains both anonymous operations (" <> show n <> ") and named operations (" <> show names <> ")" + formatError (DuplicateOperation maybeName) = "More than one operation named '" <> show maybeName <> "'" + formatError (MixedAnonymousOperations n maybeNames) + | n > 1 && null maybeNames = "Multiple anonymous operations defined. Found " <> show n + | otherwise = "Document contains both anonymous operations (" <> show n <> ") and named operations (" <> show maybeNames <> ")" formatError (DuplicateArgument name) = "More than one argument named '" <> show name <> "'" formatError (DuplicateFragmentDefinition name) = "More than one fragment named '" <> show name <> "'" formatError (NoSuchFragment name) = "No fragment named '" <> show name <> "'" diff --git a/tests/ASTTests.hs b/tests/ASTTests.hs index 0a47e6a..64042d1 100644 --- a/tests/ASTTests.hs +++ b/tests/ASTTests.hs @@ -121,7 +121,7 @@ tests = testSpec "AST" $ do ]) , AST.DefinitionOperation (AST.Query - (AST.Node "getName" [] [] + (AST.Node (pure "getName") [] [] [ AST.SelectionField (AST.Field Nothing dog [] [] [ AST.SelectionField @@ -145,7 +145,7 @@ tests = testSpec "AST" $ do let expected = AST.QueryDocument [ AST.DefinitionOperation (AST.Query - (AST.Node "houseTrainedQuery" + (AST.Node (pure "houseTrainedQuery") [ AST.VariableDefinition (AST.Variable "atOtherHomes") (AST.TypeNamed (AST.NamedType "Boolean")) diff --git a/tests/ValidationTests.hs b/tests/ValidationTests.hs index 6b1f24c..c9a365b 100644 --- a/tests/ValidationTests.hs +++ b/tests/ValidationTests.hs @@ -19,8 +19,8 @@ import GraphQL.Internal.Validation , getErrors ) -me :: Name -me = "me" +me :: Maybe Name +me = pure "me" someName :: Name someName = "name" From 61cc96b603115843024fdf5d1617518384b4c1f1 Mon Sep 17 00:00:00 2001 From: Paul Desmond Parker Date: Fri, 22 Dec 2017 17:58:01 +0800 Subject: [PATCH 5/6] Add tests for anonymous queries w|w/o variables Added tests in ASTTests.hs: - parses anonymous query documents - changed previous test of same name to: parses shorthand syntax documents - parses anonymous query with variables Added tests in ValidationTests.hs: - Treats anonymous queries as valid - Treats anonymous queries with variables as valid --- src/GraphQL/Internal/Name.hs | 1 + tests/ASTTests.hs | 53 ++++++++++++++++++++++++++++++++++-- tests/ValidationTests.hs | 40 ++++++++++++++++++++++++++- 3 files changed, 91 insertions(+), 3 deletions(-) diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs index ea2b0c1..33b2395 100644 --- a/src/GraphQL/Internal/Name.hs +++ b/src/GraphQL/Internal/Name.hs @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module GraphQL.Internal.Name ( Name(unName, Name) + , mempty , NameError(..) , makeName , nameFromSymbol diff --git a/tests/ASTTests.hs b/tests/ASTTests.hs index 64042d1..33dfa2d 100644 --- a/tests/ASTTests.hs +++ b/tests/ASTTests.hs @@ -13,7 +13,7 @@ import Test.Tasty (TestTree) import Test.Tasty.Hspec (testSpec, describe, it, shouldBe) import GraphQL.Value (String(..)) -import GraphQL.Internal.Name (Name) +import GraphQL.Internal.Name (Name (Name), mempty) import qualified GraphQL.Internal.Syntax.AST as AST import qualified GraphQL.Internal.Syntax.Parser as Parser import qualified GraphQL.Internal.Syntax.Encoder as Encoder @@ -78,7 +78,7 @@ tests = testSpec "AST" $ do output `shouldBe` "[1.5,1.5]" parseOnly Parser.value output `shouldBe` Right input describe "Parser" $ do - it "parses anonymous query documents" $ do + it "parses shorthand syntax documents" $ do let query = [r|{ dog { name @@ -96,6 +96,25 @@ tests = testSpec "AST" $ do ] parsed `shouldBe` expected + it "parses anonymous query documents" $ do + let query = [r|query { + dog { + name + } + }|] + let Right parsed = parseOnly Parser.queryDocument query + let expected = AST.QueryDocument + [ AST.DefinitionOperation + (AST.Query + (AST.Node (Name mempty) [] [] + [ AST.SelectionField + (AST.Field Nothing dog [] [] + [ AST.SelectionField (AST.Field Nothing someName [] [] []) + ]) + ])) + ] + parsed `shouldBe` expected + it "parses invalid documents" $ do let query = [r|{ dog { @@ -162,3 +181,33 @@ tests = testSpec "AST" $ do ])) ] parsed `shouldBe` expected + + it "parses anonymous query with variables" $ do + let query = [r| + query ($atOtherHomes: Boolean = true) { + dog { + isHousetrained(atOtherHomes: $atOtherHomes) + } + } + |] + let Right parsed = parseOnly Parser.queryDocument query + let expected = AST.QueryDocument + [ AST.DefinitionOperation + (AST.Query + (AST.Node (Name mempty) + [ AST.VariableDefinition + (AST.Variable "atOtherHomes") + (AST.TypeNamed (AST.NamedType "Boolean")) + (Just (AST.ValueBoolean True)) + ] [] + [ AST.SelectionField + (AST.Field Nothing dog [] [] + [ AST.SelectionField + (AST.Field Nothing "isHousetrained" + [ AST.Argument "atOtherHomes" + (AST.ValueVariable (AST.Variable "atOtherHomes")) + ] [] []) + ]) + ])) + ] + parsed `shouldBe` expected diff --git a/tests/ValidationTests.hs b/tests/ValidationTests.hs index c9a365b..16826bf 100644 --- a/tests/ValidationTests.hs +++ b/tests/ValidationTests.hs @@ -10,7 +10,7 @@ import Test.QuickCheck ((===)) import Test.Tasty (TestTree) import Test.Tasty.Hspec (testSpec, describe, it, shouldBe) -import GraphQL.Internal.Name (Name) +import GraphQL.Internal.Name (Name(Name), mempty) import qualified GraphQL.Internal.Syntax.AST as AST import GraphQL.Internal.Schema (Schema) import GraphQL.Internal.Validation @@ -25,6 +25,9 @@ me = pure "me" someName :: Name someName = "name" +dog :: Name +dog = "dog" + -- | Schema used for these tests. Since none of them do type-level stuff, we -- don't need to define it. schema :: Schema @@ -45,6 +48,41 @@ tests = testSpec "Validation" $ do ] getErrors schema doc `shouldBe` [] + it "Treats anonymous queries as valid" $ do + let doc = AST.QueryDocument + [ AST.DefinitionOperation + (AST.Query + (AST.Node (Name mempty) [] [] + [ AST.SelectionField + (AST.Field Nothing dog [] [] + [ AST.SelectionField (AST.Field Nothing someName [] [] []) + ]) + ])) + ] + getErrors schema doc `shouldBe` [] + + it "Treats anonymous queries with variables as valid" $ do + let doc = AST.QueryDocument + [ AST.DefinitionOperation + (AST.Query + (AST.Node (Name mempty) + [ AST.VariableDefinition + (AST.Variable "atOtherHomes") + (AST.TypeNamed (AST.NamedType "Boolean")) + (Just (AST.ValueBoolean True)) + ] [] + [ AST.SelectionField + (AST.Field Nothing dog [] [] + [ AST.SelectionField + (AST.Field Nothing "isHousetrained" + [ AST.Argument "atOtherHomes" + (AST.ValueVariable (AST.Variable "atOtherHomes")) + ] [] []) + ]) + ])) + ] + getErrors schema doc `shouldBe` [] + it "Detects duplicate operation names" $ do let doc = AST.QueryDocument [ AST.DefinitionOperation From 17cde57137009d775177b2451ded24779796ecd0 Mon Sep 17 00:00:00 2001 From: Paul Desmond Parker Date: Fri, 5 Jan 2018 12:22:13 +0800 Subject: [PATCH 6/6] Change tests to use `AST.Node Nothing` Remove unused imports Remove redundant import `Name(Name)` Stop exporting mempty from Internal.Name --- src/GraphQL/Internal/Name.hs | 1 - tests/ASTTests.hs | 6 +++--- tests/ValidationTests.hs | 6 +++--- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/GraphQL/Internal/Name.hs b/src/GraphQL/Internal/Name.hs index 33b2395..ea2b0c1 100644 --- a/src/GraphQL/Internal/Name.hs +++ b/src/GraphQL/Internal/Name.hs @@ -6,7 +6,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module GraphQL.Internal.Name ( Name(unName, Name) - , mempty , NameError(..) , makeName , nameFromSymbol diff --git a/tests/ASTTests.hs b/tests/ASTTests.hs index 33dfa2d..ab8019b 100644 --- a/tests/ASTTests.hs +++ b/tests/ASTTests.hs @@ -13,7 +13,7 @@ import Test.Tasty (TestTree) import Test.Tasty.Hspec (testSpec, describe, it, shouldBe) import GraphQL.Value (String(..)) -import GraphQL.Internal.Name (Name (Name), mempty) +import GraphQL.Internal.Name (Name) import qualified GraphQL.Internal.Syntax.AST as AST import qualified GraphQL.Internal.Syntax.Parser as Parser import qualified GraphQL.Internal.Syntax.Encoder as Encoder @@ -106,7 +106,7 @@ tests = testSpec "AST" $ do let expected = AST.QueryDocument [ AST.DefinitionOperation (AST.Query - (AST.Node (Name mempty) [] [] + (AST.Node Nothing [] [] [ AST.SelectionField (AST.Field Nothing dog [] [] [ AST.SelectionField (AST.Field Nothing someName [] [] []) @@ -194,7 +194,7 @@ tests = testSpec "AST" $ do let expected = AST.QueryDocument [ AST.DefinitionOperation (AST.Query - (AST.Node (Name mempty) + (AST.Node Nothing [ AST.VariableDefinition (AST.Variable "atOtherHomes") (AST.TypeNamed (AST.NamedType "Boolean")) diff --git a/tests/ValidationTests.hs b/tests/ValidationTests.hs index 16826bf..420c576 100644 --- a/tests/ValidationTests.hs +++ b/tests/ValidationTests.hs @@ -10,7 +10,7 @@ import Test.QuickCheck ((===)) import Test.Tasty (TestTree) import Test.Tasty.Hspec (testSpec, describe, it, shouldBe) -import GraphQL.Internal.Name (Name(Name), mempty) +import GraphQL.Internal.Name (Name) import qualified GraphQL.Internal.Syntax.AST as AST import GraphQL.Internal.Schema (Schema) import GraphQL.Internal.Validation @@ -52,7 +52,7 @@ tests = testSpec "Validation" $ do let doc = AST.QueryDocument [ AST.DefinitionOperation (AST.Query - (AST.Node (Name mempty) [] [] + (AST.Node (Nothing) [] [] [ AST.SelectionField (AST.Field Nothing dog [] [] [ AST.SelectionField (AST.Field Nothing someName [] [] []) @@ -65,7 +65,7 @@ tests = testSpec "Validation" $ do let doc = AST.QueryDocument [ AST.DefinitionOperation (AST.Query - (AST.Node (Name mempty) + (AST.Node Nothing [ AST.VariableDefinition (AST.Variable "atOtherHomes") (AST.TypeNamed (AST.NamedType "Boolean"))