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

Change execute' to shouldResolveTo helper method

Browse Source
This commit is contained in:
Eugen Wissner 2022-07-01 12:18:02 +02:00
parent 0dac9701bc
commit 2f19093803
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 63 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
graphql.cabal
View File

@ -111,6 +111,7 @@ test-suite graphql-test
exceptions, exceptions,
graphql, graphql,
hspec ^>= 2.9.1, hspec ^>= 2.9.1,
hspec-expectations ^>= 0.8.2,
hspec-megaparsec ^>= 2.2.0, hspec-megaparsec ^>= 2.2.0,
megaparsec, megaparsec,
text, text,

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

@ -101,7 +101,7 @@ variableDefinition formatter variableDefinition' =
in variable variableName in variable variableName
<> eitherFormat formatter ": " ":" <> eitherFormat formatter ": " ":"
<> type' variableType <> type' variableType
<> maybe mempty (defaultValue formatter) (Full.node <$> defaultValue') <> maybe mempty (defaultValue formatter . Full.node) defaultValue'
defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text
defaultValue formatter val defaultValue formatter val

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

@ -54,7 +54,7 @@ import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet) import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet import qualified Data.HashSet as HashSet
import Data.List (groupBy, sortBy, sortOn) import Data.List (groupBy, sortBy, sortOn)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe) import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Sequence (Seq(..), (|>)) import Data.Sequence (Seq(..), (|>))
@ -1551,9 +1551,9 @@ valuesOfCorrectTypeRule = ValueRule go constGo
toConst Full.Null = Just Full.ConstNull toConst Full.Null = Just Full.ConstNull
toConst (Full.Enum enum) = Just $ Full.ConstEnum enum toConst (Full.Enum enum) = Just $ Full.ConstEnum enum
toConst (Full.List values) = toConst (Full.List values) =
Just $ Full.ConstList $ catMaybes $ toConstNode <$> values Just $ Full.ConstList $ mapMaybe toConstNode values
toConst (Full.Object fields) = Just $ Full.ConstObject toConst (Full.Object fields) = Just $ Full.ConstObject
$ catMaybes $ constObjectField <$> fields $ mapMaybe constObjectField fields
constObjectField Full.ObjectField{..} constObjectField Full.ObjectField{..}
| Just constValue <- toConstNode value = | Just constValue <- toConstNode value =
Just $ Full.ObjectField name constValue location Just $ Full.ObjectField name constValue location

109
tests/Language/GraphQL/ExecuteSpec.hs
View File

@ -2,6 +2,8 @@
v. 2.0. If a copy of the MPL was not distributed with this file, You can 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/. -} obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
@ -9,7 +11,7 @@ module Language.GraphQL.ExecuteSpec
( spec ( spec
) where ) where
import Control.Exception (Exception(..), SomeException) import Control.Exception (Exception(..), SomeException, throwIO)
import Control.Monad.Catch (throwM) import Control.Monad.Catch (throwM)
import Data.Conduit import Data.Conduit
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
@ -27,11 +29,16 @@ import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type.Out as Out
import Prelude hiding (id) import Prelude hiding (id)
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.Megaparsec (parse) import Text.Megaparsec (parse, errorBundlePretty)
import Schemas.HeroSchema (heroSchema) import Schemas.HeroSchema (heroSchema)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import qualified Data.Text as Text import qualified Data.Text as Text
import Test.Hspec.Expectations
( Expectation
, expectationFailure
)
import Data.Either (fromRight)
data PhilosopherException = PhilosopherException data PhilosopherException = PhilosopherException
deriving Show deriving Show
@ -195,9 +202,17 @@ type EitherStreamOrValue = Either
(ResponseEventStream (Either SomeException) Type.Value) (ResponseEventStream (Either SomeException) Type.Value)
(Response Type.Value) (Response Type.Value)
execute' :: Document -> Either SomeException EitherStreamOrValue -- Asserts that a query resolves to a value.
execute' = shouldResolveTo :: Text.Text -> Response Type.Value -> Expectation
execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value) shouldResolveTo querySource expected =
case parse document "" querySource of
(Right parsedDocument) ->
case execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value) parsedDocument of
Right (Right result) -> shouldBe result expected
Right (Left _) -> expectationFailure
"the query is expected to resolve to a value, but it resolved to an event stream"
Left executionError -> throwIO executionError
(Left errorBundle) -> expectationFailure $ errorBundlePretty errorBundle
spec :: Spec spec :: Spec
spec = spec =
@ -213,9 +228,7 @@ spec =
} }
|] |]
expected = Response (Object mempty) mempty expected = Response (Object mempty) mempty
Right (Right actual) = either (pure . parseError) execute' in sourceQuery `shouldResolveTo` expected
$ parse document "" sourceQuery
in actual `shouldBe` expected
context "Query" $ do context "Query" $ do
it "skips unknown fields" $ it "skips unknown fields" $
@ -225,9 +238,8 @@ spec =
$ HashMap.singleton "firstName" $ HashMap.singleton "firstName"
$ String "Friedrich" $ String "Friedrich"
expected = Response data'' mempty expected = Response data'' mempty
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ philosopher { firstName surname } }"
$ parse document "" "{ philosopher { firstName surname } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "merges selections" $ it "merges selections" $
let data'' = Object let data'' = Object
$ HashMap.singleton "philosopher" $ HashMap.singleton "philosopher"
@ -237,9 +249,8 @@ spec =
, ("lastName", String "Nietzsche") , ("lastName", String "Nietzsche")
] ]
expected = Response data'' mempty expected = Response data'' mempty
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ philosopher { firstName } philosopher { lastName } }"
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "errors on invalid output enum values" $ it "errors on invalid output enum values" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
@ -250,9 +261,8 @@ spec =
, path = [Segment "philosopher", Segment "school"] , path = [Segment "philosopher", Segment "school"]
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ philosopher { school } }"
$ parse document "" "{ philosopher { school } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "gives location information for non-null unions" $ it "gives location information for non-null unions" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
@ -263,9 +273,8 @@ spec =
, path = [Segment "philosopher", Segment "interest"] , path = [Segment "philosopher", Segment "interest"]
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ philosopher { interest } }"
$ parse document "" "{ philosopher { interest } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "gives location information for invalid interfaces" $ it "gives location information for invalid interfaces" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
@ -277,9 +286,8 @@ spec =
, path = [Segment "philosopher", Segment "majorWork"] , path = [Segment "philosopher", Segment "majorWork"]
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ philosopher { majorWork { title } } }"
$ parse document "" "{ philosopher { majorWork { title } } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "gives location information for invalid scalar arguments" $ it "gives location information for invalid scalar arguments" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
@ -290,9 +298,8 @@ spec =
, path = [Segment "philosopher"] , path = [Segment "philosopher"]
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ philosopher(id: true) { lastName } }"
$ parse document "" "{ philosopher(id: true) { lastName } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "gives location information for failed result coercion" $ it "gives location information for failed result coercion" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
@ -302,9 +309,8 @@ spec =
, path = [Segment "philosopher", Segment "century"] , path = [Segment "philosopher", Segment "century"]
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ philosopher(id: \"1\") { century } }"
$ parse document "" "{ philosopher(id: \"1\") { century } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "gives location information for failed result coercion" $ it "gives location information for failed result coercion" $
let data'' = Object $ HashMap.singleton "genres" Null let data'' = Object $ HashMap.singleton "genres" Null
@ -314,9 +320,8 @@ spec =
, path = [Segment "genres"] , path = [Segment "genres"]
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ genres }"
$ parse document "" "{ genres }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "sets data to null if a root field isn't nullable" $ it "sets data to null if a root field isn't nullable" $
let executionErrors = pure $ Error let executionErrors = pure $ Error
@ -325,9 +330,8 @@ spec =
, path = [Segment "count"] , path = [Segment "count"]
} }
expected = Response Null executionErrors expected = Response Null executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ count }"
$ parse document "" "{ count }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
it "detects nullability errors" $ it "detects nullability errors" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
@ -337,30 +341,31 @@ spec =
, path = [Segment "philosopher", Segment "firstLanguage"] , path = [Segment "philosopher", Segment "firstLanguage"]
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "{ philosopher(id: \"1\") { firstLanguage } }"
$ parse document "" "{ philosopher(id: \"1\") { firstLanguage } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
context "queryError" $ do context "queryError" $ do
let let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"
namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }" twoQueries = namedQuery "A" <> " " <> namedQuery "B"
twoQueries = namedQuery "A" <> " " <> namedQuery "B" startsWith :: Text.Text -> Text.Text -> Bool
startsWith :: Text.Text -> Text.Text -> Bool startsWith xs ys = Text.take (Text.length ys) xs == ys
startsWith xs ys = Text.take (Text.length ys) xs == ys
it "throws operation name is required error" $ it "throws operation name is required error" $
let expectedErrorMessage :: Text.Text let expectedErrorMessage :: Text.Text
expectedErrorMessage = "Operation name is required" expectedErrorMessage = "Operation name is required"
Right (Right (Response _ executionErrors)) = either (pure . parseError) execute' $ parse document "" twoQueries execute' :: Document -> Either SomeException EitherStreamOrValue
execute' = execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value)
Right (Right (Response _ executionErrors)) = either (pure . parseError) execute'
$ parse document "" twoQueries
Error msg _ _ = Seq.index executionErrors 0 Error msg _ _ = Seq.index executionErrors 0
in msg `startsWith` expectedErrorMessage `shouldBe` True in msg `startsWith` expectedErrorMessage `shouldBe` True
it "throws operation not found error" $ it "throws operation not found error" $
let expectedErrorMessage :: Text.Text let expectedErrorMessage :: Text.Text
expectedErrorMessage = "Operation \"C\" is not found" expectedErrorMessage = "Operation \"C\" is not found"
execute'' :: Document -> Either SomeException EitherStreamOrValue execute' :: Document -> Either SomeException EitherStreamOrValue
execute'' = execute philosopherSchema (Just "C") (mempty :: HashMap Name Type.Value) execute' = execute philosopherSchema (Just "C") (mempty :: HashMap Name Type.Value)
Right (Right (Response _ executionErrors)) = either (pure . parseError) execute'' Right (Right (Response _ executionErrors)) = either (pure . parseError) execute'
$ parse document "" twoQueries $ parse document "" twoQueries
Error msg _ _ = Seq.index executionErrors 0 Error msg _ _ = Seq.index executionErrors 0
in msg `startsWith` expectedErrorMessage `shouldBe` True in msg `startsWith` expectedErrorMessage `shouldBe` True
@ -387,9 +392,8 @@ spec =
, path = [] , path = []
} }
expected = Response data'' executionErrors expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute' sourceQuery = "query($id: Cat) { philosopher(id: \"1\") { firstLanguage } }"
$ parse document "" "query($id: Cat) { philosopher(id: \"1\") { firstLanguage } }" in sourceQuery `shouldResolveTo` expected
in actual `shouldBe` expected
context "Error path" $ do context "Error path" $ do
let executeHero :: Document -> Either SomeException EitherStreamOrValue let executeHero :: Document -> Either SomeException EitherStreamOrValue
@ -411,7 +415,10 @@ spec =
$ HashMap.singleton "quote" $ HashMap.singleton "quote"
$ String "Naturam expelles furca, tamen usque recurret." $ String "Naturam expelles furca, tamen usque recurret."
expected = Response data'' mempty expected = Response data'' mempty
Right (Left stream) = either (pure . parseError) execute' Left stream
= fromRight (error "Execution error")
$ execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value)
$ fromRight (error "Parse error")
$ parse document "" "subscription { newQuote { quote } }" $ parse document "" "subscription { newQuote { quote } }"
Right (Just actual) = runConduit $ stream .| await Right (Just actual) = runConduit $ stream .| await
in actual `shouldBe` expected in actual `shouldBe` expected