diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,11 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.5.0.1] - 2025-06-19 +### Fixed +- Allow any 2.x QuickCheck version. +- Make the lexer and parser safe. + ## [1.5.0.0] - 2024-12-03 ### Removed - Remove deprecated 'gql' quasi quoter. @@ -546,6 +551,7 @@ ### Added - Data types for the GraphQL language. +[1.5.0.1]: https://git.caraus.tech/OSS/graphql/compare/v1.5.0.0...v1.5.0.1 [1.5.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.4.0.0...v1.5.0.0 [1.4.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.3.0.0...v1.4.0.0 [1.3.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.3...v1.3.0.0 diff --git a/graphql.cabal b/graphql.cabal --- a/graphql.cabal +++ b/graphql.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: graphql -version: 1.5.0.0 +version: 1.5.0.1 synopsis: Haskell GraphQL implementation description: Haskell implementation. category: Language @@ -11,7 +11,7 @@ Matthías Páll Gissurarson , Sólrún Halla Einarsdóttir maintainer: belka@caraus.de -copyright: (c) 2019-2024 Eugen Wissner, +copyright: (c) 2019-2025 Eugen Wissner, (c) 2015-2017 J. Daniel Navarro license: MPL-2.0 AND BSD-3-Clause license-files: LICENSE, @@ -21,7 +21,7 @@ CHANGELOG.md README.md tested-with: - GHC == 9.8.2 + GHC == 9.10.1 source-repository head type: git @@ -90,7 +90,7 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: - QuickCheck >= 2.14 && < 2.16, + QuickCheck >= 2.14 && < 3, base, conduit, exceptions, diff --git a/src/Language/GraphQL/AST.hs b/src/Language/GraphQL/AST.hs --- a/src/Language/GraphQL/AST.hs +++ b/src/Language/GraphQL/AST.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} -- | Target AST for parser. diff --git a/src/Language/GraphQL/AST/DirectiveLocation.hs b/src/Language/GraphQL/AST/DirectiveLocation.hs --- a/src/Language/GraphQL/AST/DirectiveLocation.hs +++ b/src/Language/GraphQL/AST/DirectiveLocation.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} -- | Various parts of a GraphQL document can be annotated with directives. diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -3,6 +3,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} -- | This module defines an abstract syntax tree for the @GraphQL@ language. It diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} -- | This module defines a minifier and a printer for the @GraphQL@ language. diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs --- a/src/Language/GraphQL/AST/Lexer.hs +++ b/src/Language/GraphQL/AST/Lexer.hs @@ -1,5 +1,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} -- | This module defines a bunch of small parsers used to parse individual -- lexemes. diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -2,6 +2,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} +{-# LANGUAGE Safe #-} -- | @GraphQL@ document parser. module Language.GraphQL.AST.Parser diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -189,6 +189,8 @@ | CoercionError Full.VariableDefinition | UnknownInputType Full.VariableDefinition +type ExecuteHandler m a e = e -> ExecutorT m a + tell :: Monad m => Seq Error -> ExecutorT m () tell = ExecutorT . lift . Writer.tell @@ -313,8 +315,7 @@ pure $ Response data' errors handleException :: (MonadCatch m, Serialize a) - => FieldException - -> ExecutorT m a + => ExecuteHandler m a FieldException handleException (FieldException fieldLocation errorPath next) = let newError = constructError next fieldLocation errorPath in tell (Seq.singleton newError) >> pure null @@ -390,30 +391,28 @@ fieldErrorPath = fieldsSegment fields : errorPath inputCoercionHandler :: (MonadCatch m, Serialize a) => Full.Location - -> InputCoercionException - -> ExecutorT m a + -> ExecuteHandler m a InputCoercionException inputCoercionHandler _ e@(InputCoercionException _ _ (Just valueNode)) = let argumentLocation = getField @"location" valueNode in exceptionHandler argumentLocation e inputCoercionHandler fieldLocation e = exceptionHandler fieldLocation e resultHandler :: (MonadCatch m, Serialize a) => Full.Location - -> ResultException - -> ExecutorT m a + -> ExecuteHandler m a ResultException resultHandler = exceptionHandler resolverHandler :: (MonadCatch m, Serialize a) => Full.Location - -> ResolverException - -> ExecutorT m a + -> ExecuteHandler m a ResolverException resolverHandler = exceptionHandler - nullResultHandler :: (MonadCatch m, Serialize a) - => FieldException - -> ExecutorT m a + nullResultHandler :: (MonadCatch m, Serialize a) => ExecuteHandler m a FieldException nullResultHandler e@(FieldException fieldLocation errorPath' next) = let newError = constructError next fieldLocation errorPath' in if Out.isNonNullType fieldType then throwM e else returnError newError + exceptionHandler :: (Exception e, MonadCatch m, Serialize a) + => Full.Location + -> ExecuteHandler m a e exceptionHandler errorLocation e = let newError = constructError e errorLocation fieldErrorPath in if Out.isNonNullType fieldType diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs --- a/src/Language/GraphQL/Type/Definition.hs +++ b/src/Language/GraphQL/Type/Definition.hs @@ -3,6 +3,7 @@ obtain one at https://mozilla.org/MPL/2.0/. -} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} -- | Types that can be used as both input and output types. diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs --- a/src/Language/GraphQL/Type/In.hs +++ b/src/Language/GraphQL/Type/In.hs @@ -3,6 +3,7 @@ obtain one at https://mozilla.org/MPL/2.0/. -} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE NoGeneralizedNewtypeDeriving #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ViewPatterns #-} diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -1067,18 +1067,12 @@ go selectionSet selectionType = do fieldTuples <- evalStateT (collectFields selectionType selectionSet) HashSet.empty fieldsInSetCanMerge fieldTuples - fieldsInSetCanMerge :: forall m - . HashMap Full.Name (NonEmpty (Full.Field, Type.CompositeType m)) - -> ReaderT (Validation m) Seq Error fieldsInSetCanMerge fieldTuples = do validation <- ask let (lonely, paired) = flattenPairs fieldTuples let reader = flip runReaderT validation lift $ foldMap (reader . visitLonelyFields) lonely <> foldMap (reader . forEachFieldTuple) paired - forEachFieldTuple :: forall m - . (FieldInfo m, FieldInfo m) - -> ReaderT (Validation m) Seq Error forEachFieldTuple (fieldA, fieldB) = case (parent fieldA, parent fieldB) of (parentA@Type.CompositeObjectType{}, parentB@Type.CompositeObjectType{}) @@ -1105,10 +1099,6 @@ let Full.Field _ _ _ _ subSelections _ = node compositeFieldType = Type.outToComposite type' in maybe (lift Seq.empty) (go subSelections) compositeFieldType - sameResponseShape :: forall m - . FieldInfo m - -> FieldInfo m - -> ReaderT (Validation m) Seq Error sameResponseShape fieldA fieldB = let Full.Field _ _ _ _ selectionsA _ = node fieldA Full.Field _ _ _ _ selectionsB _ = node fieldB