-
Notifications
You must be signed in to change notification settings - Fork 162
/
parser.clj
1245 lines (1050 loc) · 49.7 KB
/
parser.clj
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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
; Copyright (c) 2017-present Walmart, Inc.
;
; Licensed under the Apache License, Version 2.0 (the "License")
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
(ns com.walmartlabs.lacinia.parser
"Parsing of client querys using the ANTLR grammar."
(:require
[clojure.string :as str]
[com.walmartlabs.lacinia.internal-utils
:refer [cond-let update? q map-vals filter-vals
with-exception-context throw-exception to-message
keepv as-keyword *exception-context*]]
[com.walmartlabs.lacinia.schema :as schema]
[com.walmartlabs.lacinia.constants :as constants]
[clojure.spec.alpha :as s]
[com.walmartlabs.lacinia.resolve :as resolve]
[com.walmartlabs.lacinia.parser.query :as qp]
[flatland.ordered.map :refer [ordered-map]])
(:import
(clojure.lang ExceptionInfo)
(com.walmartlabs.lacinia.schema CompiledSchema)))
(defn ^:private first-match
[pred coll]
(->> coll
(filter pred)
first))
(defn ^:private assoc-seq?
"Associates a key into map only when the value is a non-empty seq."
[m k v]
(if (seq v)
(assoc m k v)
m))
(declare ^:private selection)
(defn ^:private contains-modifier?
[modifier-kind any-def]
(loop [{kind :kind
nested :type} (:type any-def)]
(cond
(= :root kind)
false
(= kind modifier-kind)
true
:else
(recur nested))))
(defn ^:private non-null-kind?
"Peeks at the kind of the provided def (field, argument, or variable) to see if it is :non-null"
[any-def]
(-> any-def :type :kind (= :non-null)))
;; At some point, this will move to the schema when we work out how to do extensible
;; directives. A directive effector is invoked during the prepare phase to modify
;; a node based on the directive arguments.
(def ^:private builtin-directives
(let [if-arg {:if {:type {:kind :non-null
:type {:kind :root
:type :Boolean}}}}]
{:skip {:args if-arg
:effector (fn [node arguments]
(cond-> node
(-> arguments :if true?) (assoc :disabled? true)))}
:include {:args if-arg
:effector (fn [node arguments]
(cond-> node
(-> arguments :if false?) (assoc :disabled? true)))}}))
(defn ^:private name-string-from
"Converts a Parser node into a string. The node looks like
this:
[:name
[:nameid \"foo\"]]
OR
[:name
[:operationType [:'query' \"query\"]]]"
[node]
(let [inner (second node)
inner-type (first inner)]
(if (= :nameid inner-type)
(second inner)
(-> inner second second))))
(defn ^:private name-from
"Converts a Parser node into a keyword. The node looks like
this:
[:name
[:nameid \"foo\"]]
OR
[:name
[:operationType [:'query' \"query\"]]]"
[node]
(keyword (name-string-from node)))
(declare ^:private xform-argument-map build-map-from-parsed-arguments)
(defn ^:private xform-argument-value
"Returns a tuple of type and string value. True scalar values will be passed,
as strings, to the scalar's :parse function to convert to the appropriate type
(in some cases, this is more flexible than what the GraphQL spec mandates).
Most values are returned with type :scalar.
Other types:
:enum is handled specially, as it is not a scalar.
:null is handled specially, as it potentially can apply to any other type, including
list types.
:array and :object are composite types.
:variable must be resolved later, once query variables for this particular
query execution is known."
[argument-value]
(let [{:keys [type value]} argument-value]
(case type
(:string :integer :float :boolean) [:scalar value]
:null [:null nil]
(:enum :variable) [type value]
:object [:object (build-map-from-parsed-arguments value)]
:array [:array (mapv xform-argument-value value)])))
(defn ^:private build-map-from-parsed-arguments
"Builds a map from the parsed arguments."
[parsed-arguments]
(->> parsed-arguments
(reduce (fn [m {:keys [arg-name arg-value]}]
;; TODO: Check for duplicate arg names
(assoc! m arg-name (xform-argument-value arg-value)))
(transient {}))
persistent!))
(declare ^:private extract-reportable-arguments)
(defn ^:private extract-reportable-argument-value
[[arg-type v]]
(case arg-type
:variable (symbol (str \$ (name v)))
:array (mapv extract-reportable-argument-value v)
:object (extract-reportable-arguments v)
v))
(defn ^:private extract-reportable-arguments
[arg-map]
(map-vals extract-reportable-argument-value arg-map))
(defn ^:private scalar?
[type]
(-> type :category #{:scalar :enum} boolean))
(defmulti ^:private is-dynamic?
"Given an argument tuple, returns true if the argument is dynamic
(references a variable)."
(fn [[type _]] type))
(defmethod is-dynamic? :default
[_]
false)
(defmethod is-dynamic? :variable
[_]
true)
;; For the composite types, have to see if any composed values are dynamic.
(defmethod is-dynamic? :array
[[_ array-values]]
(some is-dynamic? array-values))
(defmethod is-dynamic? :object
[[_ object-map]]
(some is-dynamic? (vals object-map)))
(defn ^:private split-arguments
"Given a map of arguments, determines which are literal and which are dynamic.
Returns a tuple of two maps. First map is simple arguments:
arguments whose value is entirely static. The second is dynamic arguments,
whose value comes from a query variable."
[arguments]
(when arguments
(loop [state nil
args arguments]
(if (seq args)
(let [[k v] (first args)
classification (if (is-dynamic? v)
:dynamic
:literal)]
(recur (assoc-in state [classification k] v)
(next args)))
[(:literal state) (:dynamic state)]))))
(defn ^:private collect-default-values
[field-map] ; also works with arguments
(let [defaults (->> field-map
(map-vals :default-value)
(filter-vals some?))]
(when-not (empty? defaults)
defaults)))
(defn ^:private use-nested-type
"Replaces the :type of the def with the nested type; this is used to strip off a
:list or :non-null type before working on the underlying :root type."
[any-def]
(update any-def :type :type))
(defn ^:private coerce-to-multiple-if-list-type
"Coerces single value to a list of size one if the value is not null
and type is a list. Otherwise returns unmodified argument tuple."
[argument-definition [arg-type arg-value :as arg-tuple]]
(if (and (contains-modifier? :list argument-definition)
(not (nil? arg-value))
(not (sequential? arg-value)))
[:array [[arg-type arg-value]]]
arg-tuple))
(defmulti ^:private process-literal-argument
"Validates a literal argument value to ensure it is compatible
with the declared type of the field argument. Returns the underlying
coorced value.
arg-value is a tuple of argument type (:scalar, :enum, :null, :array, or :object) and
the parsed value."
(fn [schema argument-definition [arg-type _]]
(if (contains-modifier? :list argument-definition)
;; list types allow a single value on input
:array
arg-type)))
(defmethod process-literal-argument :scalar
[schema argument-definition [_ arg-value]]
(let [type-name (schema/root-type-name argument-definition)
scalar-type (get schema type-name)]
(with-exception-context {:value arg-value
:type-name type-name}
;; TODO: Special case for the all-too-popular "passed a string for an enum"
(when-not (= :scalar (:category scalar-type))
(throw-exception (format "A scalar value was provided for type %s, which is not a scalar type."
(q type-name))
{:category (:category scalar-type)}))
(let [coerced (-> scalar-type :parse (s/conform arg-value))]
(cond
(= ::s/invalid coerced)
(throw-exception (format "Scalar value is not parsable as type %s."
(q type-name)))
(schema/is-coercion-failure? coerced)
(throw-exception (:message coerced)
(dissoc coerced :message))
:else
coerced)))))
(defmethod process-literal-argument :null
[schema argument-definition arg-value]
(when (non-null-kind? argument-definition)
(throw-exception "An explicit null value was provided for a non-nullable argument."))
nil)
(defmethod process-literal-argument :enum
[schema argument-definition [_ arg-value]]
;; First, make sure the category is an enum
(let [enum-type-name (schema/root-type-name argument-definition)
type-def (get schema enum-type-name)]
(with-exception-context {:value arg-value}
(when-not (= :enum (:category type-def))
(throw-exception "Enum value supplied for argument whose type is not an enum."
{:argument-type enum-type-name}))
(or (get (:values-set type-def) arg-value)
(throw-exception (format "Provided argument value %s is not member of enum type."
(q arg-value))
{:allowed-values (:values-set type-def)
:enum-type enum-type-name})))))
(defmethod process-literal-argument :object
[schema argument-definition [_ arg-value]]
(let [type-name (schema/root-type-name argument-definition)
schema-type (get schema type-name)]
(when-not (= :input-object (:category schema-type))
(throw-exception "Input object supplied for argument whose type is not an input object."
{:argument-type (:type-name schema-type)}))
;; An input object has fields, some of which are required, some of which
;; have default values.
(let [object-fields (:fields schema-type)
default-values (collect-default-values object-fields)
required-keys (keys (filter-vals non-null-kind? object-fields))
process-object-field (fn [m k v]
(if-let [field (get object-fields k)]
(assoc m k
(process-literal-argument schema field v))
(throw-exception (format "Input object contained unexpected key %s."
(q k))
{:schema-type type-name})))
object-value (reduce-kv process-object-field
nil
arg-value)
with-defaults (merge default-values object-value)]
(doseq [k required-keys]
(when (nil? (get with-defaults k))
(throw-exception (format "No value provided for non-nullable key %s of input object %s."
(q k)
(q type-name))
{:missing-key k
:required-keys (sort required-keys)
:schema-type type-name})))
with-defaults)))
(defmethod process-literal-argument :array
[schema argument-definition arg-tuple]
(let [kind (-> argument-definition :type :kind)
[_ arg-value :as arg-tuple*] (coerce-to-multiple-if-list-type argument-definition arg-tuple)]
(case kind
:non-null
(recur schema (use-nested-type argument-definition) arg-tuple*)
:root
(throw-exception "Provided argument value is an array, but the argument is not a list.")
:list
(let [fake-argument-def (use-nested-type argument-definition)]
(mapv #(process-literal-argument schema fake-argument-def %) arg-value)))))
(defn ^:private decapitalize
[s]
(str (-> s
(subs 0 1)
str/lower-case)
(subs s 1)))
(defn ^:private construct-literal-arguments
"Converts and validates all literal arguments from their parsed format into
values ready to be used at execution time. Returns a nil, or a map of arguments and
literal values."
[schema argument-defs arguments]
(let [default-values (collect-default-values argument-defs)]
(if (empty? arguments)
default-values
(let [process-arg (fn [arg-name arg-value]
(with-exception-context {:argument arg-name}
(let [arg-def (get argument-defs arg-name)]
(when-not arg-def
(throw-exception (format "Unknown argument %s."
(q arg-name))
{:defined-arguments (keys argument-defs)}))
(try
(process-literal-argument schema arg-def arg-value)
(catch Exception e
(throw-exception (format "For argument %s, %s"
(q arg-name)
(decapitalize (to-message e)))
nil
e))))))]
(let [static-args (reduce-kv (fn [m k v]
(assoc m k (process-arg k v)))
nil
arguments)
with-defaults (merge default-values
static-args)]
(when-not (empty? with-defaults)
with-defaults))))))
(defn ^:private compatible-types?
[var-type arg-type var-has-default?]
(let [v-kind (:kind var-type)
a-kind (:kind arg-type)
v-type (:type var-type)
a-type (:type arg-type)]
(cond
;; If the variable may not be null, but the argument is less precise,
;; then it's ok to continue; use the next type of the variable.
(and (= v-kind :non-null)
(not= a-kind :non-null))
(recur v-type arg-type var-has-default?)
;; The opposite: the argument is non-null but the variable might be null, BUT
;; there's a default, then strip off a layer of argument type and continue.
(and (= a-kind :non-null)
(not= v-kind :non-null)
var-has-default?)
(recur var-type a-type var-has-default?)
;; At this point we've stripped off non-null on the arg or var side. We should
;; be at a meeting point, either both :list or both :root.
(not= a-kind v-kind)
false
;; Then :list, strip that off to see if the element type of the list is compatible.
;; The default, if any, applied to the list, not the values inside the list.
;; TODO: This feels suspect, handling of list types is probably more complex than this.
(not= :root a-kind)
(recur v-type a-type false)
;; Because arguments and variables are always scalars, enums, or input-objects, the
;; more complicated checks for unions and interfaces are not necessary.
:else
(= v-type a-type))))
(defn ^:private type-compatible?
"Compares a variable definition against an argument definition to ensure they are
compatible types. This is similar to schema/is-compatible-type? but has some special rules
related to arguments."
[var-def arg-def]
(compatible-types? (:type var-def)
(:type arg-def)
(-> var-def :default-value some?)))
(defn ^:private build-type-summary
"Converts nested type maps into the format used in a GraphQL query."
[type-map]
(let [nested (:type type-map)]
(case (:kind type-map)
:list
(str "["
(build-type-summary nested)
"]")
:non-null
(str (build-type-summary nested) "!")
:root
(name nested))))
(defn ^:private summarize-type
[type-def]
(build-type-summary (:type type-def)))
(defmulti ^:private process-dynamic-argument
"Processes a dynamic argument (one whose value is at least partly defined
by a query variable) into a function that accepts the map of variable values,
and returns the extracted variable value."
(fn [schema argument-definition [arg-type _]]
arg-type))
(defn ^:private construct-literal-argument
[schema result argument-type arg-value]
(cond-let
:let [nested-type (:type argument-type)
kind (:kind argument-type)]
;; we can only hit this if we iterate over list members
(and (nil? result) (= :non-null kind))
(throw-exception (format "Variable %s contains null members but supplies the value for a list that can't have any null members."
(q arg-value))
{:variable-name arg-value})
(= :list kind)
(cond
(and (= :list (:kind nested-type))
(not (sequential? (first result))))
(throw-exception (format "Variable %s doesn't contain the correct number of (nested) lists."
(q arg-value))
{:variable-name arg-value})
;; variables of a list type allow for a single value input
(and (some? result)
(not (sequential? result)))
[:array (mapv #(construct-literal-argument schema % nested-type arg-value) [result])]
:else
[:array (mapv #(construct-literal-argument schema % nested-type arg-value) result)])
(nil? result)
[:null nil]
(map? nested-type)
(recur schema result nested-type arg-value)
:let [category (get-in schema [nested-type :category])]
(= category :scalar)
[:scalar result]
;; enums have to be handled carefully because they are likely strings in
;; the variable map.
(= category :enum)
[:enum (as-keyword result)]
(= category :input-object)
[:object (let [object-fields (get-in schema [nested-type :fields])]
(reduce (fn [acc k]
(let [v (get result k)
field-type (get object-fields k)]
(assoc acc k (construct-literal-argument schema v field-type arg-value))))
{}
(keys result)))]
:else
(throw (IllegalStateException. "Sanity check - no option in construct-literal-argument."))))
(defn ^:private substitute-variable
"Checks result against variable kind, iterates over nested types, and applies respective
actions, if necessary, e.g. parse for custom scalars."
[schema result argument-type arg-value]
(process-literal-argument schema {:type argument-type} (construct-literal-argument schema result argument-type arg-value)))
(defmethod process-dynamic-argument :variable
[schema argument-definition [_ arg-value]]
;; ::variables is stashed into schema by xform-query
(let [captured-context *exception-context*
variable-def (get-in schema [::variables arg-value])]
(when (nil? variable-def)
(throw-exception (format "Argument references undeclared variable %s."
(q arg-value))
{:unknown-variable arg-value
:declared-variables (-> schema ::variables keys sort)}))
(when-not (type-compatible? variable-def argument-definition)
(throw-exception "Variable and argument are not compatible types."
{:argument-type (summarize-type argument-definition)
:variable-type (summarize-type variable-def)}))
(let [non-nullable? (non-null-kind? argument-definition)
var-non-nullable? (non-null-kind? variable-def)]
(fn [variables]
(with-exception-context captured-context
(cond-let
:let [result (get variables arg-value)]
;; So, when a client provides variables, sometimes you get a string
;; when you expect a keyword for an enum. Can't help that, when the alue
;; comes from a variable, there's no mechanism until we reach right here to convert it
;; to a keyword.
(some? result)
{:value (substitute-variable schema result (:type argument-definition) arg-value)}
;; TODO: This is only triggered if a variable is referenced, omitting a non-nillable
;; variable should be an error, regardless.
var-non-nullable?
(throw-exception (format "No value was provided for variable %s, which is non-nullable."
(q arg-value))
{:variable-name arg-value})
;; variable has a default value that could be NULL
(contains? variable-def :default-value)
{:value (:default-value variable-def)}
;; argument has a default value that could be NULL
(contains? argument-definition :default-value)
{:value (:default-value argument-definition)}
;; variable value is set to NULL
(contains? variables arg-value)
{:value result}
non-nullable?
(throw-exception (format "Variable %s is null, but supplies the value for a non-nullable argument."
(q arg-value))
{:variable-name arg-value})
:else
nil))))))
(defn ^:private construct-dynamic-arguments-extractor
[schema argument-definitions arguments]
(when-not (empty? arguments)
(let [process-arg (fn [arg-name arg-value]
(let [arg-def (get argument-definitions arg-name)]
(with-exception-context {:argument arg-name}
(when-not arg-def
(throw-exception (format "Unknown argument %s."
(q arg-name))
{:field-arguments (keys argument-definitions)}))
(try
(process-dynamic-argument schema arg-def arg-value)
(catch Exception e
(throw-exception (format "For argument %s, %s"
(q arg-name)
(decapitalize (to-message e)))
nil
e))))))
dynamic-args (reduce-kv (fn [m k v]
(assoc m k (process-arg k v)))
nil
arguments)]
;; This is kind of a juxt buried in a map. Each value is a function that accepts
;; the variables and returns the actual value to use.
(fn [variables]
(->> (map-vals #(% variables) dynamic-args)
;; keep arguments that have a matching variable provided.
;; :value in value-map might be NULL but it's still a
;; provided value (e.g. may be used to indicate deletion)
(filter-vals some?)
(map-vals :value))))))
(defn ^:private disj*
[set ks]
(apply disj set ks))
(defn ^:private process-arguments
"Processes arguments to a field or a directive, doing some organizing and some
validation.
Returns a tuple of the literal argument values and a function to extract the dynamic argument
values from the map of query variables."
[schema argument-definitions arguments]
(let [[literal-args dynamic-args] (split-arguments arguments)
literal-argument-values (construct-literal-arguments schema argument-definitions literal-args)
dynamic-extractor (construct-dynamic-arguments-extractor schema argument-definitions dynamic-args)
missing-keys (-> argument-definitions
(as-> $ (filter-vals non-null-kind? $))
keys
set
(disj* (keys literal-args))
(disj* (keys dynamic-args))
sort)]
;; So, for literal arguments, we've already done a null check on non-nullable arguments.
;; For dynamic (variable based) arguments, there's a parse-time check that the
;; argument is mated to an appropriate variable, and a execution-time check that
;; the variable is non-null.
;; However, there might be omitted variables that are non-nullable.
(when (seq missing-keys)
(throw-exception "Not all non-nullable arguments have supplied values."
{:missing-arguments missing-keys}))
[literal-argument-values dynamic-extractor]))
(defn ^:private default-node-map
"Returns a map with the query path to the node and the location in the
document."
[selection query-path]
{:query-path query-path
:location (meta selection)})
(defn ^:private node-context
[node-map]
{:query-path (:query-path node-map)
:locations [(:location node-map)]})
(defn ^:private convert-parsed-directives
"Passed a seq of parsed directive nodes, returns a seq of executable directives."
[schema parsed-directives]
(let [f (fn [parsed-directive]
(let [{directive-name :directive-name} parsed-directive]
(with-exception-context {:directive directive-name}
(if-let [directive-def (get builtin-directives directive-name)]
(let [[literal-arguments dynamic-arguments-extractor]
(try
(process-arguments schema
(:args directive-def)
(-> parsed-directive :args build-map-from-parsed-arguments))
(catch ExceptionInfo e
(throw-exception (format "Exception applying arguments to directive %s: %s"
(q directive-name)
(to-message e))
nil
e)))]
(assoc parsed-directive
:effector (:effector directive-def)
:arguments literal-arguments
::arguments-extractor dynamic-arguments-extractor))
(throw-exception (format "Unknown directive %s."
(q directive-name)
{:unknown-directive directive-name
:available-directives (-> builtin-directives keys sort)}))))))]
(mapv f parsed-directives)))
(def ^:private typename-field-definition
"A psuedo field definition that exists to act as a placeholder when the
__typename metafield is encountered."
{:type {:kind :non-null
:type {:kind :root
:type :String}}
:field-name :__typename
:resolve (fn [context _ _]
(-> context
:com.walmartlabs.lacinia/container-type-name
resolve/resolve-as))
:selector schema/floor-selector})
(defn ^:private prepare-parsed-field
[parsed-field]
(let [{:keys [alias field-name selections directives args]} parsed-field
arguments (build-map-from-parsed-arguments args)]
(-> {:field field-name
:alias alias
:selections selections
:directives directives}
(assoc-seq? :arguments arguments)
(assoc-seq? :reportable-arguments (extract-reportable-arguments arguments)))))
(defn ^:private select-operation
"Given a collection of parsed operation definitions and an operation name (which
might be nil), retrieve the requested operation definition from the document."
[operations operation-name]
(cond-let
:let [operation-key (when-not (str/blank? operation-name)
(as-keyword operation-name))
operation-count (count operations)
single-op? (= 1 operation-count)
first-op (first operations)]
(and single-op?
operation-key
(not= operation-key (:name first-op)))
(throw-exception "Single operation did not provide a matching name."
{:op-name operation-name})
single-op?
first-op
:let [operation (first-match #(= operation-key (:name %)) operations)]
(nil? operation)
(throw-exception "Multiple operations provided but no matching name found."
{:op-count operation-count
:operation-name operation-name})
;; TODO: Check the spec, seems like if there are multiple operations, they
;; should all be named with unique names.
:else operation))
(def ^:private prepare-keys
"Seq of keys associated with prepare phase operations."
[::prepare-directives? ::prepare-dynamic-arguments? ::prepare-nested-selections? ::needs-prepare?])
(defn ^:private mark-node-for-prepare
"Marks up a node so that it will, during the prepare phase, have the
proper operations performed on it. A node may have directives,
a node may be a field with arguments, a node may be a field or inline fragment
with nested selections."
[node]
(let [directives? (-> node :directives some?)
dynamic-arguments? (-> node ::arguments-extractor some?)
selections-need-prepare? (->> node
:selections
(some ::needs-prepare?)
some?)]
(cond-> node
directives? (assoc ::prepare-directives? true)
dynamic-arguments? (assoc ::prepare-dynamic-arguments? true)
selections-need-prepare? (assoc ::prepare-nested-selections? true)
(or directives? dynamic-arguments? selections-need-prepare?)
(assoc ::needs-prepare? true))))
(defn ^:private compute-arguments
[node variables]
(let [{:keys [arguments ::arguments-extractor]} node]
(cond-> arguments
arguments-extractor (merge (arguments-extractor variables)))))
(defn ^:private apply-directives
"Computes final arguments for each directive, and passes the node through each
directive's effector."
[node variables]
(reduce (fn [node directive]
(let [effector (:effector directive)]
(effector node (compute-arguments directive variables))))
node
(:directives node)))
(defn ^:private apply-dynamic-arguments
"Computes final arguments for a field from its literal arguments and dynamic arguments."
[node variables]
(assoc node :arguments (compute-arguments node variables)))
(declare ^:private prepare-node)
(defn ^:private prepare-nested-selections
[node variables]
(let [f #(prepare-node % variables)]
(update node :selections
#(keepv f %))))
(defn ^:private prepare-node
[node variables]
;; Most nodes don't need anything and we're done
(if-not (::needs-prepare? node)
node
(let [{:keys [::prepare-directives?
::prepare-dynamic-arguments?
::prepare-nested-selections?]} node
node' (cond-> node
prepare-directives? (apply-directives variables))]
;; Directives work by modifying the node. Deleting the node entirely
;; would be nice, but that leaves errors about "must have a sub selection"
;; so we set the disabled flag instead.
(if (:disabled? node')
node'
;; No need to do work further down the tree if the node itself is
;; disabled
(cond-> node'
prepare-dynamic-arguments? (apply-dynamic-arguments variables)
prepare-nested-selections? (prepare-nested-selections variables))))))
(defn ^:private to-selection-key
"The selection key only applies to fields (not fragments) and
consists of the field name or alias, and the arguments."
[selection]
(case (:selection-type selection)
:field
(:alias selection)
;; TODO: This may be too simplified ... worried about loss of data when merging things together
;; at runtime.
(gensym "fragment-")))
(declare ^:private coalesce-selections)
(defn ^:private merge-selections
[first-selection second-selection]
(when-not (= (:reportable-arguments first-selection)
(:reportable-arguments second-selection))
(let [{:keys [type-name field-name]} (:field-definition first-selection)]
(throw (ex-info (format "Different selections of field %s of type %s have incompatible arguments. Use alias names if this is intentional."
(q field-name) (q type-name))
{:object-name type-name
:field-name field-name
:arguments (:reportable-arguments first-selection)
:incompatible-arguments (:reportable-arguments second-selection)}))))
(let [combined-selections (coalesce-selections (concat (:selections first-selection)
(:selections second-selection)))
prepare-values (select-keys second-selection prepare-keys)]
(-> first-selection
(assoc :selections combined-selections)
(cond->
(seq prepare-values) (-> (merge prepare-values)
(assoc ::needs-prepare? true))))))
(defn ^:private coalesce-selections
"It is possible to select the same field more than once, and then identify different
selections within that field. The results should merge together, and match the query
order as closely as possible. This is tricky, and recursive."
[selections]
(if (= 1 (count selections))
selections
(let [reducer (fn [m selection]
(let [selection-key (to-selection-key selection)]
(if-let [prev-selection (get m selection-key)]
(assoc m selection-key (merge-selections prev-selection selection))
(assoc m selection-key selection))))]
(->> selections
(reduce reducer (ordered-map))
vals))))
;
(defn ^:private normalize-selections
"Starting with a selection (a field or fragment) recursively normalize any nested selections selections,
and handle marking the node for any necessary prepare phase operations."
[schema m type query-path]
(let [sub-selections (:selections m)]
(mark-node-for-prepare
(if (seq sub-selections)
(assoc m :selections (->> sub-selections
(mapv #(selection schema % type query-path))
coalesce-selections))
m))))
(defn ^:private expand-fragment-type-to-concrete-types
"Expands a single type to a set of concrete types names. For unions, this is
just the union members (each a concrete type name).
For interfaces, this is the names of concrete classes that
implement the interface.
For a concrete type, this is simply the type's name as a single value set."
[condition-type]
(case (:category condition-type)
(:interface :union) (:members condition-type)
:object (hash-set (:type-name condition-type))
(throw-exception (format "Fragment cannot condition on non-composite type %s."
(-> condition-type :type-name q)))))
(defn ^:private finalize-fragment-def
[schema def]
(let [fragment-type (get schema (:type def))
concrete-types (expand-fragment-type-to-concrete-types fragment-type)]
(-> def
(dissoc :fragment-name)
(assoc :concrete-types concrete-types))))
(defn ^:private normalize-fragment-definitions
"Given a collection of fragment definitions, transform them into a map of the
form {:<definition-name> {...}}."
[schema fragment-definitions]
(let [f (fn [def]
(let [defaults {:location (meta def)}
{:keys [on-type fragment-name selections directives]} def
m (-> defaults
(assoc :fragment-name fragment-name
:type on-type
:selections selections)
(cond-> directives
(assoc :directives (convert-parsed-directives schema directives))))
path-elem (keyword (-> m :fragment-name name)
(name on-type))
fragment-type (get schema on-type)]
;; TODO: Verify fragment type exists
(normalize-selections schema
m
fragment-type
[path-elem])))]
(into {} (comp (map f)
(map (juxt :fragment-name
#(finalize-fragment-def schema %))))
fragment-definitions)))
(defmulti ^:private selection
"A recursive function that parses the parsed query tree structure into the
format used during execution; this involves tracking the current schema type
(initially, nil) and query path (which is used for error reporting)."
(fn [_schema parsed-selection _type _q-path]
(:type parsed-selection)))
(defmethod selection :field
[schema parsed-field type query-path]
(let [defaults (default-node-map parsed-field query-path)
context (node-context defaults)
result (with-exception-context context
(merge defaults (prepare-parsed-field parsed-field)))
{:keys [field alias arguments reportable-arguments directives]} result
is-typename-metafield? (= field :__typename)
field-definition (if is-typename-metafield?
typename-field-definition
(get-in type [:fields field]))
field-type (schema/root-type-name field-definition)
nested-type (get schema field-type)
query-path' (conj query-path field)
selection (with-exception-context (assoc context :field field)
(when (nil? nested-type)
(if (scalar? type)
(throw-exception "Path de-references through a scalar type.")
(let [type-name (:type-name type)]
(throw-exception (format "Cannot query field %s on type %s."
(q field)
(if type-name
(q type-name)
"UNKNOWN"))
{:type type-name}))))
(let [[literal-arguments dynamic-arguments-extractor]
(try
(process-arguments schema
(:args field-definition)
arguments)
(catch ExceptionInfo e
(throw-exception (format "Exception applying arguments to field %s: %s"
(q field)
(to-message e))
nil
e)))]
(assoc result
:selection-type :field
:directives (convert-parsed-directives schema directives)
:alias (or alias field)
:query-path query-path'
:leaf? (scalar? nested-type)
:concrete-type? (or is-typename-metafield?
(-> type :category #{:object :input-object} some?))
:reportable-arguments reportable-arguments
:arguments literal-arguments
::arguments-extractor dynamic-arguments-extractor
:field-definition field-definition)))]
(normalize-selections schema selection nested-type query-path')))
(defmethod selection :inline-fragment