Compare commits
7 Commits
Author | SHA1 | Date |
---|---|---|
Eugen Wissner | a5cf0a32e8 | |
Eugen Wissner | 2f9881bb21 | |
Eugen Wissner | bf2e4925b4 | |
Eugen Wissner | 2321d1a1bc | |
Eugen Wissner | 2f19093803 | |
Eugen Wissner | 0dac9701bc | |
Eugen Wissner | 0d25f482dd |
18
CHANGELOG.md
18
CHANGELOG.md
|
@ -6,6 +6,19 @@ 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.1.0.0] - 2022-12-24
|
||||||
|
### Changed
|
||||||
|
- Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`,
|
||||||
|
`singleError`.
|
||||||
|
- Deprecate `Resolution`, `CollectErrsT` and `runCollectErrs` in the `Error`
|
||||||
|
module. It was already noted in the documentation that these symbols are
|
||||||
|
deprecated, now a pragma is added.
|
||||||
|
- `Language.GraphQL`: Added information about the *json* flag and switching to
|
||||||
|
*graphql-spice* for JSON support.
|
||||||
|
|
||||||
|
### Added
|
||||||
|
- Partial schema printing: operation type encoder.
|
||||||
|
|
||||||
## [1.0.3.0] - 2022-03-27
|
## [1.0.3.0] - 2022-03-27
|
||||||
### Fixed
|
### Fixed
|
||||||
- Index position in error path. (Index and Segment paths of a field have been
|
- Index position in error path. (Index and Segment paths of a field have been
|
||||||
|
@ -477,8 +490,9 @@ and this project adheres to
|
||||||
### Added
|
### Added
|
||||||
- Data types for the GraphQL language.
|
- Data types for the GraphQL language.
|
||||||
|
|
||||||
[1.0.3.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=1.0.3.0&rev_to=v1.0.2.0
|
[1.1.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.1.0.0&rev_to=v1.0.3.0
|
||||||
[1.0.2.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=1.0.2.0&rev_to=v1.0.1.0
|
[1.0.3.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.3.0&rev_to=v1.0.2.0
|
||||||
|
[1.0.2.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.2.0&rev_to=v1.0.1.0
|
||||||
[1.0.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.1.0&rev_to=v1.0.0.0
|
[1.0.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.1.0&rev_to=v1.0.0.0
|
||||||
[1.0.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.0.0&rev_to=v0.11.1.0
|
[1.0.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.0.0&rev_to=v0.11.1.0
|
||||||
[0.11.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.1.0&rev_to=v0.11.0.0
|
[0.11.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.1.0&rev_to=v0.11.0.0
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
cabal-version: 2.4
|
cabal-version: 2.4
|
||||||
|
|
||||||
name: graphql
|
name: graphql
|
||||||
version: 1.0.3.0
|
version: 1.1.0.0
|
||||||
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-2021 Eugen Wissner,
|
copyright: (c) 2019-2022 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,
|
||||||
|
@ -22,7 +22,7 @@ extra-source-files:
|
||||||
README.md
|
README.md
|
||||||
tested-with:
|
tested-with:
|
||||||
GHC == 8.10.7,
|
GHC == 8.10.7,
|
||||||
GHC == 9.2.2
|
GHC == 9.2.4
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
|
@ -30,7 +30,7 @@ source-repository head
|
||||||
|
|
||||||
flag Json
|
flag Json
|
||||||
description: Whether to build against @aeson 1.x@
|
description: Whether to build against @aeson 1.x@
|
||||||
default: True
|
default: False
|
||||||
manual: True
|
manual: True
|
||||||
|
|
||||||
library
|
library
|
||||||
|
@ -111,6 +111,7 @@ test-suite graphql-test
|
||||||
exceptions,
|
exceptions,
|
||||||
graphql,
|
graphql,
|
||||||
hspec ^>= 2.9.1,
|
hspec ^>= 2.9.1,
|
||||||
|
hspec-expectations ^>= 0.8.2,
|
||||||
hspec-megaparsec ^>= 2.2.0,
|
hspec-megaparsec ^>= 2.2.0,
|
||||||
megaparsec,
|
megaparsec,
|
||||||
text,
|
text,
|
||||||
|
|
|
@ -4,6 +4,28 @@
|
||||||
|
|
||||||
#ifdef WITH_JSON
|
#ifdef WITH_JSON
|
||||||
-- | This module provides the functions to parse and execute @GraphQL@ queries.
|
-- | This module provides the functions to parse and execute @GraphQL@ queries.
|
||||||
|
--
|
||||||
|
-- The content of this module depends on the value of the __json__ flag, which
|
||||||
|
-- is currently on by default. This behavior will change in the future, the flag
|
||||||
|
-- will be switched off by default and then removed.
|
||||||
|
--
|
||||||
|
-- This documentation is generated with the enabled __json__ flag and functions
|
||||||
|
-- described here support JSON and are deprecated. JSON instances are provided
|
||||||
|
-- now by an additional package, __graphql-spice__. To start using the new
|
||||||
|
-- package create __cabal.project__ in the root directory of your project with
|
||||||
|
-- the following contents:
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- packages: .
|
||||||
|
-- constraints: graphql -json
|
||||||
|
-- @
|
||||||
|
--
|
||||||
|
-- Then add __graphql-spice__ as dependency.
|
||||||
|
--
|
||||||
|
-- The new version of this module defines only one function, @graphql@, which
|
||||||
|
-- works with the internal GraphQL value representation used by this lbirary.
|
||||||
|
-- Refer to @Language.GraphQL.JSON.graphql@ in __graphql-spice__ for the
|
||||||
|
-- function that accepts and returns JSON.
|
||||||
module Language.GraphQL
|
module Language.GraphQL
|
||||||
( graphql
|
( graphql
|
||||||
, graphqlSubs
|
, graphqlSubs
|
||||||
|
@ -23,6 +45,7 @@ import qualified Language.GraphQL.Validate as Validate
|
||||||
import Language.GraphQL.Type.Schema (Schema)
|
import Language.GraphQL.Type.Schema (Schema)
|
||||||
import Text.Megaparsec (parse)
|
import Text.Megaparsec (parse)
|
||||||
|
|
||||||
|
{-# DEPRECATED graphql "Use graphql-spice package instead" #-}
|
||||||
-- | If the text parses correctly as a @GraphQL@ query the query is
|
-- | If the text parses correctly as a @GraphQL@ query the query is
|
||||||
-- executed using the given 'Schema'.
|
-- executed using the given 'Schema'.
|
||||||
graphql :: MonadCatch m
|
graphql :: MonadCatch m
|
||||||
|
@ -31,6 +54,7 @@ graphql :: MonadCatch m
|
||||||
-> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
|
-> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
|
||||||
graphql schema = graphqlSubs schema mempty mempty
|
graphql schema = graphqlSubs schema mempty mempty
|
||||||
|
|
||||||
|
{-# DEPRECATED graphqlSubs "Use graphql-spice package instead" #-}
|
||||||
-- | If the text parses correctly as a @GraphQL@ query the substitution is
|
-- | If the text parses correctly as a @GraphQL@ query the substitution is
|
||||||
-- applied to the query and the query is then executed using to the given
|
-- applied to the query and the query is then executed using to the given
|
||||||
-- 'Schema'.
|
-- 'Schema'.
|
||||||
|
|
|
@ -11,6 +11,7 @@ module Language.GraphQL.AST.Encoder
|
||||||
, directive
|
, directive
|
||||||
, document
|
, document
|
||||||
, minified
|
, minified
|
||||||
|
, operationType
|
||||||
, pretty
|
, pretty
|
||||||
, type'
|
, type'
|
||||||
, value
|
, value
|
||||||
|
@ -34,7 +35,7 @@ import qualified Language.GraphQL.AST.Document as Full
|
||||||
-- Use 'pretty' or 'minified' to construct the formatter.
|
-- Use 'pretty' or 'minified' to construct the formatter.
|
||||||
data Formatter
|
data Formatter
|
||||||
= Minified
|
= Minified
|
||||||
| Pretty Word
|
| Pretty !Word
|
||||||
|
|
||||||
-- | Constructs a formatter for pretty printing.
|
-- | Constructs a formatter for pretty printing.
|
||||||
pretty :: Formatter
|
pretty :: Formatter
|
||||||
|
@ -101,7 +102,7 @@ variableDefinition formatter variableDefinition' =
|
||||||
in variable variableName
|
in variable variableName
|
||||||
<> eitherFormat formatter ": " ":"
|
<> eitherFormat formatter ": " ":"
|
||||||
<> type' variableType
|
<> type' variableType
|
||||||
<> maybe mempty (defaultValue formatter) (Full.node <$> defaultValue')
|
<> maybe mempty (defaultValue formatter . Full.node) defaultValue'
|
||||||
|
|
||||||
defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text
|
defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text
|
||||||
defaultValue formatter val
|
defaultValue formatter val
|
||||||
|
@ -294,6 +295,12 @@ nonNullType :: Full.NonNullType -> Lazy.Text
|
||||||
nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
|
nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
|
||||||
nonNullType (Full.NonNullTypeList x) = listType x <> "!"
|
nonNullType (Full.NonNullTypeList x) = listType x <> "!"
|
||||||
|
|
||||||
|
-- | Produces lowercase operation type: query, mutation or subscription.
|
||||||
|
operationType :: Formatter -> Full.OperationType -> Lazy.Text
|
||||||
|
operationType _formatter Full.Query = "query"
|
||||||
|
operationType _formatter Full.Mutation = "mutation"
|
||||||
|
operationType _formatter Full.Subscription = "subscription"
|
||||||
|
|
||||||
-- * Internal
|
-- * Internal
|
||||||
|
|
||||||
between :: Char -> Char -> Lazy.Text -> Lazy.Text
|
between :: Char -> Char -> Lazy.Text -> Lazy.Text
|
||||||
|
|
|
@ -58,6 +58,7 @@ import qualified Text.Megaparsec.Char.Lexer as Lexer
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy as TL
|
import qualified Data.Text.Lazy as TL
|
||||||
|
import Control.Monad (void)
|
||||||
|
|
||||||
-- | Standard parser.
|
-- | Standard parser.
|
||||||
-- Accepts the type of the parsed token.
|
-- Accepts the type of the parsed token.
|
||||||
|
@ -93,7 +94,7 @@ dollar = symbol "$"
|
||||||
|
|
||||||
-- | Parser for "@".
|
-- | Parser for "@".
|
||||||
at :: Parser ()
|
at :: Parser ()
|
||||||
at = symbol "@" >> pure ()
|
at = void $ symbol "@"
|
||||||
|
|
||||||
-- | Parser for "&".
|
-- | Parser for "&".
|
||||||
amp :: Parser T.Text
|
amp :: Parser T.Text
|
||||||
|
@ -101,7 +102,7 @@ amp = symbol "&"
|
||||||
|
|
||||||
-- | Parser for ":".
|
-- | Parser for ":".
|
||||||
colon :: Parser ()
|
colon :: Parser ()
|
||||||
colon = symbol ":" >> pure ()
|
colon = void $ symbol ":"
|
||||||
|
|
||||||
-- | Parser for "=".
|
-- | Parser for "=".
|
||||||
equals :: Parser T.Text
|
equals :: Parser T.Text
|
||||||
|
@ -220,7 +221,7 @@ escapeSequence = do
|
||||||
|
|
||||||
-- | Parser for the "Byte Order Mark".
|
-- | Parser for the "Byte Order Mark".
|
||||||
unicodeBOM :: Parser ()
|
unicodeBOM :: Parser ()
|
||||||
unicodeBOM = optional (char '\xfeff') >> pure ()
|
unicodeBOM = void $ optional $ char '\xfeff'
|
||||||
|
|
||||||
-- | Parses "extend" followed by a 'symbol'. It is used by schema extensions.
|
-- | Parses "extend" followed by a 'symbol'. It is used by schema extensions.
|
||||||
extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
|
extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
|
||||||
|
|
|
@ -15,16 +15,13 @@ module Language.GraphQL.Error
|
||||||
, ResolverException(..)
|
, ResolverException(..)
|
||||||
, Response(..)
|
, Response(..)
|
||||||
, ResponseEventStream
|
, ResponseEventStream
|
||||||
, addErr
|
|
||||||
, addErrMsg
|
|
||||||
, parseError
|
, parseError
|
||||||
, runCollectErrs
|
, runCollectErrs
|
||||||
, singleError
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Conduit
|
import Conduit
|
||||||
import Control.Exception (Exception(..))
|
import Control.Exception (Exception(..))
|
||||||
import Control.Monad.Trans.State (StateT, modify, runStateT)
|
import Control.Monad.Trans.State (StateT, runStateT)
|
||||||
import Data.HashMap.Strict (HashMap)
|
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
|
||||||
|
@ -103,11 +100,9 @@ instance Exception ResolverException
|
||||||
|
|
||||||
-- * Deprecated
|
-- * 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
|
-- | Runs the given query computation, but collects the errors into an error
|
||||||
-- list, which is then sent back with the data.
|
-- list, which is then sent back with the data.
|
||||||
--
|
|
||||||
-- /runCollectErrs was part of the old executor and isn't used anymore, it will
|
|
||||||
-- be deprecated in the future and removed./
|
|
||||||
runCollectErrs :: (Monad m, Serialize a)
|
runCollectErrs :: (Monad m, Serialize a)
|
||||||
=> HashMap Name (Schema.Type m)
|
=> HashMap Name (Schema.Type m)
|
||||||
-> CollectErrsT m a
|
-> CollectErrsT m a
|
||||||
|
@ -117,40 +112,13 @@ runCollectErrs types' res = do
|
||||||
$ Resolution{ errors = Seq.empty, types = types' }
|
$ Resolution{ errors = Seq.empty, types = types' }
|
||||||
pure $ Response dat errors
|
pure $ Response dat errors
|
||||||
|
|
||||||
|
{-# DEPRECATED Resolution "Resolution was part of the old executor and isn't used anymore" #-}
|
||||||
-- | Executor context.
|
-- | Executor context.
|
||||||
--
|
|
||||||
-- /Resolution was part of the old executor and isn't used anymore, it will be
|
|
||||||
-- deprecated in the future and removed./
|
|
||||||
data Resolution m = Resolution
|
data Resolution m = Resolution
|
||||||
{ errors :: Seq Error
|
{ errors :: Seq Error
|
||||||
, types :: HashMap Name (Schema.Type m)
|
, 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.
|
-- | A wrapper to pass error messages around.
|
||||||
--
|
|
||||||
-- /CollectErrsT was part of the old executor and isn't used anymore, it will be
|
|
||||||
-- deprecated in the future and removed./
|
|
||||||
type CollectErrsT m = StateT (Resolution m) m
|
type CollectErrsT m = StateT (Resolution m) m
|
||||||
|
|
||||||
-- | Adds an error to the list of errors.
|
|
||||||
{-# DEPRECATED #-}
|
|
||||||
addErr :: Monad m => Error -> CollectErrsT m ()
|
|
||||||
addErr v = modify appender
|
|
||||||
where
|
|
||||||
appender :: Monad m => Resolution m -> Resolution m
|
|
||||||
appender resolution@Resolution{..} = resolution{ errors = errors |> v }
|
|
||||||
|
|
||||||
{-# DEPRECATED #-}
|
|
||||||
makeErrorMessage :: Text -> Error
|
|
||||||
makeErrorMessage s = Error s [] []
|
|
||||||
|
|
||||||
-- | Constructs a response object containing only the error with the given
|
|
||||||
-- message.
|
|
||||||
{-# DEPRECATED #-}
|
|
||||||
singleError :: Serialize a => Text -> Response a
|
|
||||||
singleError message = Response null $ Seq.singleton $ Error message [] []
|
|
||||||
|
|
||||||
-- | Convenience function for just wrapping an error message.
|
|
||||||
{-# DEPRECATED #-}
|
|
||||||
addErrMsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
|
|
||||||
addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null
|
|
||||||
|
|
|
@ -8,6 +8,11 @@
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
-- | Types and functions used for input and result coercion.
|
-- | Types and functions used for input and result coercion.
|
||||||
|
--
|
||||||
|
-- JSON instances in this module are only available with the __json__
|
||||||
|
-- flag that is currently on by default, but will be disabled in the future.
|
||||||
|
-- Refer to the documentation in the 'Language.GraphQL' module and to
|
||||||
|
-- the __graphql-spice__ package.
|
||||||
module Language.GraphQL.Execute.Coerce
|
module Language.GraphQL.Execute.Coerce
|
||||||
( Output(..)
|
( Output(..)
|
||||||
, Serialize(..)
|
, Serialize(..)
|
||||||
|
|
|
@ -54,7 +54,7 @@ import Data.HashMap.Strict (HashMap)
|
||||||
import Data.HashSet (HashSet)
|
import Data.HashSet (HashSet)
|
||||||
import qualified Data.HashSet as HashSet
|
import qualified Data.HashSet as HashSet
|
||||||
import Data.List (groupBy, sortBy, sortOn)
|
import Data.List (groupBy, sortBy, sortOn)
|
||||||
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
|
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
|
||||||
import Data.List.NonEmpty (NonEmpty(..))
|
import Data.List.NonEmpty (NonEmpty(..))
|
||||||
import Data.Ord (comparing)
|
import Data.Ord (comparing)
|
||||||
import Data.Sequence (Seq(..), (|>))
|
import Data.Sequence (Seq(..), (|>))
|
||||||
|
@ -1551,9 +1551,9 @@ valuesOfCorrectTypeRule = ValueRule go constGo
|
||||||
toConst Full.Null = Just Full.ConstNull
|
toConst Full.Null = Just Full.ConstNull
|
||||||
toConst (Full.Enum enum) = Just $ Full.ConstEnum enum
|
toConst (Full.Enum enum) = Just $ Full.ConstEnum enum
|
||||||
toConst (Full.List values) =
|
toConst (Full.List values) =
|
||||||
Just $ Full.ConstList $ catMaybes $ toConstNode <$> values
|
Just $ Full.ConstList $ mapMaybe toConstNode values
|
||||||
toConst (Full.Object fields) = Just $ Full.ConstObject
|
toConst (Full.Object fields) = Just $ Full.ConstObject
|
||||||
$ catMaybes $ constObjectField <$> fields
|
$ mapMaybe constObjectField fields
|
||||||
constObjectField Full.ObjectField{..}
|
constObjectField Full.ObjectField{..}
|
||||||
| Just constValue <- toConstNode value =
|
| Just constValue <- toConstNode value =
|
||||||
Just $ Full.ObjectField name constValue location
|
Just $ Full.ObjectField name constValue location
|
||||||
|
|
|
@ -9,7 +9,7 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
-- | Test helpers.
|
-- | Test helpers.
|
||||||
module Test.Hspec.GraphQL
|
module Test.Hspec.GraphQL {-# DEPRECATED "Use graphql-spice package instead" #-}
|
||||||
( shouldResolve
|
( shouldResolve
|
||||||
, shouldResolveTo
|
, shouldResolveTo
|
||||||
) where
|
) where
|
||||||
|
@ -43,7 +43,7 @@ shouldResolve executor query = do
|
||||||
_ -> expectationFailure
|
_ -> expectationFailure
|
||||||
"the query is expected to resolve to a value, but it resolved to an event stream"
|
"the query is expected to resolve to a value, but it resolved to an event stream"
|
||||||
#else
|
#else
|
||||||
module Test.Hspec.GraphQL
|
module Test.Hspec.GraphQL {-# DEPRECATED "Use graphql-spice package instead" #-}
|
||||||
(
|
(
|
||||||
) where
|
) where
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -173,3 +173,8 @@ spec = do
|
||||||
|] '\n'
|
|] '\n'
|
||||||
actual = definition pretty operation
|
actual = definition pretty operation
|
||||||
in actual `shouldBe` expected
|
in actual `shouldBe` expected
|
||||||
|
|
||||||
|
describe "operationType" $
|
||||||
|
it "produces lowercase mutation operation type" $
|
||||||
|
let actual = operationType pretty Full.Mutation
|
||||||
|
in actual `shouldBe` "mutation"
|
||||||
|
|
|
@ -2,6 +2,10 @@
|
||||||
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 DuplicateRecordFields #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
|
@ -9,7 +13,7 @@ module Language.GraphQL.ExecuteSpec
|
||||||
( spec
|
( spec
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception (Exception(..), SomeException)
|
import Control.Exception (Exception(..))
|
||||||
import Control.Monad.Catch (throwM)
|
import Control.Monad.Catch (throwM)
|
||||||
import Data.Conduit
|
import Data.Conduit
|
||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
|
@ -27,11 +31,17 @@ import qualified Language.GraphQL.Type.In as In
|
||||||
import qualified Language.GraphQL.Type.Out as Out
|
import qualified Language.GraphQL.Type.Out as Out
|
||||||
import Prelude hiding (id)
|
import Prelude hiding (id)
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
import Text.Megaparsec (parse)
|
import Text.Megaparsec (parse, errorBundlePretty)
|
||||||
import Schemas.HeroSchema (heroSchema)
|
import Schemas.HeroSchema (heroSchema)
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
|
import Test.Hspec.Expectations
|
||||||
|
( Expectation
|
||||||
|
, expectationFailure
|
||||||
|
)
|
||||||
|
import Data.Either (fromRight)
|
||||||
|
|
||||||
data PhilosopherException = PhilosopherException
|
data PhilosopherException = PhilosopherException
|
||||||
deriving Show
|
deriving Show
|
||||||
|
@ -42,7 +52,7 @@ instance Exception PhilosopherException where
|
||||||
ResolverException resolverException <- fromException e
|
ResolverException resolverException <- fromException e
|
||||||
cast resolverException
|
cast resolverException
|
||||||
|
|
||||||
philosopherSchema :: Schema (Either SomeException)
|
philosopherSchema :: Schema IO
|
||||||
philosopherSchema =
|
philosopherSchema =
|
||||||
schemaWithTypes Nothing queryType Nothing subscriptionRoot extraTypes mempty
|
schemaWithTypes Nothing queryType Nothing subscriptionRoot extraTypes mempty
|
||||||
where
|
where
|
||||||
|
@ -52,7 +62,7 @@ philosopherSchema =
|
||||||
, Schema.ObjectType bookCollectionType
|
, Schema.ObjectType bookCollectionType
|
||||||
]
|
]
|
||||||
|
|
||||||
queryType :: Out.ObjectType (Either SomeException)
|
queryType :: Out.ObjectType IO
|
||||||
queryType = Out.ObjectType "Query" Nothing []
|
queryType = Out.ObjectType "Query" Nothing []
|
||||||
$ HashMap.fromList
|
$ HashMap.fromList
|
||||||
[ ("philosopher", ValueResolver philosopherField philosopherResolver)
|
[ ("philosopher", ValueResolver philosopherField philosopherResolver)
|
||||||
|
@ -68,14 +78,14 @@ queryType = Out.ObjectType "Query" Nothing []
|
||||||
genresField =
|
genresField =
|
||||||
let fieldType = Out.ListType $ Out.NonNullScalarType string
|
let fieldType = Out.ListType $ Out.NonNullScalarType string
|
||||||
in Out.Field Nothing fieldType HashMap.empty
|
in Out.Field Nothing fieldType HashMap.empty
|
||||||
genresResolver :: Resolve (Either SomeException)
|
genresResolver :: Resolve IO
|
||||||
genresResolver = throwM PhilosopherException
|
genresResolver = throwM PhilosopherException
|
||||||
countField =
|
countField =
|
||||||
let fieldType = Out.NonNullScalarType int
|
let fieldType = Out.NonNullScalarType int
|
||||||
in Out.Field Nothing fieldType HashMap.empty
|
in Out.Field Nothing fieldType HashMap.empty
|
||||||
countResolver = pure ""
|
countResolver = pure ""
|
||||||
|
|
||||||
musicType :: Out.ObjectType (Either SomeException)
|
musicType :: Out.ObjectType IO
|
||||||
musicType = Out.ObjectType "Music" Nothing []
|
musicType = Out.ObjectType "Music" Nothing []
|
||||||
$ HashMap.fromList resolvers
|
$ HashMap.fromList resolvers
|
||||||
where
|
where
|
||||||
|
@ -85,7 +95,7 @@ musicType = Out.ObjectType "Music" Nothing []
|
||||||
instrumentResolver = pure $ String "piano"
|
instrumentResolver = pure $ String "piano"
|
||||||
instrumentField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
instrumentField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
||||||
|
|
||||||
poetryType :: Out.ObjectType (Either SomeException)
|
poetryType :: Out.ObjectType IO
|
||||||
poetryType = Out.ObjectType "Poetry" Nothing []
|
poetryType = Out.ObjectType "Poetry" Nothing []
|
||||||
$ HashMap.fromList resolvers
|
$ HashMap.fromList resolvers
|
||||||
where
|
where
|
||||||
|
@ -95,10 +105,10 @@ poetryType = Out.ObjectType "Poetry" Nothing []
|
||||||
genreResolver = pure $ String "Futurism"
|
genreResolver = pure $ String "Futurism"
|
||||||
genreField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
genreField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
||||||
|
|
||||||
interestType :: Out.UnionType (Either SomeException)
|
interestType :: Out.UnionType IO
|
||||||
interestType = Out.UnionType "Interest" Nothing [musicType, poetryType]
|
interestType = Out.UnionType "Interest" Nothing [musicType, poetryType]
|
||||||
|
|
||||||
philosopherType :: Out.ObjectType (Either SomeException)
|
philosopherType :: Out.ObjectType IO
|
||||||
philosopherType = Out.ObjectType "Philosopher" Nothing []
|
philosopherType = Out.ObjectType "Philosopher" Nothing []
|
||||||
$ HashMap.fromList resolvers
|
$ HashMap.fromList resolvers
|
||||||
where
|
where
|
||||||
|
@ -139,14 +149,14 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
|
||||||
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
||||||
firstLanguageResolver = pure Null
|
firstLanguageResolver = pure Null
|
||||||
|
|
||||||
workType :: Out.InterfaceType (Either SomeException)
|
workType :: Out.InterfaceType IO
|
||||||
workType = Out.InterfaceType "Work" Nothing []
|
workType = Out.InterfaceType "Work" Nothing []
|
||||||
$ HashMap.fromList fields
|
$ HashMap.fromList fields
|
||||||
where
|
where
|
||||||
fields = [("title", titleField)]
|
fields = [("title", titleField)]
|
||||||
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
||||||
|
|
||||||
bookType :: Out.ObjectType (Either SomeException)
|
bookType :: Out.ObjectType IO
|
||||||
bookType = Out.ObjectType "Book" Nothing [workType]
|
bookType = Out.ObjectType "Book" Nothing [workType]
|
||||||
$ HashMap.fromList resolvers
|
$ HashMap.fromList resolvers
|
||||||
where
|
where
|
||||||
|
@ -156,7 +166,7 @@ bookType = Out.ObjectType "Book" Nothing [workType]
|
||||||
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
||||||
titleResolver = pure "Also sprach Zarathustra: Ein Buch für Alle und Keinen"
|
titleResolver = pure "Also sprach Zarathustra: Ein Buch für Alle und Keinen"
|
||||||
|
|
||||||
bookCollectionType :: Out.ObjectType (Either SomeException)
|
bookCollectionType :: Out.ObjectType IO
|
||||||
bookCollectionType = Out.ObjectType "Book" Nothing [workType]
|
bookCollectionType = Out.ObjectType "Book" Nothing [workType]
|
||||||
$ HashMap.fromList resolvers
|
$ HashMap.fromList resolvers
|
||||||
where
|
where
|
||||||
|
@ -166,7 +176,7 @@ bookCollectionType = Out.ObjectType "Book" Nothing [workType]
|
||||||
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
|
||||||
titleResolver = pure "The Three Critiques"
|
titleResolver = pure "The Three Critiques"
|
||||||
|
|
||||||
subscriptionType :: Out.ObjectType (Either SomeException)
|
subscriptionType :: Out.ObjectType IO
|
||||||
subscriptionType = Out.ObjectType "Subscription" Nothing []
|
subscriptionType = Out.ObjectType "Subscription" Nothing []
|
||||||
$ HashMap.singleton "newQuote"
|
$ HashMap.singleton "newQuote"
|
||||||
$ EventStreamResolver quoteField (pure $ Object mempty)
|
$ EventStreamResolver quoteField (pure $ Object mempty)
|
||||||
|
@ -175,7 +185,7 @@ subscriptionType = Out.ObjectType "Subscription" Nothing []
|
||||||
quoteField =
|
quoteField =
|
||||||
Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
|
Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
|
||||||
|
|
||||||
quoteType :: Out.ObjectType (Either SomeException)
|
quoteType :: Out.ObjectType IO
|
||||||
quoteType = Out.ObjectType "Quote" Nothing []
|
quoteType = Out.ObjectType "Quote" Nothing []
|
||||||
$ HashMap.singleton "quote"
|
$ HashMap.singleton "quote"
|
||||||
$ ValueResolver quoteField
|
$ ValueResolver quoteField
|
||||||
|
@ -192,12 +202,48 @@ schoolType = EnumType "School" Nothing $ HashMap.fromList
|
||||||
]
|
]
|
||||||
|
|
||||||
type EitherStreamOrValue = Either
|
type EitherStreamOrValue = Either
|
||||||
(ResponseEventStream (Either SomeException) Type.Value)
|
(ResponseEventStream IO Type.Value)
|
||||||
(Response Type.Value)
|
(Response Type.Value)
|
||||||
|
|
||||||
execute' :: Document -> Either SomeException EitherStreamOrValue
|
-- Asserts that a query resolves to a value.
|
||||||
execute' =
|
shouldResolveTo :: Text.Text -> Response Type.Value -> Expectation
|
||||||
execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value)
|
shouldResolveTo querySource expected =
|
||||||
|
case parse document "" querySource of
|
||||||
|
(Right parsedDocument) ->
|
||||||
|
execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value) parsedDocument >>= go
|
||||||
|
(Left errorBundle) -> expectationFailure $ errorBundlePretty errorBundle
|
||||||
|
where
|
||||||
|
go = \case
|
||||||
|
Right result -> shouldBe result expected
|
||||||
|
Left _ -> expectationFailure
|
||||||
|
"the query is expected to resolve to a value, but it resolved to an event stream"
|
||||||
|
|
||||||
|
-- Asserts that the executor produces an error that starts with a string.
|
||||||
|
shouldContainError :: Either (ResponseEventStream IO Type.Value) (Response Type.Value)
|
||||||
|
-> Text
|
||||||
|
-> Expectation
|
||||||
|
shouldContainError streamOrValue expected =
|
||||||
|
case streamOrValue of
|
||||||
|
Right response -> respond response
|
||||||
|
Left _ -> expectationFailure
|
||||||
|
"the query is expected to resolve to a value, but it resolved to an event stream"
|
||||||
|
where
|
||||||
|
startsWith :: Text.Text -> Text.Text -> Bool
|
||||||
|
startsWith xs ys = Text.take (Text.length ys) xs == ys
|
||||||
|
respond :: Response Type.Value -> Expectation
|
||||||
|
respond Response{ errors }
|
||||||
|
| any ((`startsWith` expected) . message) errors = pure ()
|
||||||
|
| otherwise = expectationFailure
|
||||||
|
"the query is expected to execute with errors, but the response doesn't contain any errors"
|
||||||
|
|
||||||
|
parseAndExecute :: Schema IO
|
||||||
|
-> Maybe Text
|
||||||
|
-> HashMap Name Type.Value
|
||||||
|
-> Text
|
||||||
|
-> IO (Either (ResponseEventStream IO Type.Value) (Response Type.Value))
|
||||||
|
parseAndExecute schema' operation variables
|
||||||
|
= either (pure . parseError) (execute schema' operation variables)
|
||||||
|
. parse document ""
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec =
|
spec =
|
||||||
|
@ -213,9 +259,7 @@ spec =
|
||||||
}
|
}
|
||||||
|]
|
|]
|
||||||
expected = Response (Object mempty) mempty
|
expected = Response (Object mempty) mempty
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
in sourceQuery `shouldResolveTo` expected
|
||||||
$ parse document "" sourceQuery
|
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
context "Query" $ do
|
context "Query" $ do
|
||||||
it "skips unknown fields" $
|
it "skips unknown fields" $
|
||||||
|
@ -225,9 +269,8 @@ spec =
|
||||||
$ HashMap.singleton "firstName"
|
$ HashMap.singleton "firstName"
|
||||||
$ String "Friedrich"
|
$ String "Friedrich"
|
||||||
expected = Response data'' mempty
|
expected = Response data'' mempty
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ philosopher { firstName surname } }"
|
||||||
$ parse document "" "{ philosopher { firstName surname } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
it "merges selections" $
|
it "merges selections" $
|
||||||
let data'' = Object
|
let data'' = Object
|
||||||
$ HashMap.singleton "philosopher"
|
$ HashMap.singleton "philosopher"
|
||||||
|
@ -237,9 +280,8 @@ spec =
|
||||||
, ("lastName", String "Nietzsche")
|
, ("lastName", String "Nietzsche")
|
||||||
]
|
]
|
||||||
expected = Response data'' mempty
|
expected = Response data'' mempty
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ philosopher { firstName } philosopher { lastName } }"
|
||||||
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "errors on invalid output enum values" $
|
it "errors on invalid output enum values" $
|
||||||
let data'' = Object $ HashMap.singleton "philosopher" Null
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
|
@ -250,9 +292,8 @@ spec =
|
||||||
, path = [Segment "philosopher", Segment "school"]
|
, path = [Segment "philosopher", Segment "school"]
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ philosopher { school } }"
|
||||||
$ parse document "" "{ philosopher { school } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "gives location information for non-null unions" $
|
it "gives location information for non-null unions" $
|
||||||
let data'' = Object $ HashMap.singleton "philosopher" Null
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
|
@ -263,9 +304,8 @@ spec =
|
||||||
, path = [Segment "philosopher", Segment "interest"]
|
, path = [Segment "philosopher", Segment "interest"]
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ philosopher { interest } }"
|
||||||
$ parse document "" "{ philosopher { interest } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "gives location information for invalid interfaces" $
|
it "gives location information for invalid interfaces" $
|
||||||
let data'' = Object $ HashMap.singleton "philosopher" Null
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
|
@ -277,9 +317,8 @@ spec =
|
||||||
, path = [Segment "philosopher", Segment "majorWork"]
|
, path = [Segment "philosopher", Segment "majorWork"]
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ philosopher { majorWork { title } } }"
|
||||||
$ parse document "" "{ philosopher { majorWork { title } } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "gives location information for invalid scalar arguments" $
|
it "gives location information for invalid scalar arguments" $
|
||||||
let data'' = Object $ HashMap.singleton "philosopher" Null
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
|
@ -290,9 +329,8 @@ spec =
|
||||||
, path = [Segment "philosopher"]
|
, path = [Segment "philosopher"]
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ philosopher(id: true) { lastName } }"
|
||||||
$ parse document "" "{ philosopher(id: true) { lastName } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` 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
|
||||||
|
@ -302,9 +340,8 @@ spec =
|
||||||
, path = [Segment "philosopher", Segment "century"]
|
, path = [Segment "philosopher", Segment "century"]
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ philosopher(id: \"1\") { century } }"
|
||||||
$ parse document "" "{ philosopher(id: \"1\") { century } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "gives location information for failed result coercion" $
|
it "gives location information for failed result coercion" $
|
||||||
let data'' = Object $ HashMap.singleton "genres" Null
|
let data'' = Object $ HashMap.singleton "genres" Null
|
||||||
|
@ -314,9 +351,8 @@ spec =
|
||||||
, path = [Segment "genres"]
|
, path = [Segment "genres"]
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ genres }"
|
||||||
$ parse document "" "{ genres }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
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
|
||||||
|
@ -325,9 +361,8 @@ spec =
|
||||||
, path = [Segment "count"]
|
, path = [Segment "count"]
|
||||||
}
|
}
|
||||||
expected = Response Null executionErrors
|
expected = Response Null executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ count }"
|
||||||
$ parse document "" "{ count }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
it "detects nullability errors" $
|
it "detects nullability errors" $
|
||||||
let data'' = Object $ HashMap.singleton "philosopher" Null
|
let data'' = Object $ HashMap.singleton "philosopher" Null
|
||||||
|
@ -337,35 +372,24 @@ spec =
|
||||||
, path = [Segment "philosopher", Segment "firstLanguage"]
|
, path = [Segment "philosopher", Segment "firstLanguage"]
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "{ philosopher(id: \"1\") { firstLanguage } }"
|
||||||
$ parse document "" "{ philosopher(id: \"1\") { firstLanguage } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
context "queryError" $ do
|
context "queryError" $ do
|
||||||
let
|
let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"
|
||||||
namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"
|
twoQueries = namedQuery "A" <> " " <> namedQuery "B"
|
||||||
twoQueries = namedQuery "A" <> " " <> namedQuery "B"
|
|
||||||
startsWith :: Text.Text -> Text.Text -> Bool
|
|
||||||
startsWith xs ys = Text.take (Text.length ys) xs == ys
|
|
||||||
|
|
||||||
it "throws operation name is required error" $
|
it "throws operation name is required error" $ do
|
||||||
let expectedErrorMessage :: Text.Text
|
let expectedErrorMessage = "Operation name is required"
|
||||||
expectedErrorMessage = "Operation name is required"
|
actual <- parseAndExecute philosopherSchema Nothing mempty twoQueries
|
||||||
Right (Right (Response _ executionErrors)) = either (pure . parseError) execute' $ parse document "" twoQueries
|
actual `shouldContainError` expectedErrorMessage
|
||||||
Error msg _ _ = Seq.index executionErrors 0
|
|
||||||
in msg `startsWith` expectedErrorMessage `shouldBe` True
|
|
||||||
|
|
||||||
it "throws operation not found error" $
|
it "throws operation not found error" $ do
|
||||||
let expectedErrorMessage :: Text.Text
|
let expectedErrorMessage = "Operation \"C\" is not found"
|
||||||
expectedErrorMessage = "Operation \"C\" is not found"
|
actual <- parseAndExecute philosopherSchema (Just "C") mempty twoQueries
|
||||||
execute'' :: Document -> Either SomeException EitherStreamOrValue
|
actual `shouldContainError` expectedErrorMessage
|
||||||
execute'' = execute philosopherSchema (Just "C") (mempty :: HashMap Name Type.Value)
|
|
||||||
Right (Right (Response _ executionErrors)) = either (pure . parseError) execute''
|
|
||||||
$ parse document "" twoQueries
|
|
||||||
Error msg _ _ = Seq.index executionErrors 0
|
|
||||||
in msg `startsWith` expectedErrorMessage `shouldBe` True
|
|
||||||
|
|
||||||
it "throws variable coercion error" $
|
it "throws variable coercion error" $ do
|
||||||
let data'' = Null
|
let data'' = Null
|
||||||
executionErrors = pure $ Error
|
executionErrors = pure $ Error
|
||||||
{ message = "Failed to coerce the variable $id: String."
|
{ message = "Failed to coerce the variable $id: String."
|
||||||
|
@ -373,11 +397,10 @@ spec =
|
||||||
, path = []
|
, path = []
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
executeWithVars :: Document -> Either SomeException EitherStreamOrValue
|
|
||||||
executeWithVars = execute philosopherSchema Nothing (HashMap.singleton "id" (Type.Int 1))
|
executeWithVars = execute philosopherSchema Nothing (HashMap.singleton "id" (Type.Int 1))
|
||||||
Right (Right actual) = either (pure . parseError) executeWithVars
|
Right actual <- either (pure . parseError) executeWithVars
|
||||||
$ parse document "" "query($id: String) { philosopher(id: \"1\") { firstLanguage } }"
|
$ parse document "" "query($id: String) { philosopher(id: \"1\") { firstLanguage } }"
|
||||||
in actual `shouldBe` expected
|
actual `shouldBe` expected
|
||||||
|
|
||||||
it "throws variable unkown input type error" $
|
it "throws variable unkown input type error" $
|
||||||
let data'' = Null
|
let data'' = Null
|
||||||
|
@ -387,31 +410,31 @@ spec =
|
||||||
, path = []
|
, path = []
|
||||||
}
|
}
|
||||||
expected = Response data'' executionErrors
|
expected = Response data'' executionErrors
|
||||||
Right (Right actual) = either (pure . parseError) execute'
|
sourceQuery = "query($id: Cat) { philosopher(id: \"1\") { firstLanguage } }"
|
||||||
$ parse document "" "query($id: Cat) { philosopher(id: \"1\") { firstLanguage } }"
|
in sourceQuery `shouldResolveTo` expected
|
||||||
in actual `shouldBe` expected
|
|
||||||
|
|
||||||
context "Error path" $ do
|
context "Error path" $ do
|
||||||
let executeHero :: Document -> Either SomeException EitherStreamOrValue
|
let executeHero :: Document -> IO EitherStreamOrValue
|
||||||
executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Type.Value)
|
executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Type.Value)
|
||||||
|
|
||||||
it "at the beggining of the list" $
|
it "at the beggining of the list" $ do
|
||||||
let Right (Right actual) = either (pure . parseError) executeHero
|
Right actual <- either (pure . parseError) executeHero
|
||||||
$ parse document "" "{ hero(id: \"1\") { friends { name } } }"
|
$ parse document "" "{ hero(id: \"1\") { friends { name } } }"
|
||||||
Response _ errors' = actual
|
let Response _ errors' = actual
|
||||||
Error _ _ path' = fromJust $ Seq.lookup 0 errors'
|
Error _ _ path' = fromJust $ Seq.lookup 0 errors'
|
||||||
expected = [Segment "hero", Segment "friends", Index 0, Segment "name"]
|
expected = [Segment "hero", Segment "friends", Index 0, Segment "name"]
|
||||||
in path' `shouldBe` expected
|
in path' `shouldBe` expected
|
||||||
|
|
||||||
context "Subscription" $
|
context "Subscription" $
|
||||||
it "subscribes" $
|
it "subscribes" $ do
|
||||||
let data'' = Object
|
let data'' = Object
|
||||||
$ HashMap.singleton "newQuote"
|
$ HashMap.singleton "newQuote"
|
||||||
$ Object
|
$ Object
|
||||||
$ HashMap.singleton "quote"
|
$ HashMap.singleton "quote"
|
||||||
$ String "Naturam expelles furca, tamen usque recurret."
|
$ String "Naturam expelles furca, tamen usque recurret."
|
||||||
expected = Response data'' mempty
|
expected = Response data'' mempty
|
||||||
Right (Left stream) = either (pure . parseError) execute'
|
Left stream <- execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value)
|
||||||
$ parse document "" "subscription { newQuote { quote } }"
|
$ fromRight (error "Parse error")
|
||||||
Right (Just actual) = runConduit $ stream .| await
|
$ parse document "" "subscription { newQuote { quote } }"
|
||||||
in actual `shouldBe` expected
|
Just actual <- runConduit $ stream .| await
|
||||||
|
actual `shouldBe` expected
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
|
|
||||||
module Schemas.HeroSchema (heroSchema) where
|
module Schemas.HeroSchema (heroSchema) where
|
||||||
|
|
||||||
import Control.Exception (Exception(..), SomeException)
|
import Control.Exception (Exception(..))
|
||||||
import Control.Monad.Catch (throwM)
|
import Control.Monad.Catch (throwM)
|
||||||
import Language.GraphQL.Error (ResolverException (..))
|
import Language.GraphQL.Error (ResolverException (..))
|
||||||
import qualified Language.GraphQL.Type.In as In
|
import qualified Language.GraphQL.Type.In as In
|
||||||
|
@ -25,11 +25,11 @@ instance Exception HeroException where
|
||||||
ResolverException resolverException <- fromException e
|
ResolverException resolverException <- fromException e
|
||||||
cast resolverException
|
cast resolverException
|
||||||
|
|
||||||
heroSchema :: Type.Schema (Either SomeException)
|
heroSchema :: Type.Schema IO
|
||||||
heroSchema =
|
heroSchema =
|
||||||
schemaWithTypes Nothing queryType Nothing Nothing [] mempty
|
schemaWithTypes Nothing queryType Nothing Nothing [] mempty
|
||||||
|
|
||||||
type ObjectType = Out.ObjectType (Either SomeException)
|
type ObjectType = Out.ObjectType IO
|
||||||
|
|
||||||
queryType :: ObjectType
|
queryType :: ObjectType
|
||||||
queryType = Out.ObjectType "Query" Nothing []
|
queryType = Out.ObjectType "Query" Nothing []
|
||||||
|
@ -42,7 +42,7 @@ queryType = Out.ObjectType "Query" Nothing []
|
||||||
$ In.Argument Nothing (In.NamedScalarType Type.id) Nothing
|
$ In.Argument Nothing (In.NamedScalarType Type.id) Nothing
|
||||||
heroResolver = pure $ Type.Object mempty
|
heroResolver = pure $ Type.Object mempty
|
||||||
|
|
||||||
stringField :: Out.Field (Either SomeException)
|
stringField :: Out.Field IO
|
||||||
stringField = Out.Field Nothing (Out.NonNullScalarType Type.string) HashMap.empty
|
stringField = Out.Field Nothing (Out.NonNullScalarType Type.string) HashMap.empty
|
||||||
|
|
||||||
heroType :: ObjectType
|
heroType :: ObjectType
|
||||||
|
|
Loading…
Reference in New Issue