graphql 1.2.0.1 → 1.2.0.2
raw patch · 11 files changed
+161/−44 lines, 11 files
Files
- CHANGELOG.md +8/−0
- graphql.cabal +6/−3
- src/Language/GraphQL/AST/Document.hs +2/−2
- src/Language/GraphQL/Execute.hs +20/−1
- src/Language/GraphQL/TH.hs +1/−1
- src/Language/GraphQL/Type/Definition.hs +10/−0
- src/Language/GraphQL/Type/In.hs +5/−4
- src/Language/GraphQL/Type/Out.hs +6/−6
- src/Language/GraphQL/Validate/Rules.hs +17/−4
- tests/Language/GraphQL/ExecuteSpec.hs +37/−18
- tests/Language/GraphQL/Validate/RulesSpec.hs +49/−5
CHANGELOG.md view
@@ -6,6 +6,13 @@ 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.@@ -508,6 +515,7 @@ ### 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
graphql.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name: graphql-version: 1.2.0.1+version: 1.2.0.2 synopsis: Haskell GraphQL implementation description: Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation. category: Language@@ -11,7 +11,7 @@ Matthías Páll Gissurarson <mpg@mpg.is>, Sólrún Halla Einarsdóttir <she@mpg.is> maintainer: belka@caraus.de-copyright: (c) 2019-2023 Eugen Wissner,+copyright: (c) 2019-2024 Eugen Wissner, (c) 2015-2017 J. Daniel Navarro license: MPL-2.0 AND BSD-3-Clause license-files: LICENSE,@@ -21,7 +21,8 @@ CHANGELOG.md README.md tested-with:- GHC == 9.2.5+ GHC == 9.4.7,+ GHC == 9.6.3 source-repository head type: git@@ -105,4 +106,6 @@ unordered-containers, containers, vector+ build-tool-depends:+ hspec-discover:hspec-discover default-language: Haskell2010
src/Language/GraphQL/AST/Document.hs view
@@ -371,8 +371,8 @@ 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
src/Language/GraphQL/Execute.hs view
@@ -556,8 +556,10 @@ $ Just inputValue | otherwise -> throwM $ InputCoercionException (Text.unpack argumentName) variableType Nothing+ matchFieldValues' = matchFieldValues coerceArgumentValue $ Full.node <$> argumentValues+ coerceArgumentValue inputType (Transform.Int integer) = coerceInputLiteral inputType (Type.Int integer) coerceArgumentValue inputType (Transform.Boolean boolean) =@@ -575,14 +577,31 @@ let coerceItem = coerceArgumentValue inputType in Type.List <$> traverse coerceItem list coerceArgumentValue (In.InputObjectBaseType inputType) (Transform.Object object)- | In.InputObjectType _ _ inputFields <- inputType = + | 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+ coerceArgumentValue inputType transform =+ coerceInputLiteral inputType $ extractArgumentValue transform+<<<<<<< Updated upstream++======= forEachField object variableName (In.InputField _ variableType defaultValue) = matchFieldValues coerceArgumentValue object variableName variableType defaultValue+>>>>>>> Stashed changes+ 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 collectFields :: Monad m => Out.ObjectType m
src/Language/GraphQL/TH.hs view
@@ -21,7 +21,7 @@ indent count (' ' : xs) = indent (count - 1) xs indent _ xs = xs withoutLeadingNewlines = dropNewlines code- dropNewlines = dropWhile (== '\n')+ dropNewlines = dropWhile $ flip any ['\n', '\r'] . (==) spaces = length $ takeWhile (== ' ') withoutLeadingNewlines -- | Removes leading and trailing newlines. Indentation of the first line is
src/Language/GraphQL/Type/Definition.hs view
@@ -18,6 +18,8 @@ , float , id , int+ , showNonNullType+ , showNonNullListType , selection , string ) where@@ -207,3 +209,11 @@ (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, "]!"]
src/Language/GraphQL/Type/In.hs view
@@ -66,10 +66,11 @@ show (NamedEnumType enumType) = show enumType show (NamedInputObjectType inputObjectType) = show inputObjectType show (ListType baseType) = concat ["[", show baseType, "]"]- show (NonNullScalarType scalarType) = '!' : show scalarType- show (NonNullEnumType enumType) = '!' : show enumType- show (NonNullInputObjectType inputObjectType) = '!' : show inputObjectType- show (NonNullListType 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 -- | Field argument definition. data Argument = Argument (Maybe Text) Type (Maybe Definition.Value)
src/Language/GraphQL/Type/Out.hs view
@@ -115,12 +115,12 @@ show (NamedInterfaceType interfaceType) = show interfaceType show (NamedUnionType unionType) = show unionType show (ListType baseType) = concat ["[", show 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, "]"]+ 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 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'. pattern ScalarBaseType :: forall m. ScalarType -> Type m
src/Language/GraphQL/Validate/Rules.hs view
@@ -2,11 +2,13 @@ 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.@@ -61,6 +63,7 @@ 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@@ -618,6 +621,10 @@ , "\"." ] +-- 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]@@ -664,11 +671,17 @@ = filterSelections' selections >>= lift . mapReaderT (<> mapDirectives directives') . pure findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments- mapArguments = Seq.fromList . mapMaybe findArgumentVariables+ mapArguments = Seq.fromList . (>>= findArgumentVariables) mapDirectives = foldMap findDirectiveVariables- findArgumentVariables (Full.Argument _ Full.Node{ node = Full.Variable value', ..} _) =- Just (value', [location])- findArgumentVariables _ = Nothing++ 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 _ _ = [] makeError operationName (variableName, locations') = Error { message = errorMessage operationName variableName , locations = locations'
tests/Language/GraphQL/ExecuteSpec.hs view
@@ -69,6 +69,7 @@ , ("throwing", ValueResolver throwingField throwingResolver) , ("count", ValueResolver countField countResolver) , ("sequence", ValueResolver sequenceField sequenceResolver)+ , ("withInputObject", ValueResolver withInputObjectField withInputObjectResolver) ] where philosopherField =@@ -89,7 +90,18 @@ 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] @@ -295,7 +307,7 @@ 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"] }@@ -307,7 +319,7 @@ 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"] }@@ -319,7 +331,7 @@ 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"]@@ -328,22 +340,10 @@ 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 @@ 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 @@ 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"] }@@ -388,6 +388,25 @@ expected = Response data'' mempty 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 } }"
tests/Language/GraphQL/Validate/RulesSpec.hs view
@@ -29,6 +29,7 @@ [ ("dog", dogResolver) , ("cat", catResolver) , ("findDog", findDogResolver)+ , ("findCats", findCatsResolver) ] where dogField = Field Nothing (Out.NamedObjectType dogType) mempty@@ -39,6 +40,11 @@ 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@@ -538,7 +544,7 @@ } in validate queryString `shouldContain` [expected] - context "noUndefinedVariablesRule" $+ context "noUndefinedVariablesRule" $ do it "rejects undefined variables" $ let queryString = [gql| query variableIsNotDefinedUsedInSingleFragment {@@ -560,7 +566,35 @@ } in validate queryString `shouldBe` [expected] - context "noUnusedVariablesRule" $+ 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 it "rejects unused variables" $ let queryString = [gql| query variableUnused($atOtherHomes: Boolean) {@@ -577,6 +611,16 @@ } 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|@@ -878,7 +922,7 @@ { message = "Variable \"$dogCommandArg\" of type \ \\"DogCommand\" used in position expecting type \- \\"!DogCommand\"."+ \\"DogCommand!\"." , locations = [AST.Location 1 26] } in validate queryString `shouldBe` [expected]@@ -925,7 +969,7 @@ |] 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]@@ -940,7 +984,7 @@ |] 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]