graphql/tests/Language/GraphQL/ExecuteSpec.hs

249 lines
9.7 KiB
Haskell
Raw Normal View History

{- This Source Code Form is subject to the terms of the Mozilla Public License,
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/. -}
2020-06-10 11:42:00 +02:00
{-# LANGUAGE OverloadedStrings #-}
2020-09-11 08:03:49 +02:00
{-# LANGUAGE QuasiQuotes #-}
2020-06-10 11:42:00 +02:00
module Language.GraphQL.ExecuteSpec
( spec
) where
import Control.Exception (SomeException)
2020-06-10 11:42:00 +02:00
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
2020-09-11 08:03:49 +02:00
import Data.Aeson.Types (emptyObject)
import Data.Conduit
2020-06-10 11:42:00 +02:00
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL.AST (Document, Location(..), Name)
2020-06-10 11:42:00 +02:00
import Language.GraphQL.AST.Parser (document)
import Language.GraphQL.Error
import Language.GraphQL.Execute (execute)
import qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Type
import qualified Language.GraphQL.Type.Out as Out
import Test.Hspec (Spec, context, describe, it, shouldBe)
2020-06-10 11:42:00 +02:00
import Text.Megaparsec (parse)
2020-09-11 08:03:49 +02:00
import Text.RawString.QQ (r)
2020-06-10 11:42:00 +02:00
2020-09-28 07:06:15 +02:00
philosopherSchema :: Schema (Either SomeException)
philosopherSchema =
schemaWithTypes Nothing queryType Nothing subscriptionRoot extraTypes mempty
where
subscriptionRoot = Just subscriptionType
extraTypes =
[ Schema.ObjectType bookType
, Schema.ObjectType bookCollectionType
]
2020-06-10 11:42:00 +02:00
queryType :: Out.ObjectType (Either SomeException)
2020-06-10 11:42:00 +02:00
queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "philosopher"
$ ValueResolver philosopherField
$ pure $ Object mempty
2020-06-10 11:42:00 +02:00
where
philosopherField =
Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
2020-06-12 07:58:08 +02:00
musicType :: Out.ObjectType (Either SomeException)
musicType = Out.ObjectType "Music" Nothing []
$ HashMap.fromList resolvers
where
resolvers =
[ ("instrument", ValueResolver instrumentField instrumentResolver)
]
instrumentResolver = pure $ String "piano"
instrumentField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
poetryType :: Out.ObjectType (Either SomeException)
poetryType = Out.ObjectType "Poetry" Nothing []
$ HashMap.fromList resolvers
where
resolvers =
[ ("genre", ValueResolver genreField genreResolver)
]
genreResolver = pure $ String "Futurism"
genreField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
interestType :: Out.UnionType (Either SomeException)
interestType = Out.UnionType "Interest" Nothing [musicType, poetryType]
philosopherType :: Out.ObjectType (Either SomeException)
2020-06-12 07:58:08 +02:00
philosopherType = Out.ObjectType "Philosopher" Nothing []
$ HashMap.fromList resolvers
where
resolvers =
[ ("firstName", ValueResolver firstNameField firstNameResolver)
, ("lastName", ValueResolver lastNameField lastNameResolver)
, ("school", ValueResolver schoolField schoolResolver)
, ("interest", ValueResolver interestField interestResolver)
, ("majorWork", ValueResolver majorWorkField majorWorkResolver)
2020-06-12 07:58:08 +02:00
]
firstNameField =
Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
firstNameResolver = pure $ String "Friedrich"
lastNameField
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
lastNameResolver = pure $ String "Nietzsche"
schoolField
= Out.Field Nothing (Out.NonNullEnumType schoolType) HashMap.empty
schoolResolver = pure $ Enum "EXISTENTIALISM"
interestField
= Out.Field Nothing (Out.NonNullUnionType interestType) HashMap.empty
interestResolver = pure
$ Object
$ HashMap.fromList [("instrument", "piano")]
majorWorkField
= Out.Field Nothing (Out.NonNullInterfaceType workType) HashMap.empty
majorWorkResolver = pure
$ Object
$ HashMap.fromList
[ ("title", "Also sprach Zarathustra: Ein Buch für Alle und Keinen")
]
workType :: Out.InterfaceType (Either SomeException)
workType = Out.InterfaceType "Work" Nothing []
$ HashMap.fromList fields
where
fields = [("title", titleField)]
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
bookType :: Out.ObjectType (Either SomeException)
bookType = Out.ObjectType "Book" Nothing [workType]
$ HashMap.fromList resolvers
where
resolvers =
[ ("title", ValueResolver titleField titleResolver)
]
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
titleResolver = pure "Also sprach Zarathustra: Ein Buch für Alle und Keinen"
bookCollectionType :: Out.ObjectType (Either SomeException)
bookCollectionType = Out.ObjectType "Book" Nothing [workType]
$ HashMap.fromList resolvers
where
resolvers =
[ ("title", ValueResolver titleField titleResolver)
]
titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
titleResolver = pure "The Three Critiques"
2020-06-10 11:42:00 +02:00
subscriptionType :: Out.ObjectType (Either SomeException)
subscriptionType = Out.ObjectType "Subscription" Nothing []
$ HashMap.singleton "newQuote"
$ EventStreamResolver quoteField (pure $ Object mempty)
$ pure $ yield $ Object mempty
where
quoteField =
Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
quoteType :: Out.ObjectType (Either SomeException)
quoteType = Out.ObjectType "Quote" Nothing []
$ HashMap.singleton "quote"
$ ValueResolver quoteField
$ pure "Naturam expelles furca, tamen usque recurret."
where
quoteField =
Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
schoolType :: EnumType
schoolType = EnumType "School" Nothing $ HashMap.fromList
[ ("NOMINALISM", EnumValue Nothing)
, ("REALISM", EnumValue Nothing)
, ("IDEALISM", EnumValue Nothing)
]
2020-09-11 08:03:49 +02:00
type EitherStreamOrValue = Either
(ResponseEventStream (Either SomeException) Aeson.Value)
(Response Aeson.Value)
execute' :: Document -> Either SomeException EitherStreamOrValue
2020-09-28 07:06:15 +02:00
execute' =
execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)
2020-09-11 08:03:49 +02:00
2020-06-10 11:42:00 +02:00
spec :: Spec
spec =
2020-06-12 07:58:08 +02:00
describe "execute" $ do
2020-09-11 08:03:49 +02:00
it "rejects recursive fragments" $
let sourceQuery = [r|
{
...cyclicFragment
}
fragment cyclicFragment on Query {
...cyclicFragment
}
|]
expected = Response emptyObject mempty
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" sourceQuery
in actual `shouldBe` expected
context "Query" $ do
it "skips unknown fields" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.object
[ "firstName" .= ("Friedrich" :: String)
]
]
expected = Response data'' mempty
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName surname } }"
in actual `shouldBe` expected
it "merges selections" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.object
[ "firstName" .= ("Friedrich" :: String)
, "lastName" .= ("Nietzsche" :: String)
]
2020-06-12 07:58:08 +02:00
]
expected = Response data'' mempty
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
in actual `shouldBe` expected
it "errors on invalid output enum values" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.object
[ "school" .= Aeson.Null
]
]
executionErrors = pure $ Error
{ message = "Enum value completion failed."
, locations = [Location 1 17]
, path = []
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { school } }"
in actual `shouldBe` expected
it "gives location information for invalid interfaces" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.object
[ "interest" .= Aeson.Null
]
]
executionErrors = pure $ Error
{ message = "Union value completion failed."
, locations = [Location 1 17]
, path = []
}
expected = Response data'' executionErrors
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { interest } }"
in actual `shouldBe` expected
context "Subscription" $
it "subscribes" $
let data'' = Aeson.object
[ "newQuote" .= Aeson.object
[ "quote" .= ("Naturam expelles furca, tamen usque recurret." :: String)
]
2020-06-12 07:58:08 +02:00
]
expected = Response data'' mempty
Right (Left stream) = either (pure . parseError) execute'
$ parse document "" "subscription { newQuote { quote } }"
Right (Just actual) = runConduit $ stream .| await
in actual `shouldBe` expected