1 Commits

Author SHA1 Message Date
97d304d283 Fix values not being coerced to lists 2023-10-10 02:37:22 +02:00
14 changed files with 108 additions and 256 deletions

View File

@ -1,52 +0,0 @@
name: Build
on:
push:
branches:
- '**'
pull_request:
branches: [master]
jobs:
audit:
runs-on: haskell
steps:
- name: Set up environment
run: |
apt-get update -y
apt-get upgrade -y
apt-get install -y nodejs pkg-config
- uses: actions/checkout@v4
- name: Install dependencies
run: |
cabal update
cabal install hlint "--constraint=hlint ==3.8"
- run: cabal exec hlint -- src tests
test:
runs-on: haskell
steps:
- name: Set up environment
run: |
apt-get update -y
apt-get upgrade -y
apt-get install -y nodejs pkg-config
- uses: actions/checkout@v4
- name: Install dependencies
run: cabal update
- name: Prepare system
run: cabal build graphql-test
- run: cabal test --test-show-details=streaming
doc:
runs-on: haskell
steps:
- name: Set up environment
run: |
apt-get update -y
apt-get upgrade -y
apt-get install -y nodejs pkg-config
- uses: actions/checkout@v4
- name: Install dependencies
run: cabal update
- run: cabal haddock --enable-documentation

View File

@ -1,23 +0,0 @@
name: Release
on:
push:
tags:
- '**'
jobs:
release:
runs-on: haskell
steps:
- name: Set up environment
run: |
apt-get update -y
apt-get upgrade -y
apt-get install -y nodejs pkg-config
- uses: actions/checkout@v4
- name: Upload a candidate
env:
HACKAGE_PASSWORD: ${{ secrets.HACKAGE_PASSWORD }}
run: |
cabal sdist
cabal upload --username belka --password ${HACKAGE_PASSWORD}

View File

@ -6,21 +6,9 @@ The format is based on
and this project adheres to and this project adheres to
[Haskell Package Versioning Policy](https://pvp.haskell.org/). [Haskell Package Versioning Policy](https://pvp.haskell.org/).
## [1.3.0.0] - 2024-05-01 ## [Unreleased]
### Changed
- Remove deprecated `runCollectErrs`, `Resolution`, `CollectErrsT` from the
`Error` module.
## [1.2.0.3] - 2024-01-09
### Fixed
- Fix corrupted source distribution.
## [1.2.0.2] - 2024-01-09
### Fixed ### Fixed
- `gql` removes not only leading `\n` but also `\r`. - `gql` removes not only leading `\n` but also `\r`.
- Fix non nullable type string representation in executor error messages.
- Fix input objects not being coerced to lists.
- Fix used variables are not found in the properties of input objects.
## [1.2.0.1] - 2023-04-25 ## [1.2.0.1] - 2023-04-25
### Fixed ### Fixed
@ -524,9 +512,7 @@ and this project adheres to
### Added ### Added
- Data types for the GraphQL language. - Data types for the GraphQL language.
[1.3.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.3...v1.3.0.0 [Unreleased]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.1...master
[1.2.0.3]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.2...v1.2.0.3
[1.2.0.2]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.1...v1.2.0.2
[1.2.0.1]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.0...v1.2.0.1 [1.2.0.1]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.0...v1.2.0.1
[1.2.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.1.0.0...v1.2.0.0 [1.2.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.1.0.0...v1.2.0.0
[1.1.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.0.3.0...v1.1.0.0 [1.1.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.0.3.0...v1.1.0.0

View File

@ -1,7 +1,7 @@
cabal-version: 2.4 cabal-version: 2.4
name: graphql name: graphql
version: 1.3.0.0 version: 1.2.0.1
synopsis: Haskell GraphQL implementation synopsis: Haskell GraphQL implementation
description: Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation. description: Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
category: Language category: Language
@ -11,7 +11,7 @@ author: Danny Navarro <j@dannynavarro.net>,
Matthías Páll Gissurarson <mpg@mpg.is>, Matthías Páll Gissurarson <mpg@mpg.is>,
Sólrún Halla Einarsdóttir <she@mpg.is> Sólrún Halla Einarsdóttir <she@mpg.is>
maintainer: belka@caraus.de maintainer: belka@caraus.de
copyright: (c) 2019-2024 Eugen Wissner, copyright: (c) 2019-2023 Eugen Wissner,
(c) 2015-2017 J. Daniel Navarro (c) 2015-2017 J. Daniel Navarro
license: MPL-2.0 AND BSD-3-Clause license: MPL-2.0 AND BSD-3-Clause
license-files: LICENSE, license-files: LICENSE,
@ -21,8 +21,8 @@ extra-source-files:
CHANGELOG.md CHANGELOG.md
README.md README.md
tested-with: tested-with:
GHC == 9.4.7, GHC == 9.2.8,
GHC == 9.6.3 GHC == 9.6.2
source-repository head source-repository head
type: git type: git
@ -60,7 +60,7 @@ library
build-depends: build-depends:
base >= 4.7 && < 5, base >= 4.7 && < 5,
conduit ^>= 1.3.4, conduit ^>= 1.3.4,
containers >= 0.6 && < 0.8, containers ^>= 0.6.2,
exceptions ^>= 0.10.4, exceptions ^>= 0.10.4,
megaparsec >= 9.0 && < 10, megaparsec >= 9.0 && < 10,
parser-combinators >= 1.3 && < 2, parser-combinators >= 1.3 && < 2,
@ -93,7 +93,7 @@ test-suite graphql-test
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
build-depends: build-depends:
QuickCheck >= 2.14 && < 2.16, QuickCheck ^>= 2.14.1,
base, base,
conduit, conduit,
exceptions, exceptions,

View File

@ -371,8 +371,8 @@ data NonNullType
deriving Eq deriving Eq
instance Show NonNullType where instance Show NonNullType where
show (NonNullTypeNamed typeName) = Text.unpack $ typeName <> "!" show (NonNullTypeNamed typeName) = '!' : Text.unpack typeName
show (NonNullTypeList listType) = concat ["[", show listType, "]!"] show (NonNullTypeList listType) = concat ["![", show listType, "]"]
-- ** Directives -- ** Directives

View File

@ -8,22 +8,28 @@
-- | Error handling. -- | Error handling.
module Language.GraphQL.Error module Language.GraphQL.Error
( Error(..) ( CollectErrsT
, Error(..)
, Path(..) , Path(..)
, Resolution(..)
, ResolverException(..) , ResolverException(..)
, Response(..) , Response(..)
, ResponseEventStream , ResponseEventStream
, parseError , parseError
, runCollectErrs
) where ) where
import Conduit import Conduit
import Control.Exception (Exception(..)) import Control.Exception (Exception(..))
import Control.Monad.Trans.State (StateT, runStateT)
import Data.HashMap.Strict (HashMap)
import Data.Sequence (Seq(..), (|>)) import Data.Sequence (Seq(..), (|>))
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Language.GraphQL.AST (Location(..)) import Language.GraphQL.AST (Location(..), Name)
import Language.GraphQL.Execute.Coerce import Language.GraphQL.Execute.Coerce
import qualified Language.GraphQL.Type.Schema as Schema
import Prelude hiding (null) import Prelude hiding (null)
import Text.Megaparsec import Text.Megaparsec
( ParseErrorBundle(..) ( ParseErrorBundle(..)
@ -91,3 +97,28 @@ instance Show ResolverException where
show (ResolverException e) = show e show (ResolverException e) = show e
instance Exception ResolverException instance Exception ResolverException
-- * Deprecated
{-# DEPRECATED runCollectErrs "runCollectErrs was part of the old executor and isn't used anymore" #-}
-- | Runs the given query computation, but collects the errors into an error
-- list, which is then sent back with the data.
runCollectErrs :: (Monad m, Serialize a)
=> HashMap Name (Schema.Type m)
-> CollectErrsT m a
-> m (Response a)
runCollectErrs types' res = do
(dat, Resolution{..}) <- runStateT res
$ Resolution{ errors = Seq.empty, types = types' }
pure $ Response dat errors
{-# DEPRECATED Resolution "Resolution was part of the old executor and isn't used anymore" #-}
-- | Executor context.
data Resolution m = Resolution
{ errors :: Seq Error
, types :: HashMap Name (Schema.Type m)
}
{-# DEPRECATED CollectErrsT "CollectErrsT was part of the old executor and isn't used anymore" #-}
-- | A wrapper to pass error messages around.
type CollectErrsT m = StateT (Resolution m) m

View File

@ -18,8 +18,6 @@ module Language.GraphQL.Type.Definition
, float , float
, id , id
, int , int
, showNonNullType
, showNonNullListType
, selection , selection
, string , string
) where ) where
@ -209,11 +207,3 @@ include = handle include'
(Just (Boolean True)) -> Include directive' (Just (Boolean True)) -> Include directive'
_ -> Skip _ -> Skip
include' directive' = Continue directive' include' directive' = Continue directive'
showNonNullType :: Show a => a -> String
showNonNullType = (++ "!") . show
showNonNullListType :: Show a => a -> String
showNonNullListType listType =
let representation = show listType
in concat ["[", representation, "]!"]

View File

@ -66,11 +66,10 @@ instance Show Type where
show (NamedEnumType enumType) = show enumType show (NamedEnumType enumType) = show enumType
show (NamedInputObjectType inputObjectType) = show inputObjectType show (NamedInputObjectType inputObjectType) = show inputObjectType
show (ListType baseType) = concat ["[", show baseType, "]"] show (ListType baseType) = concat ["[", show baseType, "]"]
show (NonNullScalarType scalarType) = Definition.showNonNullType scalarType show (NonNullScalarType scalarType) = '!' : show scalarType
show (NonNullEnumType enumType) = Definition.showNonNullType enumType show (NonNullEnumType enumType) = '!' : show enumType
show (NonNullInputObjectType inputObjectType) = show (NonNullInputObjectType inputObjectType) = '!' : show inputObjectType
Definition.showNonNullType inputObjectType show (NonNullListType baseType) = concat ["![", show baseType, "]"]
show (NonNullListType baseType) = Definition.showNonNullListType baseType
-- | Field argument definition. -- | Field argument definition.
data Argument = Argument (Maybe Text) Type (Maybe Definition.Value) data Argument = Argument (Maybe Text) Type (Maybe Definition.Value)

View File

@ -115,12 +115,12 @@ instance forall a. Show (Type a) where
show (NamedInterfaceType interfaceType) = show interfaceType show (NamedInterfaceType interfaceType) = show interfaceType
show (NamedUnionType unionType) = show unionType show (NamedUnionType unionType) = show unionType
show (ListType baseType) = concat ["[", show baseType, "]"] show (ListType baseType) = concat ["[", show baseType, "]"]
show (NonNullScalarType scalarType) = showNonNullType scalarType show (NonNullScalarType scalarType) = '!' : show scalarType
show (NonNullEnumType enumType) = showNonNullType enumType show (NonNullEnumType enumType) = '!' : show enumType
show (NonNullObjectType inputObjectType) = showNonNullType inputObjectType show (NonNullObjectType inputObjectType) = '!' : show inputObjectType
show (NonNullInterfaceType interfaceType) = showNonNullType interfaceType show (NonNullInterfaceType interfaceType) = '!' : show interfaceType
show (NonNullUnionType unionType) = showNonNullType unionType show (NonNullUnionType unionType) = '!' : show unionType
show (NonNullListType baseType) = showNonNullListType baseType show (NonNullListType baseType) = concat ["![", show baseType, "]"]
-- | Matches either 'NamedScalarType' or 'NonNullScalarType'. -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
pattern ScalarBaseType :: forall m. ScalarType -> Type m pattern ScalarBaseType :: forall m. ScalarType -> Type m

View File

@ -2,13 +2,11 @@
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 DataKinds #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
-- | This module contains default rules defined in the GraphQL specification. -- | This module contains default rules defined in the GraphQL specification.
@ -63,7 +61,6 @@ import Data.Sequence (Seq(..), (|>))
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import GHC.Records (HasField(..))
import qualified Language.GraphQL.AST.Document as Full import qualified Language.GraphQL.AST.Document as Full
import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.Internal as Type import qualified Language.GraphQL.Type.Internal as Type
@ -621,10 +618,6 @@ noUndefinedVariablesRule =
, "\"." , "\"."
] ]
-- Used to find the difference between defined and used variables. The first
-- argument are variables defined in the operation, the second argument are
-- variables used in the query. It should return the difference between these
-- 2 sets.
type UsageDifference type UsageDifference
= HashMap Full.Name [Full.Location] = HashMap Full.Name [Full.Location]
-> HashMap Full.Name [Full.Location] -> HashMap Full.Name [Full.Location]
@ -671,17 +664,11 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
= filterSelections' selections = filterSelections' selections
>>= lift . mapReaderT (<> mapDirectives directives') . pure >>= lift . mapReaderT (<> mapDirectives directives') . pure
findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments
mapArguments = Seq.fromList . (>>= findArgumentVariables) mapArguments = Seq.fromList . mapMaybe findArgumentVariables
mapDirectives = foldMap findDirectiveVariables mapDirectives = foldMap findDirectiveVariables
findArgumentVariables (Full.Argument _ Full.Node{ node = Full.Variable value', ..} _) =
findArgumentVariables (Full.Argument _ value _) = findNodeVariables value Just (value', [location])
findNodeVariables Full.Node{ node = value, ..} = findValueVariables location value findArgumentVariables _ = Nothing
findValueVariables location (Full.Variable value') = [(value', [location])]
findValueVariables _ (Full.List values) = values >>= findNodeVariables
findValueVariables _ (Full.Object fields) = fields
>>= findNodeVariables . getField @"value"
findValueVariables _ _ = []
makeError operationName (variableName, locations') = Error makeError operationName (variableName, locations') = Error
{ message = errorMessage operationName variableName { message = errorMessage operationName variableName
, locations = locations' , locations = locations'

View File

@ -7,7 +7,6 @@ import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..)) import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
import Test.QuickCheck.Gen (Gen (..)) import Test.QuickCheck.Gen (Gen (..))
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Data.Functor ((<&>))
newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show) newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show)
@ -60,36 +59,34 @@ instance Arbitrary a => Arbitrary (AnyObjectField a) where
location' <- getAnyLocation <$> arbitrary location' <- getAnyLocation <$> arbitrary
pure $ AnyObjectField $ Doc.ObjectField name' value' location' pure $ AnyObjectField $ Doc.ObjectField name' value' location'
newtype AnyValue = AnyValue { getAnyValue :: Doc.Value } newtype AnyValue = AnyValue { getAnyValue :: Doc.Value } deriving (Eq, Show)
deriving (Eq, Show)
instance Arbitrary AnyValue instance Arbitrary AnyValue where
where arbitrary = AnyValue <$> oneof
arbitrary = [ variableGen
let variableGen :: Gen Doc.Value , Doc.Int <$> arbitrary
variableGen = Doc.Variable . getAnyName <$> arbitrary , Doc.Float <$> arbitrary
listGen :: Gen [Doc.Node Doc.Value] , Doc.String <$> (getAnyPrintableText <$> arbitrary)
listGen = (resize 5 . listOf) nodeGen , Doc.Boolean <$> arbitrary
nodeGen :: Gen (Doc.Node Doc.Value) , MkGen $ \_ _ -> Doc.Null
nodeGen = fmap getAnyNode arbitrary <&> fmap getAnyValue , Doc.Enum <$> (getAnyName <$> arbitrary)
objectGen :: Gen [Doc.ObjectField Doc.Value] , Doc.List <$> listGen
objectGen = resize 1 , Doc.Object <$> objectGen
$ fmap getNonEmpty arbitrary ]
<&> map (fmap getAnyValue . getAnyObjectField) where
in AnyValue <$> oneof variableGen :: Gen Doc.Value
[ variableGen variableGen = Doc.Variable <$> (getAnyName <$> arbitrary)
, Doc.Int <$> arbitrary listGen :: Gen [Doc.Node Doc.Value]
, Doc.Float <$> arbitrary listGen = (resize 5 . listOf) nodeGen
, Doc.String . getAnyPrintableText <$> arbitrary nodeGen = do
, Doc.Boolean <$> arbitrary node' <- getAnyNode <$> (arbitrary :: Gen (AnyNode AnyValue))
, MkGen $ \_ _ -> Doc.Null pure (getAnyValue <$> node')
, Doc.Enum . getAnyName <$> arbitrary objectGen :: Gen [Doc.ObjectField Doc.Value]
, Doc.List <$> listGen objectGen = resize 1 $ do
, Doc.Object <$> objectGen list <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList (AnyObjectField AnyValue)))
] pure $ map (fmap getAnyValue . getAnyObjectField) list
newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument } newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument } deriving (Eq, Show)
deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyArgument a) where instance Arbitrary a => Arbitrary (AnyArgument a) where
arbitrary = do arbitrary = do

View File

@ -69,7 +69,6 @@ queryType = Out.ObjectType "Query" Nothing []
, ("throwing", ValueResolver throwingField throwingResolver) , ("throwing", ValueResolver throwingField throwingResolver)
, ("count", ValueResolver countField countResolver) , ("count", ValueResolver countField countResolver)
, ("sequence", ValueResolver sequenceField sequenceResolver) , ("sequence", ValueResolver sequenceField sequenceResolver)
, ("withInputObject", ValueResolver withInputObjectField withInputObjectResolver)
] ]
where where
philosopherField = philosopherField =
@ -90,17 +89,6 @@ queryType = Out.ObjectType "Query" Nothing []
let fieldType = Out.ListType $ Out.NonNullScalarType int let fieldType = Out.ListType $ Out.NonNullScalarType int
in Out.Field Nothing fieldType HashMap.empty in Out.Field Nothing fieldType HashMap.empty
sequenceResolver = pure intSequence sequenceResolver = pure intSequence
withInputObjectResolver = pure $ Type.Int 0
withInputObjectField =
Out.Field Nothing (Out.NonNullScalarType int) $ HashMap.fromList
[("values", In.Argument Nothing withInputObjectArgumentType Nothing)]
withInputObjectArgumentType = In.NonNullListType
$ In.NonNullInputObjectType inputObjectType
inputObjectType :: In.InputObjectType
inputObjectType = In.InputObjectType "InputObject" Nothing $
HashMap.singleton "name" $
In.InputField Nothing (In.NonNullScalarType int) Nothing
intSequence :: Value intSequence :: Value
intSequence = Type.List [Type.Int 1, Type.Int 2, Type.Int 3] intSequence = Type.List [Type.Int 1, Type.Int 2, Type.Int 3]
@ -307,7 +295,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = { message =
"Value completion error. Expected type School!, found: EXISTENTIALISM." "Value completion error. Expected type !School, found: EXISTENTIALISM."
, locations = [Location 1 17] , locations = [Location 1 17]
, path = [Segment "philosopher", Segment "school"] , path = [Segment "philosopher", Segment "school"]
} }
@ -319,7 +307,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = { message =
"Value completion error. Expected type Interest!, found: { instrument: \"piano\" }." "Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
, locations = [Location 1 17] , locations = [Location 1 17]
, path = [Segment "philosopher", Segment "interest"] , path = [Segment "philosopher", Segment "interest"]
} }
@ -331,7 +319,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message { message
= "Value completion error. Expected type Work!, found:\ = "Value completion error. Expected type !Work, found:\
\ { title: \"Also sprach Zarathustra: Ein Buch f\252r Alle und Keinen\" }." \ { title: \"Also sprach Zarathustra: Ein Buch f\252r Alle und Keinen\" }."
, locations = [Location 1 17] , locations = [Location 1 17]
, path = [Segment "philosopher", Segment "majorWork"] , path = [Segment "philosopher", Segment "majorWork"]
@ -340,10 +328,22 @@ spec =
sourceQuery = "{ philosopher { majorWork { title } } }" sourceQuery = "{ philosopher { majorWork { title } } }"
in sourceQuery `shouldResolveTo` expected in sourceQuery `shouldResolveTo` expected
it "gives location information for invalid scalar arguments" $
let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message =
"Argument \"id\" has invalid type. Expected type ID, found: True."
, locations = [Location 1 15]
, path = [Segment "philosopher"]
}
expected = Response data'' executionErrors
sourceQuery = "{ philosopher(id: true) { lastName } }"
in sourceQuery `shouldResolveTo` 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
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = "Unable to coerce result to Int!." { message = "Unable to coerce result to !Int."
, locations = [Location 1 26] , locations = [Location 1 26]
, path = [Segment "philosopher", Segment "century"] , path = [Segment "philosopher", Segment "century"]
} }
@ -364,7 +364,7 @@ spec =
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
{ message = "Unable to coerce result to Int!." { message = "Unable to coerce result to !Int."
, locations = [Location 1 3] , locations = [Location 1 3]
, path = [Segment "count"] , path = [Segment "count"]
} }
@ -375,7 +375,7 @@ spec =
it "detects nullability errors" $ it "detects nullability errors" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = "Value completion error. Expected type String!, found: null." { message = "Value completion error. Expected type !String, found: null."
, locations = [Location 1 26] , locations = [Location 1 26]
, path = [Segment "philosopher", Segment "firstLanguage"] , path = [Segment "philosopher", Segment "firstLanguage"]
} }
@ -389,25 +389,6 @@ spec =
sourceQuery = "{ sequence }" sourceQuery = "{ sequence }"
in sourceQuery `shouldResolveTo` expected in sourceQuery `shouldResolveTo` expected
context "Arguments" $ do
it "gives location information for invalid scalar arguments" $
let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message =
"Argument \"id\" has invalid type. Expected type ID, found: True."
, locations = [Location 1 15]
, path = [Segment "philosopher"]
}
expected = Response data'' executionErrors
sourceQuery = "{ philosopher(id: true) { lastName } }"
in sourceQuery `shouldResolveTo` expected
it "puts an object in a list if needed" $
let data'' = Object $ HashMap.singleton "withInputObject" $ Type.Int 0
expected = Response data'' mempty
sourceQuery = "{ withInputObject(values: { name: 0 }) }"
in sourceQuery `shouldResolveTo` expected
context "queryError" $ do context "queryError" $ do
let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }" let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"
twoQueries = namedQuery "A" <> " " <> namedQuery "B" twoQueries = namedQuery "A" <> " " <> namedQuery "B"

View File

@ -29,7 +29,6 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
[ ("dog", dogResolver) [ ("dog", dogResolver)
, ("cat", catResolver) , ("cat", catResolver)
, ("findDog", findDogResolver) , ("findDog", findDogResolver)
, ("findCats", findCatsResolver)
] ]
where where
dogField = Field Nothing (Out.NamedObjectType dogType) mempty dogField = Field Nothing (Out.NamedObjectType dogType) mempty
@ -40,11 +39,6 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
findDogResolver = ValueResolver findDogField $ pure Null findDogResolver = ValueResolver findDogField $ pure Null
catField = Field Nothing (Out.NamedObjectType catType) mempty catField = Field Nothing (Out.NamedObjectType catType) mempty
catResolver = ValueResolver catField $ pure Null catResolver = ValueResolver catField $ pure Null
findCatsArguments = HashMap.singleton "commands"
$ In.Argument Nothing (In.NonNullListType $ In.NonNullEnumType catCommandType)
$ Just $ List []
findCatsField = Field Nothing (Out.NonNullListType $ Out.NonNullObjectType catType) findCatsArguments
findCatsResolver = ValueResolver findCatsField $ pure $ List []
catCommandType :: EnumType catCommandType :: EnumType
catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList
@ -544,7 +538,7 @@ spec =
} }
in validate queryString `shouldContain` [expected] in validate queryString `shouldContain` [expected]
context "noUndefinedVariablesRule" $ do context "noUndefinedVariablesRule" $
it "rejects undefined variables" $ it "rejects undefined variables" $
let queryString = [gql| let queryString = [gql|
query variableIsNotDefinedUsedInSingleFragment { query variableIsNotDefinedUsedInSingleFragment {
@ -566,35 +560,7 @@ spec =
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "gets variable location inside an input object" $ context "noUnusedVariablesRule" $
let queryString = [gql|
query {
findDog (complex: { name: $name }) {
name
}
}
|]
expected = Error
{ message = "Variable \"$name\" is not defined."
, locations = [AST.Location 2 29]
}
in validate queryString `shouldBe` [expected]
it "gets variable location inside an array" $
let queryString = [gql|
query {
findCats (commands: [JUMP, $command]) {
name
}
}
|]
expected = Error
{ message = "Variable \"$command\" is not defined."
, locations = [AST.Location 2 30]
}
in validate queryString `shouldBe` [expected]
context "noUnusedVariablesRule" $ do
it "rejects unused variables" $ it "rejects unused variables" $
let queryString = [gql| let queryString = [gql|
query variableUnused($atOtherHomes: Boolean) { query variableUnused($atOtherHomes: Boolean) {
@ -611,16 +577,6 @@ spec =
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "detects variables in properties of input objects" $
let queryString = [gql|
query withVar ($name: String!) {
findDog (complex: { name: $name }) {
name
}
}
|]
in validate queryString `shouldBe` []
context "uniqueInputFieldNamesRule" $ context "uniqueInputFieldNamesRule" $
it "rejects duplicate fields in input objects" $ it "rejects duplicate fields in input objects" $
let queryString = [gql| let queryString = [gql|
@ -922,7 +878,7 @@ spec =
{ message = { message =
"Variable \"$dogCommandArg\" of type \ "Variable \"$dogCommandArg\" of type \
\\"DogCommand\" used in position expecting type \ \\"DogCommand\" used in position expecting type \
\\"DogCommand!\"." \\"!DogCommand\"."
, locations = [AST.Location 1 26] , locations = [AST.Location 1 26]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
@ -969,7 +925,7 @@ spec =
|] |]
expected = Error expected = Error
{ message = { message =
"Value 3 cannot be coerced to type \"CatCommand!\"." "Value 3 cannot be coerced to type \"!CatCommand\"."
, locations = [AST.Location 3 36] , locations = [AST.Location 3 36]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
@ -984,7 +940,7 @@ spec =
|] |]
expected = Error expected = Error
{ message = { message =
"Value 3 cannot be coerced to type \"String!\"." "Value 3 cannot be coerced to type \"!String\"."
, locations = [AST.Location 2 28] , locations = [AST.Location 2 28]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]