Compare commits

..

No commits in common. "v1.2.0.2" and "v1.2.0.1" have entirely different histories.

12 changed files with 68 additions and 225 deletions

View File

@ -1,68 +0,0 @@
name: Build
on:
push:
pull_request:
branches: [master]
jobs:
audit:
runs-on: alpine
steps:
- name: Set up environment
shell: ash {0}
run: |
apk add --no-cache git bash curl build-base readline-dev openssl-dev zlib-dev libpq-dev gmp-dev
- name: Prepare system
run: |
curl --create-dirs --output-dir \
~/.ghcup/bin https://downloads.haskell.org/~ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 -o ghcup
chmod +x ~/.ghcup/bin/ghcup
~/.ghcup/bin/ghcup install ghc 9.4.8
~/.ghcup/bin/ghcup install cabal 3.6.2.0
- uses: actions/checkout@v4
- name: Install dependencies
run: |
~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal update
~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal install hlint --constraint="hlint ==3.6.1"
- run: ~/.cabal/bin/hlint -- src tests
test:
runs-on: alpine
steps:
- name: Set up environment
shell: ash {0}
run: |
apk add --no-cache git bash curl build-base readline-dev openssl-dev zlib-dev libpq-dev gmp-dev
- name: Prepare system
run: |
curl --create-dirs --output-dir \
~/.ghcup/bin https://downloads.haskell.org/~ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 -o ghcup
chmod +x ~/.ghcup/bin/ghcup
~/.ghcup/bin/ghcup install ghc 9.4.8
~/.ghcup/bin/ghcup install cabal 3.6.2.0
- uses: actions/checkout@v4
- name: Install dependencies
run: |
~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal update
~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal build graphql-test
- run: ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal test --test-show-details=direct
doc:
runs-on: alpine
steps:
- name: Set up environment
shell: ash {0}
run: |
apk add --no-cache git bash curl build-base readline-dev openssl-dev zlib-dev libpq-dev gmp-dev
- name: Prepare system
run: |
curl --create-dirs --output-dir \
~/.ghcup/bin https://downloads.haskell.org/~ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 -o ghcup
chmod +x ~/.ghcup/bin/ghcup
~/.ghcup/bin/ghcup install ghc 9.4.8
~/.ghcup/bin/ghcup install cabal 3.6.2.0
- uses: actions/checkout@v4
- name: Install dependencies
run: ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal update
- run: ~/.ghcup/bin/ghcup run --ghc 9.4.8 --cabal 3.6.2.0 -- cabal haddock --enable-documentation

View File

@ -6,13 +6,6 @@ The format is based on
and this project adheres to
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
## [1.2.0.2] - 2024-01-09
### Fixed
- `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
### Fixed
- Support hspec 2.11.
@ -515,7 +508,6 @@ and this project adheres to
### Added
- Data types for the GraphQL language.
[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.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

View File

@ -1,7 +1,7 @@
cabal-version: 2.4
name: graphql
version: 1.2.0.2
version: 1.2.0.1
synopsis: Haskell GraphQL implementation
description: Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
category: Language
@ -11,7 +11,7 @@ author: Danny Navarro <j@dannynavarro.net>,
Matthías Páll Gissurarson <mpg@mpg.is>,
Sólrún Halla Einarsdóttir <she@mpg.is>
maintainer: belka@caraus.de
copyright: (c) 2019-2024 Eugen Wissner,
copyright: (c) 2019-2023 Eugen Wissner,
(c) 2015-2017 J. Daniel Navarro
license: MPL-2.0 AND BSD-3-Clause
license-files: LICENSE,
@ -21,8 +21,7 @@ extra-source-files:
CHANGELOG.md
README.md
tested-with:
GHC == 9.4.7,
GHC == 9.6.3
GHC == 9.2.5
source-repository head
type: git
@ -106,6 +105,4 @@ test-suite graphql-test
unordered-containers,
containers,
vector
build-tool-depends:
hspec-discover:hspec-discover
default-language: Haskell2010

View File

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

View File

@ -556,24 +556,33 @@ coerceArgumentValues argumentDefinitions argumentValues =
$ Just inputValue
| otherwise -> throwM
$ InputCoercionException (Text.unpack argumentName) variableType Nothing
matchFieldValues' = matchFieldValues coerceArgumentValue
$ Full.node <$> argumentValues
coerceArgumentValue inputType transform =
coerceInputLiteral inputType $ extractArgumentValue transform
extractArgumentValue (Transform.Int integer) = Type.Int integer
extractArgumentValue (Transform.Boolean boolean) = Type.Boolean boolean
extractArgumentValue (Transform.String string) = Type.String string
extractArgumentValue (Transform.Float float) = Type.Float float
extractArgumentValue (Transform.Enum enum) = Type.Enum enum
extractArgumentValue Transform.Null = Type.Null
extractArgumentValue (Transform.List list) =
Type.List $ extractArgumentValue <$> list
extractArgumentValue (Transform.Object object) =
Type.Object $ extractArgumentValue <$> object
extractArgumentValue (Transform.Variable variable) = variable
coerceArgumentValue inputType (Transform.Int integer) =
coerceInputLiteral inputType (Type.Int integer)
coerceArgumentValue inputType (Transform.Boolean boolean) =
coerceInputLiteral inputType (Type.Boolean boolean)
coerceArgumentValue inputType (Transform.String string) =
coerceInputLiteral inputType (Type.String string)
coerceArgumentValue inputType (Transform.Float float) =
coerceInputLiteral inputType (Type.Float float)
coerceArgumentValue inputType (Transform.Enum enum) =
coerceInputLiteral inputType (Type.Enum enum)
coerceArgumentValue inputType Transform.Null
| In.isNonNullType inputType = Nothing
| otherwise = coerceInputLiteral inputType Type.Null
coerceArgumentValue (In.ListBaseType inputType) (Transform.List list) =
let coerceItem = coerceArgumentValue inputType
in Type.List <$> traverse coerceItem list
coerceArgumentValue (In.InputObjectBaseType inputType) (Transform.Object object)
| In.InputObjectType _ _ inputFields <- inputType =
let go = forEachField object
resultMap = HashMap.foldrWithKey go (pure mempty) inputFields
in Type.Object <$> resultMap
coerceArgumentValue _ (Transform.Variable variable) = pure variable
coerceArgumentValue _ _ = Nothing
forEachField object variableName (In.InputField _ variableType defaultValue) =
matchFieldValues coerceArgumentValue object variableName variableType defaultValue
collectFields :: Monad m
=> Out.ObjectType m

View File

@ -21,7 +21,7 @@ stripIndentation code = reverse
indent count (' ' : xs) = indent (count - 1) xs
indent _ xs = xs
withoutLeadingNewlines = dropNewlines code
dropNewlines = dropWhile $ flip any ['\n', '\r'] . (==)
dropNewlines = dropWhile (== '\n')
spaces = length $ takeWhile (== ' ') withoutLeadingNewlines
-- | Removes leading and trailing newlines. Indentation of the first line is

View File

@ -18,8 +18,6 @@ module Language.GraphQL.Type.Definition
, float
, id
, int
, showNonNullType
, showNonNullListType
, selection
, string
) where
@ -209,11 +207,3 @@ include = handle include'
(Just (Boolean True)) -> Include directive'
_ -> Skip
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 (NamedInputObjectType inputObjectType) = show inputObjectType
show (ListType baseType) = concat ["[", show baseType, "]"]
show (NonNullScalarType scalarType) = Definition.showNonNullType scalarType
show (NonNullEnumType enumType) = Definition.showNonNullType enumType
show (NonNullInputObjectType inputObjectType) =
Definition.showNonNullType inputObjectType
show (NonNullListType baseType) = Definition.showNonNullListType baseType
show (NonNullScalarType scalarType) = '!' : show scalarType
show (NonNullEnumType enumType) = '!' : show enumType
show (NonNullInputObjectType inputObjectType) = '!' : show inputObjectType
show (NonNullListType baseType) = concat ["![", show baseType, "]"]
-- | Field argument definition.
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 (NamedUnionType unionType) = show unionType
show (ListType baseType) = concat ["[", show baseType, "]"]
show (NonNullScalarType scalarType) = showNonNullType scalarType
show (NonNullEnumType enumType) = showNonNullType enumType
show (NonNullObjectType inputObjectType) = showNonNullType inputObjectType
show (NonNullInterfaceType interfaceType) = showNonNullType interfaceType
show (NonNullUnionType unionType) = showNonNullType unionType
show (NonNullListType baseType) = showNonNullListType baseType
show (NonNullScalarType scalarType) = '!' : show scalarType
show (NonNullEnumType enumType) = '!' : show enumType
show (NonNullObjectType inputObjectType) = '!' : show inputObjectType
show (NonNullInterfaceType interfaceType) = '!' : show interfaceType
show (NonNullUnionType unionType) = '!' : show unionType
show (NonNullListType baseType) = concat ["![", show baseType, "]"]
-- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
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
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
-- | 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 Data.Text (Text)
import qualified Data.Text as Text
import GHC.Records (HasField(..))
import qualified Language.GraphQL.AST.Document as Full
import qualified Language.GraphQL.Type.Definition as Definition
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
= HashMap Full.Name [Full.Location]
-> HashMap Full.Name [Full.Location]
@ -671,17 +664,11 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
= filterSelections' selections
>>= lift . mapReaderT (<> mapDirectives directives') . pure
findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments
mapArguments = Seq.fromList . (>>= findArgumentVariables)
mapArguments = Seq.fromList . mapMaybe findArgumentVariables
mapDirectives = foldMap findDirectiveVariables
findArgumentVariables (Full.Argument _ value _) = findNodeVariables value
findNodeVariables Full.Node{ node = value, ..} = findValueVariables location value
findValueVariables location (Full.Variable value') = [(value', [location])]
findValueVariables _ (Full.List values) = values >>= findNodeVariables
findValueVariables _ (Full.Object fields) = fields
>>= findNodeVariables . getField @"value"
findValueVariables _ _ = []
findArgumentVariables (Full.Argument _ Full.Node{ node = Full.Variable value', ..} _) =
Just (value', [location])
findArgumentVariables _ = Nothing
makeError operationName (variableName, locations') = Error
{ message = errorMessage operationName variableName
, locations = locations'

View File

@ -69,7 +69,6 @@ queryType = Out.ObjectType "Query" Nothing []
, ("throwing", ValueResolver throwingField throwingResolver)
, ("count", ValueResolver countField countResolver)
, ("sequence", ValueResolver sequenceField sequenceResolver)
, ("withInputObject", ValueResolver withInputObjectField withInputObjectResolver)
]
where
philosopherField =
@ -90,17 +89,6 @@ queryType = Out.ObjectType "Query" Nothing []
let fieldType = Out.ListType $ Out.NonNullScalarType int
in Out.Field Nothing fieldType HashMap.empty
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 = Type.List [Type.Int 1, Type.Int 2, Type.Int 3]
@ -307,7 +295,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message =
"Value completion error. Expected type School!, found: EXISTENTIALISM."
"Value completion error. Expected type !School, found: EXISTENTIALISM."
, locations = [Location 1 17]
, path = [Segment "philosopher", Segment "school"]
}
@ -319,7 +307,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message =
"Value completion error. Expected type Interest!, found: { instrument: \"piano\" }."
"Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
, locations = [Location 1 17]
, path = [Segment "philosopher", Segment "interest"]
}
@ -331,7 +319,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ 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\" }."
, locations = [Location 1 17]
, path = [Segment "philosopher", Segment "majorWork"]
@ -340,10 +328,22 @@ spec =
sourceQuery = "{ philosopher { majorWork { title } } }"
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" $
let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message = "Unable to coerce result to Int!."
{ message = "Unable to coerce result to !Int."
, locations = [Location 1 26]
, path = [Segment "philosopher", Segment "century"]
}
@ -364,7 +364,7 @@ spec =
it "sets data to null if a root field isn't nullable" $
let executionErrors = pure $ Error
{ message = "Unable to coerce result to Int!."
{ message = "Unable to coerce result to !Int."
, locations = [Location 1 3]
, path = [Segment "count"]
}
@ -375,7 +375,7 @@ spec =
it "detects nullability errors" $
let data'' = Object $ HashMap.singleton "philosopher" Null
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]
, path = [Segment "philosopher", Segment "firstLanguage"]
}
@ -389,25 +389,6 @@ spec =
sourceQuery = "{ sequence }"
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
let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"
twoQueries = namedQuery "A" <> " " <> namedQuery "B"

View File

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