OSS
/
graphql
1
1
Fork 1
Code Issues 3 Pull Requests Actions Releases 22 Wiki Activity

Validate single root field in subscriptions

This commit is contained in:
Eugen Wissner 2020-08-25 21:03:42 +02:00
parent 54dbf1df16
commit 7355533268
13 changed files with 301 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CHANGELOG.md
View File

@ -9,6 +9,14 @@ and this project adheres to
## [Unreleased]
## Changed
- `Test.Hspec.GraphQL.*`: replace `IO` in the resolver with any `MonadCatch`.
- The `Location` argument of `AST.Document.Definition.ExecutableDefinition` was
moved to `OperationDefinition` and `FragmentDefinition` since these are the
actual elements that have a location in the document.
- `Validate.Rules` get the whole validation context (AST and schema).
## Added
- `Validate.Validation` contains data structures and functions used by the
validator and concretet rules.
## [0.9.0.0] - 2020-07-24
## Fixed

3
graphql.cabal
View File

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: 1d8c32c00a882ccd1fefc4c083d5fe4e83a1825fbf8e0dcfd551ff2c8cd2dda0
-- hash: 59e2949d07cb5e678b493b77771db1bd64947de480f3da93ca07b3f2458cc495
name: graphql
version: 0.9.0.0
@ -50,6 +50,7 @@ library
Language.GraphQL.Type.Out
Language.GraphQL.Type.Schema
Language.GraphQL.Validate
Language.GraphQL.Validate.Validation
Test.Hspec.GraphQL
other-modules:
Language.GraphQL.Execute.Execution

7
src/Language/GraphQL/AST/Document.hs
View File

@ -69,7 +69,7 @@ type Document = NonEmpty Definition
-- | All kinds of definitions that can occur in a GraphQL document.
data Definition
= ExecutableDefinition ExecutableDefinition Location
= ExecutableDefinition ExecutableDefinition
| TypeSystemDefinition TypeSystemDefinition Location
| TypeSystemExtension TypeSystemExtension Location
deriving (Eq, Show)
@ -84,13 +84,14 @@ data ExecutableDefinition
-- | Operation definition.
data OperationDefinition
= SelectionSet SelectionSet
= SelectionSet SelectionSet Location
| OperationDefinition
OperationType
(Maybe Name)
[VariableDefinition]
[Directive]
SelectionSet
Location
deriving (Eq, Show)
-- | GraphQL has 3 operation types:
@ -195,7 +196,7 @@ type Alias = Name
-- | Fragment definition.
data FragmentDefinition
= FragmentDefinition Name TypeCondition [Directive] SelectionSet
= FragmentDefinition Name TypeCondition [Directive] SelectionSet Location
deriving (Eq, Show)
-- | Type condition.

14
src/Language/GraphQL/AST/Encoder.hs
View File

@ -50,8 +50,8 @@ document formatter defs
| Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
where
encodeDocument = foldr executableDefinition [] defs
executableDefinition (ExecutableDefinition x _) acc =
definition formatter x : acc
executableDefinition (ExecutableDefinition executableDefinition') acc =
definition formatter executableDefinition' : acc
executableDefinition _ acc = acc
-- | Converts a t'ExecutableDefinition' into a string.
@ -68,12 +68,12 @@ definition formatter x
-- | Converts a 'OperationDefinition into a string.
operationDefinition :: Formatter -> OperationDefinition -> Lazy.Text
operationDefinition formatter = \case
SelectionSet sels -> selectionSet formatter sels
OperationDefinition Query name vars dirs sels ->
SelectionSet sels _ -> selectionSet formatter sels
OperationDefinition Query name vars dirs sels _ ->
"query " <> node formatter name vars dirs sels
OperationDefinition Mutation name vars dirs sels ->
OperationDefinition Mutation name vars dirs sels _ ->
"mutation " <> node formatter name vars dirs sels
OperationDefinition Subscription name vars dirs sels ->
OperationDefinition Subscription name vars dirs sels _ ->
"subscription " <> node formatter name vars dirs sels
-- | Converts a Query or Mutation into a string.
@ -190,7 +190,7 @@ inlineFragment formatter tc dirs sels = "... on "
<> selectionSet formatter sels
fragmentDefinition :: Formatter -> FragmentDefinition -> Lazy.Text
fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
fragmentDefinition formatter (FragmentDefinition name tc dirs sels _)
= "fragment " <> Lazy.Text.fromStrict name
<> " on " <> Lazy.Text.fromStrict tc
<> optempty (directives formatter) dirs

45
src/Language/GraphQL/AST/Parser.hs
View File

@ -21,7 +21,8 @@ import Language.GraphQL.AST.DirectiveLocation
import Language.GraphQL.AST.Document
import Language.GraphQL.AST.Lexer
import Text.Megaparsec
( SourcePos(..)
( MonadParsec(..)
, SourcePos(..)
, getSourcePos
, lookAhead
, option
@ -37,15 +38,11 @@ document = unicodeBOM
*> lexeme (NonEmpty.some definition)
definition :: Parser Definition
definition = executableDefinition'
definition = ExecutableDefinition <$> executableDefinition
<|> typeSystemDefinition'
<|> typeSystemExtension'
<?> "Definition"
where
executableDefinition' = do
location <- getLocation
definition' <- executableDefinition
pure $ ExecutableDefinition definition' location
typeSystemDefinition' = do
location <- getLocation
definition' <- typeSystemDefinition
@ -349,16 +346,22 @@ operationTypeDefinition = OperationTypeDefinition
<?> "OperationTypeDefinition"
operationDefinition :: Parser OperationDefinition
operationDefinition = SelectionSet <$> selectionSet
operationDefinition = shorthand
<|> operationDefinition'
<?> "OperationDefinition"
where
operationDefinition'
= OperationDefinition <$> operationType
<*> optional name
<*> variableDefinitions
<*> directives
<*> selectionSet
shorthand = do
location <- getLocation
selectionSet' <- selectionSet
pure $ SelectionSet selectionSet' location
operationDefinition' = do
location <- getLocation
operationType' <- operationType
operationName <- optional name
variableDefinitions' <- variableDefinitions
directives' <- directives
selectionSet' <- selectionSet
pure $ OperationDefinition operationType' operationName variableDefinitions' directives' selectionSet' location
operationType :: Parser OperationType
operationType = Query <$ symbol "query"
@ -412,13 +415,15 @@ inlineFragment = InlineFragment
<?> "InlineFragment"
fragmentDefinition :: Parser FragmentDefinition
fragmentDefinition = FragmentDefinition
<$ symbol "fragment"
<*> name
<*> typeCondition
<*> directives
<*> selectionSet
<?> "FragmentDefinition"
fragmentDefinition = label "FragmentDefinition" $ do
location <- getLocation
_ <- symbol "fragment"
fragmentName' <- name
typeCondition' <- typeCondition
directives' <- directives
selectionSet' <- selectionSet
pure $ FragmentDefinition
fragmentName' typeCondition' directives' selectionSet' location
fragmentName :: Parser Name
fragmentName = but (symbol "on") *> name <?> "FragmentName"

24
src/Language/GraphQL/Execute/Execution.hs
View File

@ -83,30 +83,6 @@ resolveAbstractType abstractType values'
_ -> pure Nothing
| otherwise = pure Nothing
doesFragmentTypeApply :: forall m
. CompositeType m
-> Out.ObjectType m
-> Bool
doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
fragmentType == objectType
doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =
instanceOf objectType $ AbstractInterfaceType fragmentType
doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =
instanceOf objectType $ AbstractUnionType fragmentType
instanceOf :: forall m. Out.ObjectType m -> AbstractType m -> Bool
instanceOf objectType (AbstractInterfaceType interfaceType) =
let Out.ObjectType _ _ interfaces _ = objectType
in foldr go False interfaces
where
go objectInterfaceType@(Out.InterfaceType _ _ interfaces _) acc =
acc || foldr go (interfaceType == objectInterfaceType) interfaces
instanceOf objectType (AbstractUnionType unionType) =
let Out.UnionType _ _ members = unionType
in foldr go False members
where
go unionMemberType acc = acc || objectType == unionMemberType
executeField :: (MonadCatch m, Serialize a)
=> Out.Resolver m
-> Type.Value

36
src/Language/GraphQL/Execute/Transform.hs
View File

@ -255,18 +255,18 @@ defragment ast =
in (, fragmentTable) <$> maybe emptyDocument Right nonEmptyOperations
where
defragment' definition (operations, fragments')
| (Full.ExecutableDefinition executable _) <- definition
| (Full.ExecutableDefinition executable) <- definition
, (Full.DefinitionOperation operation') <- executable =
(transform operation' : operations, fragments')
| (Full.ExecutableDefinition executable _) <- definition
| (Full.ExecutableDefinition executable) <- definition
, (Full.DefinitionFragment fragment) <- executable
, (Full.FragmentDefinition name _ _ _) <- fragment =
, (Full.FragmentDefinition name _ _ _ _) <- fragment =
(operations, HashMap.insert name fragment fragments')
defragment' _ acc = acc
transform = \case
Full.OperationDefinition type' name variables directives' selections ->
Full.OperationDefinition type' name variables directives' selections _ ->
OperationDefinition type' name variables directives' selections
Full.SelectionSet selectionSet ->
Full.SelectionSet selectionSet _ ->
OperationDefinition Full.Query Nothing mempty mempty selectionSet
-- * Operation
@ -324,8 +324,8 @@ selection (Full.InlineFragment type' directives' selections) = do
case type' of
Nothing -> pure $ Left fragmentSelectionSet
Just typeName -> do
typeCondition' <- lookupTypeCondition typeName
case typeCondition' of
types' <- gets types
case lookupTypeCondition typeName types' of
Just typeCondition -> pure $
selectionFragment typeCondition fragmentSelectionSet
Nothing -> pure $ Left mempty
@ -364,29 +364,17 @@ collectFragments = do
_ <- fragmentDefinition nextValue
collectFragments
lookupTypeCondition :: Full.Name -> State (Replacement m) (Maybe (CompositeType m))
lookupTypeCondition type' = do
types' <- gets types
case HashMap.lookup type' types' of
Just (ObjectType objectType) ->
lift $ pure $ Just $ CompositeObjectType objectType
Just (UnionType unionType) ->
lift $ pure $ Just $ CompositeUnionType unionType
Just (InterfaceType interfaceType) ->
lift $ pure $ Just $ CompositeInterfaceType interfaceType
_ -> lift $ pure Nothing
fragmentDefinition
:: Full.FragmentDefinition
-> State (Replacement m) (Maybe (Fragment m))
fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
fragmentDefinition (Full.FragmentDefinition name type' _ selections _) = do
modify deleteFragmentDefinition
fragmentSelection <- appendSelection selections
compositeType <- lookupTypeCondition type'
types' <- gets types
case compositeType of
Just compositeType' -> do
let newValue = Fragment compositeType' fragmentSelection
case lookupTypeCondition type' types' of
Just compositeType -> do
let newValue = Fragment compositeType fragmentSelection
modify $ insertFragment newValue
lift $ pure $ Just newValue
_ -> lift $ pure Nothing

39
src/Language/GraphQL/Type/Internal.hs
View File

@ -8,6 +8,9 @@ module Language.GraphQL.Type.Internal
( AbstractType(..)
, CompositeType(..)
, collectReferencedTypes
, doesFragmentTypeApply
, instanceOf
, lookupTypeCondition
) where
import Data.HashMap.Strict (HashMap)
@ -89,3 +92,39 @@ collectReferencedTypes schema =
polymorphicTraverser interfaces fields
= flip (foldr visitFields) fields
. flip (foldr traverseInterfaceType) interfaces
doesFragmentTypeApply :: forall m
. CompositeType m
-> Out.ObjectType m
-> Bool
doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
fragmentType == objectType
doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =
instanceOf objectType $ AbstractInterfaceType fragmentType
doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =
instanceOf objectType $ AbstractUnionType fragmentType
instanceOf :: forall m. Out.ObjectType m -> AbstractType m -> Bool
instanceOf objectType (AbstractInterfaceType interfaceType) =
let Out.ObjectType _ _ interfaces _ = objectType
in foldr go False interfaces
where
go objectInterfaceType@(Out.InterfaceType _ _ interfaces _) acc =
acc || foldr go (interfaceType == objectInterfaceType) interfaces
instanceOf objectType (AbstractUnionType unionType) =
let Out.UnionType _ _ members = unionType
in foldr go False members
where
go unionMemberType acc = acc || objectType == unionMemberType
lookupTypeCondition :: forall m
. Name
-> HashMap Name (Type m)
-> Maybe (CompositeType m)
lookupTypeCondition type' types' =
case HashMap.lookup type' types' of
Just (ObjectType objectType) -> Just $ CompositeObjectType objectType
Just (UnionType unionType) -> Just $ CompositeUnionType unionType
Just (InterfaceType interfaceType) ->
Just $ CompositeInterfaceType interfaceType
_ -> Nothing

72
src/Language/GraphQL/Validate.hs
View File

@ -13,22 +13,19 @@ module Language.GraphQL.Validate
, module Language.GraphQL.Validate.Rules
) where
import Control.Monad.Trans.Reader (Reader, asks, runReader)
import Control.Monad (foldM)
import Control.Monad.Trans.Reader (Reader, asks, mapReaderT, runReader)
import Data.Foldable (foldrM)
import Data.Sequence (Seq(..), (><), (|>))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Language.GraphQL.AST.Document
import Language.GraphQL.Type.Schema
import Language.GraphQL.Type.Internal
import Language.GraphQL.Type.Schema (Schema(..))
import Language.GraphQL.Validate.Rules
import Language.GraphQL.Validate.Validation
data Context m = Context
{ ast :: Document
, schema :: Schema m
, rules :: [Rule]
}
type ValidateT m = Reader (Context m) (Seq Error)
type ValidateT m = Reader (Validation m) (Seq Error)
-- | If an error can be associated to a particular field in the GraphQL result,
-- it must contain an entry with the key path that details the path of the
@ -48,36 +45,46 @@ data Error = Error
-- | Validates a document and returns a list of found errors. If the returned
-- list is empty, the document is valid.
document :: forall m. Schema m -> [Rule] -> Document -> Seq Error
document :: forall m. Schema m -> [Rule m] -> Document -> Seq Error
document schema' rules' document' =
runReader (foldrM go Seq.empty document') context
where
context = Context
context = Validation
{ ast = document'
, schema = schema'
, types = collectReferencedTypes schema'
, rules = rules'
}
go definition' accumulator = (accumulator ><) <$> definition definition'
definition :: forall m. Definition -> ValidateT m
definition = \case
definition'@(ExecutableDefinition executableDefinition' _) -> do
definition'@(ExecutableDefinition executableDefinition') -> do
applied <- applyRules definition'
children <- executableDefinition executableDefinition'
pure $ children >< applied
definition' -> applyRules definition'
where
applyRules definition' = foldr (ruleFilter definition') Seq.empty
<$> asks rules
ruleFilter definition' (DefinitionRule rule) accumulator
| Just message' <- rule definition' =
accumulator |> Error
{ message = message'
, locations = [definitionLocation definition']
, path = []
}
| otherwise = accumulator
definitionLocation (ExecutableDefinition _ location) = location
applyRules definition' =
asks rules >>= foldM (ruleFilter definition') Seq.empty
ruleFilter definition' accumulator (DefinitionRule rule) =
flip mapReaderT (rule definition') $ \case
Just message' ->
pure $ accumulator |> Error
{ message = message'
, locations = [definitionLocation definition']
, path = []
}
Nothing -> pure accumulator
ruleFilter _ accumulator _ = pure accumulator
definitionLocation (ExecutableDefinition executableDefinition')
| DefinitionOperation definitionOperation <- executableDefinition'
, SelectionSet _ location <- definitionOperation = location
| DefinitionOperation definitionOperation <- executableDefinition'
, OperationDefinition _ _ _ _ _ location <- definitionOperation =
location
| DefinitionFragment fragmentDefinition' <- executableDefinition'
, FragmentDefinition _ _ _ _ location <- fragmentDefinition' = location
definitionLocation (TypeSystemDefinition _ location) = location
definitionLocation (TypeSystemExtension _ location) = location
@ -88,10 +95,21 @@ executableDefinition (DefinitionFragment definition') =
fragmentDefinition definition'
operationDefinition :: forall m. OperationDefinition -> ValidateT m
operationDefinition (SelectionSet _operation) =
pure Seq.empty
operationDefinition (OperationDefinition _type _name _variables _directives _selection) =
pure Seq.empty
operationDefinition operation =
asks rules >>= foldM (ruleFilter operation) Seq.empty
where
ruleFilter definition' accumulator (OperationDefinitionRule rule) =
flip mapReaderT (rule definition') $ \case
Just message' ->
pure $ accumulator |> Error
{ message = message'
, locations = [definitionLocation operation]
, path = []
}
Nothing -> pure accumulator
ruleFilter _ accumulator _ = pure accumulator
definitionLocation (SelectionSet _ location) = location
definitionLocation (OperationDefinition _ _ _ _ _ location) = location
fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m
fragmentDefinition _fragment = pure Seq.empty

93
src/Language/GraphQL/Validate/Rules.hs
View File

@ -2,30 +2,99 @@
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
-- | This module contains default rules defined in the GraphQL specification.
module Language.GraphQL.Validate.Rules
( Rule(..)
, executableDefinitionsRule
( executableDefinitionsRule
, specifiedRules
) where
import Control.Monad (foldM)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Reader (asks)
import Control.Monad.Trans.State (evalStateT, gets, modify)
import qualified Data.HashSet as HashSet
import qualified Data.Text as Text
import Language.GraphQL.AST.Document
-- | 'Rule' assigns a function to each AST node that can be validated. If the
-- validation fails, the function should return an error message, or 'Nothing'
-- otherwise.
newtype Rule
= DefinitionRule (Definition -> Maybe String)
import Language.GraphQL.Type.Internal
import qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Validate.Validation
-- | Default rules given in the specification.
specifiedRules :: [Rule]
specifiedRules :: forall m. [Rule m]
specifiedRules =
[ executableDefinitionsRule
, singleFieldSubscriptionsRule
]
-- | Definition must be OperationDefinition or FragmentDefinition.
executableDefinitionsRule :: Rule
executableDefinitionsRule :: forall m. Rule m
executableDefinitionsRule = DefinitionRule go
where
go (ExecutableDefinition _definition _) = Nothing
go _ = Just "Definition must be OperationDefinition or FragmentDefinition."
go :: Definition -> RuleT m
go (ExecutableDefinition _) = lift Nothing
go _ = pure
"Definition must be OperationDefinition or FragmentDefinition."
-- | Subscription operations must have exactly one root field.
singleFieldSubscriptionsRule :: forall m. Rule m
singleFieldSubscriptionsRule = OperationDefinitionRule go
where
go (OperationDefinition Subscription name' _ _ rootFields _) = do
groupedFieldSet <- evalStateT (collectFields rootFields) HashSet.empty
case HashSet.size groupedFieldSet of
1 -> lift Nothing
_
| Just name <- name' -> pure $ unwords
[ "Subscription"
, Text.unpack name
, "must select only one top level field."
]
| otherwise -> pure
"Anonymous Subscription must select only one top level field."
go _ = lift Nothing
collectFields selectionSet = foldM forEach HashSet.empty selectionSet
forEach accumulator (Field alias name _ directives _)
| any skip directives = pure accumulator
| Just aliasedName <- alias = pure
$ HashSet.insert aliasedName accumulator
| otherwise = pure $ HashSet.insert name accumulator
forEach accumulator (FragmentSpread fragmentName directives)
| any skip directives = pure accumulator
| otherwise = do
inVisitetFragments <- gets $ HashSet.member fragmentName
if inVisitetFragments
then pure accumulator
else collectFromSpread fragmentName accumulator
forEach accumulator (InlineFragment typeCondition' directives selectionSet)
| any skip directives = pure accumulator
| Just typeCondition <- typeCondition' =
collectFromFragment typeCondition selectionSet accumulator
| otherwise = HashSet.union accumulator
<$> collectFields selectionSet
skip (Directive "skip" [Argument "if" (Boolean True)]) = True
skip (Directive "include" [Argument "if" (Boolean False)]) = True
skip _ = False
findFragmentDefinition (ExecutableDefinition executableDefinition) Nothing
| DefinitionFragment fragmentDefinition <- executableDefinition =
Just fragmentDefinition
findFragmentDefinition _ accumulator = accumulator
collectFromFragment typeCondition selectionSet accumulator = do
types' <- lift $ asks types
schema' <- lift $ asks schema
case lookupTypeCondition typeCondition types' of
Nothing -> pure accumulator
Just compositeType
| Just objectType <- Schema.subscription schema'
, True <- doesFragmentTypeApply compositeType objectType ->
HashSet.union accumulator<$> collectFields selectionSet
| otherwise -> pure accumulator
collectFromSpread fragmentName accumulator = do
modify $ HashSet.insert fragmentName
ast' <- lift $ asks ast
case foldr findFragmentDefinition Nothing ast' of
Nothing -> pure accumulator
Just (FragmentDefinition _ typeCondition _ selectionSet _) ->
collectFromFragment typeCondition selectionSet accumulator

34
src/Language/GraphQL/Validate/Validation.hs Normal file
View File

@ -0,0 +1,34 @@
{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
-- | Definitions used by the validation rules and the validator itself.
module Language.GraphQL.Validate.Validation
( Validation(..)
, Rule(..)
, RuleT
) where
import Control.Monad.Trans.Reader (ReaderT(..))
import Data.HashMap.Strict (HashMap)
import Language.GraphQL.AST.Document
import Language.GraphQL.Type.Schema (Schema)
import qualified Language.GraphQL.Type.Schema as Schema
-- | Validation rule context.
data Validation m = Validation
{ ast :: Document
, schema :: Schema m
, types :: HashMap Name (Schema.Type m)
, rules :: [Rule m]
}
-- | 'Rule' assigns a function to each AST node that can be validated. If the
-- validation fails, the function should return an error message, or 'Nothing'
-- otherwise.
data Rule m
= DefinitionRule (Definition -> RuleT m)
| OperationDefinitionRule (OperationDefinition -> RuleT m)
-- | Monad transformer used by the rules.
type RuleT m = ReaderT (Validation m) Maybe String

4
tests/Language/GraphQL/AST/EncoderSpec.hs
View File

@ -123,7 +123,9 @@ spec = do
it "indents block strings in arguments" $
let arguments = [Argument "message" (String "line1\nline2")]
field = Field Nothing "field" arguments [] []
operation = DefinitionOperation $ SelectionSet $ pure field
operation = DefinitionOperation
$ SelectionSet (pure field)
$ Location 0 0
in definition pretty operation `shouldBe` [r|{
field(message: """
line1

42
tests/Language/GraphQL/ValidateSpec.hs
View File

@ -148,7 +148,7 @@ validate queryString =
spec :: Spec
spec =
describe "document" $
describe "document" $ do
it "rejects type definitions" $
let queryString = [r|
query getDogName {
@ -169,3 +169,43 @@ spec =
, path = []
}
in validate queryString `shouldBe` Seq.singleton expected
it "rejects multiple subscription root fields" $
let queryString = [r|
subscription sub {
newMessage {
body
sender
}
disallowedSecondRootField
}
|]
expected = Error
{ message =
"Subscription sub must select only one top level field."
, locations = [AST.Location 2 15]
, path = []
}
in validate queryString `shouldBe` Seq.singleton expected
it "rejects multiple subscription root fields coming from a fragment" $
let queryString = [r|
subscription sub {
...multipleSubscriptions
}
fragment multipleSubscriptions on Subscription {
newMessage {
body
sender
}
disallowedSecondRootField
}
|]
expected = Error
{ message =
"Subscription sub must select only one top level field."
, locations = [AST.Location 2 15]
, path = []
}
in validate queryString `shouldBe` Seq.singleton expected