1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
{- 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/. -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.ExecuteSpec
( spec
) where
import Control.Exception (SomeException)
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (emptyObject)
import Data.Conduit
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL.AST (Document, Location(..), Name)
import Language.GraphQL.AST.Parser (document)
import Language.GraphQL.Error
import Language.GraphQL.Execute
import Language.GraphQL.Type as Type
import Language.GraphQL.Type.Out as Out
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.Megaparsec (parse)
import Text.RawString.QQ (r)
philosopherSchema :: Schema (Either SomeException)
philosopherSchema = schema queryType Nothing (Just subscriptionType) mempty
queryType :: Out.ObjectType (Either SomeException)
queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "philosopher"
$ ValueResolver philosopherField
$ pure $ Type.Object mempty
where
philosopherField =
Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
musicType :: Out.ObjectType (Either SomeException)
musicType = Out.ObjectType "Music" Nothing []
$ HashMap.fromList resolvers
where
resolvers =
[ ("instrument", ValueResolver instrumentField instrumentResolver)
]
instrumentResolver = pure $ Type.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 $ Type.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)
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)
]
firstNameField =
Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
firstNameResolver = pure $ Type.String "Friedrich"
lastNameField
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
lastNameResolver = pure $ Type.String "Nietzsche"
schoolField
= Out.Field Nothing (Out.NonNullEnumType schoolType) HashMap.empty
schoolResolver = pure $ Type.Enum "EXISTENTIALISM"
interestField
= Out.Field Nothing (Out.NonNullUnionType interestType) HashMap.empty
interestResolver = pure
$ Type.Object
$ HashMap.fromList [("instrument", "piano")]
subscriptionType :: Out.ObjectType (Either SomeException)
subscriptionType = Out.ObjectType "Subscription" Nothing []
$ HashMap.singleton "newQuote"
$ EventStreamResolver quoteField (pure $ Type.Object mempty)
$ pure $ yield $ Type.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)
]
type EitherStreamOrValue = Either
(ResponseEventStream (Either SomeException) Aeson.Value)
(Response Aeson.Value)
execute' :: Document -> Either SomeException EitherStreamOrValue
execute' =
execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)
spec :: Spec
spec =
describe "execute" $ do
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)
]
]
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)
]
]
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
|
