From e6a6926e18a032a129936794184b518189207648 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 26 Aug 2020 18:58:48 +0200 Subject: [PATCH] Validate anonymous operation definitions --- README.md | 2 +- src/Language/GraphQL/AST/Document.hs | 6 ++++ src/Language/GraphQL/Validate/Rules.hs | 42 ++++++++++++++++++++------ stack.yaml | 2 +- tests/Language/GraphQL/ValidateSpec.hs | 24 +++++++++++++++ 5 files changed, 64 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index 065645a..ee5bab4 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# GraphQL implementation in Haskell. +# GraphQL implementation in Haskell [![Hackage Version](https://img.shields.io/hackage/v/graphql.svg)](https://hackage.haskell.org/package/graphql) [![Build Status](https://github.com/caraus-ecms/graphql/workflows/Haskell%20CI/badge.svg)](https://github.com/caraus-ecms/graphql/actions?query=workflow%3A%22Haskell+CI%22) diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index f60ddda..72d39bb 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -62,6 +62,12 @@ data Location = Location , column :: Word } deriving (Eq, Show) +instance Ord Location where + compare (Location thisLine thisColumn) (Location thatLine thatColumn) + | thisLine < thatLine = LT + | thisLine > thatLine = GT + | otherwise = compare thisColumn thatColumn + -- ** Document -- | GraphQL document. diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index a3b1a59..466dcae 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -3,6 +3,7 @@ obtain one at https://mozilla.org/MPL/2.0/. -} {-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- | This module contains default rules defined in the GraphQL specification. @@ -27,22 +28,19 @@ specifiedRules :: forall m. [Rule m] specifiedRules = [ executableDefinitionsRule , singleFieldSubscriptionsRule + , loneAnonymousOperationRule ] -- | Definition must be OperationDefinition or FragmentDefinition. executableDefinitionsRule :: forall m. Rule m -executableDefinitionsRule = DefinitionRule go - where - go :: Definition -> RuleT m - go (ExecutableDefinition _) = lift Nothing - go _ = pure - "Definition must be OperationDefinition or FragmentDefinition." +executableDefinitionsRule = DefinitionRule $ \case + ExecutableDefinition _ -> lift Nothing + _ -> 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 +singleFieldSubscriptionsRule = OperationDefinitionRule $ \case + OperationDefinition Subscription name' _ _ rootFields _ -> do groupedFieldSet <- evalStateT (collectFields rootFields) HashSet.empty case HashSet.size groupedFieldSet of 1 -> lift Nothing @@ -54,7 +52,8 @@ singleFieldSubscriptionsRule = OperationDefinitionRule go ] | otherwise -> pure "Anonymous Subscription must select only one top level field." - go _ = lift Nothing + _ -> lift Nothing + where collectFields selectionSet = foldM forEach HashSet.empty selectionSet forEach accumulator (Field alias name _ directives _) | any skip directives = pure accumulator @@ -98,3 +97,26 @@ singleFieldSubscriptionsRule = OperationDefinitionRule go Nothing -> pure accumulator Just (FragmentDefinition _ typeCondition _ selectionSet _) -> collectFromFragment typeCondition selectionSet accumulator + +-- | GraphQL allows a short‐hand form for defining query operations when only +-- that one operation exists in the document. +loneAnonymousOperationRule :: forall m. Rule m +loneAnonymousOperationRule = OperationDefinitionRule $ \case + SelectionSet _ thisLocation -> check thisLocation + OperationDefinition _ Nothing _ _ _ thisLocation -> check thisLocation + _ -> lift Nothing + where + check thisLocation = asks ast + >>= lift . foldr (filterAnonymousOperations thisLocation) Nothing + filterAnonymousOperations thisLocation definition Nothing + | ExecutableDefinition executableDefinition <- definition + , DefinitionOperation operationDefinition <- executableDefinition = + compareAnonymousOperations thisLocation operationDefinition + filterAnonymousOperations _ _ accumulator = accumulator + compareAnonymousOperations thisLocation operationDefinition + | OperationDefinition _ _ _ _ _ thatLocation <- operationDefinition + , thisLocation /= thatLocation = pure message + | SelectionSet _ thatLocation <- operationDefinition + , thisLocation /= thatLocation = pure message + compareAnonymousOperations _ _ = Nothing + message = "This anonymous operation must be the only defined operation." diff --git a/stack.yaml b/stack.yaml index 042ce94..acffb4d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-16.10 +resolver: lts-16.11 packages: - . diff --git a/tests/Language/GraphQL/ValidateSpec.hs b/tests/Language/GraphQL/ValidateSpec.hs index c463dd9..4b5e638 100644 --- a/tests/Language/GraphQL/ValidateSpec.hs +++ b/tests/Language/GraphQL/ValidateSpec.hs @@ -209,3 +209,27 @@ spec = , path = [] } in validate queryString `shouldBe` Seq.singleton expected + + it "rejects multiple anonymous operations" $ + let queryString = [r| + { + dog { + name + } + } + + query getName { + dog { + owner { + name + } + } + } + |] + expected = Error + { message = + "This anonymous operation must be the only defined operation." + , locations = [AST.Location 2 15] + , path = [] + } + in validate queryString `shouldBe` Seq.singleton expected