From fdd627bf5d7ae7a78f716ffb2245710e5e200477 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sat, 20 Nov 2021 07:20:31 +0100 Subject: [PATCH] Move functional tests --- graphql-spice.cabal | 29 ++- tests/Language/GraphQL/DirectiveSpec.hs | 92 +++++++++ tests/Language/GraphQL/FragmentSpec.hs | 204 ++++++++++++++++++++ tests/Language/GraphQL/RootOperationSpec.hs | 72 +++++++ tests/Spec.hs | 1 + 5 files changed, 394 insertions(+), 4 deletions(-) create mode 100644 tests/Language/GraphQL/DirectiveSpec.hs create mode 100644 tests/Language/GraphQL/FragmentSpec.hs create mode 100644 tests/Language/GraphQL/RootOperationSpec.hs create mode 100644 tests/Spec.hs diff --git a/graphql-spice.cabal b/graphql-spice.cabal index 0ac60af..8a06f3a 100644 --- a/graphql-spice.cabal +++ b/graphql-spice.cabal @@ -5,10 +5,8 @@ version: 0.1.0.0 synopsis: GraphQL with batteries description: Various extensions and convenience functions for the core graphql package. - --- A URL where users can report bugs. --- bug-reports: - +homepage: https://www.caraus.tech/projects/pub-graphql-spice +bug-reports: https://www.caraus.tech/projects/pub-graphql-spice/issues license: MPL-2.0 license-files: LICENSE author: Eugen Wissner @@ -17,6 +15,8 @@ maintainer: belka@caraus.de copyright: (c) 2021 Eugen Wissner category: Language extra-source-files: CHANGELOG.md +tested-with: + GHC == 8.10.7 source-repository head type: git @@ -29,6 +29,27 @@ library hs-source-dirs: src ghc-options: -Wall build-depends: +-- aeson >= 2.0.2.0 && < 2.1 base ^>=4.14.3.0 , graphql >= 1.0.1.0 && < 1.1 default-language: Haskell2010 + + +test-suite graphql-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Language.GraphQL.DirectiveSpec + Language.GraphQL.FragmentSpec + Language.GraphQL.RootOperationSpec + hs-source-dirs: + tests + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + aeson + , base >= 4.8 && < 5 + , graphql + , hspec >= 2.9.1 && < 3 + , text + , unordered-containers + default-language: Haskell2010 diff --git a/tests/Language/GraphQL/DirectiveSpec.hs b/tests/Language/GraphQL/DirectiveSpec.hs new file mode 100644 index 0000000..40f6215 --- /dev/null +++ b/tests/Language/GraphQL/DirectiveSpec.hs @@ -0,0 +1,92 @@ +{- 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/. -} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Language.GraphQL.DirectiveSpec + ( spec + ) where + +import Data.Aeson (object, (.=)) +import qualified Data.Aeson as Aeson +import qualified Data.HashMap.Strict as HashMap +import Language.GraphQL +import Language.GraphQL.TH +import Language.GraphQL.Type +import qualified Language.GraphQL.Type.Out as Out +import Test.Hspec (Spec, describe, it) +import Test.Hspec.GraphQL + +experimentalResolver :: Schema IO +experimentalResolver = schema queryType Nothing Nothing mempty + where + queryType = Out.ObjectType "Query" Nothing [] + $ HashMap.singleton "experimentalField" + $ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty) + $ pure $ Int 5 + +emptyObject :: Aeson.Object +emptyObject = HashMap.singleton "data" $ object [] + +spec :: Spec +spec = + describe "Directive executor" $ do + it "should be able to @skip fields" $ do + let sourceQuery = [gql| + { + experimentalField @skip(if: true) + } + |] + + actual <- graphql experimentalResolver sourceQuery + actual `shouldResolveTo` emptyObject + + it "should not skip fields if @skip is false" $ do + let sourceQuery = [gql| + { + experimentalField @skip(if: false) + } + |] + expected = HashMap.singleton "data" + $ object + [ "experimentalField" .= (5 :: Int) + ] + actual <- graphql experimentalResolver sourceQuery + actual `shouldResolveTo` expected + + it "should skip fields if @include is false" $ do + let sourceQuery = [gql| + { + experimentalField @include(if: false) + } + |] + + actual <- graphql experimentalResolver sourceQuery + actual `shouldResolveTo` emptyObject + + it "should be able to @skip a fragment spread" $ do + let sourceQuery = [gql| + { + ...experimentalFragment @skip(if: true) + } + + fragment experimentalFragment on Query { + experimentalField + } + |] + + actual <- graphql experimentalResolver sourceQuery + actual `shouldResolveTo` emptyObject + + it "should be able to @skip an inline fragment" $ do + let sourceQuery = [gql| + { + ... on Query @skip(if: true) { + experimentalField + } + } + |] + + actual <- graphql experimentalResolver sourceQuery + actual `shouldResolveTo` emptyObject diff --git a/tests/Language/GraphQL/FragmentSpec.hs b/tests/Language/GraphQL/FragmentSpec.hs new file mode 100644 index 0000000..b7902d9 --- /dev/null +++ b/tests/Language/GraphQL/FragmentSpec.hs @@ -0,0 +1,204 @@ +{- 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/. -} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Language.GraphQL.FragmentSpec + ( spec + ) where + +import Data.Aeson ((.=)) +import qualified Data.Aeson as Aeson +import qualified Data.HashMap.Strict as HashMap +import Data.Text (Text) +import Language.GraphQL +import Language.GraphQL.Type +import qualified Language.GraphQL.Type.Out as Out +import Language.GraphQL.TH +import Test.Hspec (Spec, describe, it) +import Test.Hspec.GraphQL + +size :: (Text, Value) +size = ("size", String "L") + +circumference :: (Text, Value) +circumference = ("circumference", Int 60) + +garment :: Text -> (Text, Value) +garment typeName = + ("garment", Object $ HashMap.fromList + [ if typeName == "Hat" then circumference else size + , ("__typename", String typeName) + ] + ) + +inlineQuery :: Text +inlineQuery = [gql| + { + garment { + ... on Hat { + circumference + } + ... on Shirt { + size + } + } + } +|] + +shirtType :: Out.ObjectType IO +shirtType = Out.ObjectType "Shirt" Nothing [] $ HashMap.fromList + [ ("size", sizeFieldType) + ] + +hatType :: Out.ObjectType IO +hatType = Out.ObjectType "Hat" Nothing [] $ HashMap.fromList + [ ("size", sizeFieldType) + , ("circumference", circumferenceFieldType) + ] + +circumferenceFieldType :: Out.Resolver IO +circumferenceFieldType + = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty) + $ pure $ snd circumference + +sizeFieldType :: Out.Resolver IO +sizeFieldType + = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty) + $ pure $ snd size + +toSchema :: Text -> (Text, Value) -> Schema IO +toSchema t (_, resolve) = schema queryType Nothing Nothing mempty + where + garmentType = Out.UnionType "Garment" Nothing [hatType, shirtType] + typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty + garmentField = Out.Field Nothing (Out.NamedUnionType garmentType) mempty + queryType = + case t of + "circumference" -> hatType + "size" -> shirtType + _ -> Out.ObjectType "Query" Nothing [] + $ HashMap.fromList + [ ("garment", ValueResolver garmentField (pure resolve)) + , ("__typename", ValueResolver typeNameField (pure $ String "Shirt")) + ] + +spec :: Spec +spec = do + describe "Inline fragment executor" $ do + it "chooses the first selection if the type matches" $ do + actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery + let expected = HashMap.singleton "data" + $ Aeson.object + [ "garment" .= Aeson.object + [ "circumference" .= (60 :: Int) + ] + ] + in actual `shouldResolveTo` expected + + it "chooses the last selection if the type matches" $ do + actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery + let expected = HashMap.singleton "data" + $ Aeson.object + [ "garment" .= Aeson.object + [ "size" .= ("L" :: Text) + ] + ] + in actual `shouldResolveTo` expected + + it "embeds inline fragments without type" $ do + let sourceQuery = [gql| + { + circumference + ... { + size + } + } + |] + actual <- graphql (toSchema "circumference" circumference) sourceQuery + let expected = HashMap.singleton "data" + $ Aeson.object + [ "circumference" .= (60 :: Int) + , "size" .= ("L" :: Text) + ] + in actual `shouldResolveTo` expected + + it "evaluates fragments on Query" $ do + let sourceQuery = [gql| + { + ... { + size + } + } + |] + in graphql (toSchema "size" size) `shouldResolve` sourceQuery + + describe "Fragment spread executor" $ do + it "evaluates fragment spreads" $ do + let sourceQuery = [gql| + { + ...circumferenceFragment + } + + fragment circumferenceFragment on Hat { + circumference + } + |] + + actual <- graphql (toSchema "circumference" circumference) sourceQuery + let expected = HashMap.singleton "data" + $ Aeson.object + [ "circumference" .= (60 :: Int) + ] + in actual `shouldResolveTo` expected + + it "evaluates nested fragments" $ do + let sourceQuery = [gql| + { + garment { + ...circumferenceFragment + } + } + + fragment circumferenceFragment on Hat { + ...hatFragment + } + + fragment hatFragment on Hat { + circumference + } + |] + + actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery + let expected = HashMap.singleton "data" + $ Aeson.object + [ "garment" .= Aeson.object + [ "circumference" .= (60 :: Int) + ] + ] + in actual `shouldResolveTo` expected + + it "considers type condition" $ do + let sourceQuery = [gql| + { + garment { + ...circumferenceFragment + ...sizeFragment + } + } + fragment circumferenceFragment on Hat { + circumference + } + fragment sizeFragment on Shirt { + size + } + |] + expected = HashMap.singleton "data" + $ Aeson.object + [ "garment" .= Aeson.object + [ "circumference" .= (60 :: Int) + ] + ] + actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery + actual `shouldResolveTo` expected diff --git a/tests/Language/GraphQL/RootOperationSpec.hs b/tests/Language/GraphQL/RootOperationSpec.hs new file mode 100644 index 0000000..3c4779d --- /dev/null +++ b/tests/Language/GraphQL/RootOperationSpec.hs @@ -0,0 +1,72 @@ +{- 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/. -} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Language.GraphQL.RootOperationSpec + ( spec + ) where + +import Data.Aeson ((.=), object) +import qualified Data.HashMap.Strict as HashMap +import Language.GraphQL +import Test.Hspec (Spec, describe, it) +import Language.GraphQL.TH +import Language.GraphQL.Type +import qualified Language.GraphQL.Type.Out as Out +import Test.Hspec.GraphQL + +hatType :: Out.ObjectType IO +hatType = Out.ObjectType "Hat" Nothing [] + $ HashMap.singleton "circumference" + $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty) + $ pure $ Int 60 + +garmentSchema :: Schema IO +garmentSchema = schema queryType (Just mutationType) Nothing mempty + where + queryType = Out.ObjectType "Query" Nothing [] hatFieldResolver + mutationType = Out.ObjectType "Mutation" Nothing [] incrementFieldResolver + garment = pure $ Object $ HashMap.fromList + [ ("circumference", Int 60) + ] + incrementFieldResolver = HashMap.singleton "incrementCircumference" + $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty) + $ pure $ Int 61 + hatField = Out.Field Nothing (Out.NamedObjectType hatType) mempty + hatFieldResolver = + HashMap.singleton "garment" $ ValueResolver hatField garment + +spec :: Spec +spec = + describe "Root operation type" $ do + it "returns objects from the root resolvers" $ do + let querySource = [gql| + { + garment { + circumference + } + } + |] + expected = HashMap.singleton "data" + $ object + [ "garment" .= object + [ "circumference" .= (60 :: Int) + ] + ] + actual <- graphql garmentSchema querySource + actual `shouldResolveTo` expected + + it "chooses Mutation" $ do + let querySource = [gql| + mutation { + incrementCircumference + } + |] + expected = HashMap.singleton "data" + $ object + [ "incrementCircumference" .= (61 :: Int) + ] + actual <- graphql garmentSchema querySource + actual `shouldResolveTo` expected diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}