M example/example1.lisp +1 -1
@@ 23,7 23,7 @@
("Query" . query-resolvers))))
(with-schema *example-schema*
- (let ((result (execute-request (query item) nil *variable-values* nil)))
+ (let ((result (execute (query item) nil *variable-values* nil)))
(format nil "~a~%" (cl-json:encode-json-to-string result)))))))
(defvar *server* (make-instance 'hunchentoot:easy-acceptor :port 3000))
M example/example2.lisp +1 -2
@@ 52,8 52,7 @@
(defun example2 (query)
(with-schema (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))
- (let* ((res (gql::execute-request
- (build-schema query) nil (make-hash-table :test #'equal) nil)))
+ (let* ((res (gql::execute (build-schema query) nil (make-hash-table :test #'equal) nil)))
(format t "~%~a" (cl-json:encode-json-to-string res)))))
(let ((*resolvers*
M src/execution.lisp +24 -12
@@ 106,11 106,13 @@
(let ((query-type (gethash "Query" *all-types*)))
(check-type query-type object-type-definition)
(with-slots (selection-set) query
- (let ((results (make-hash-table :test #'equal)))
- (setf (gethash "data" results)
- (execute-selection-set (selections selection-set) query-type initial-value variable-values))
- (setf (gethash "errors" results) *errors*)
- results))))
+ (setf (gethash "data" *result*)
+ (execute-selection-set (selections selection-set) query-type initial-value variable-values))
+ (when *errors*
+ ;; TODO: This might be too strict. It may be okay to leave some data here.
+ (setf (gethash "data" *result*) nil)
+ (setf (gethash "errors" *result*) *errors*))
+ *result*)))
(declaim (ftype (function (operation-definition hash-table t) hash-table) execute-mutation))
(defun execute-mutation (mutation variable-values initial-value)
@@ 118,11 120,13 @@
(let ((mutation-type (gethash "Mutation" *all-types*)))
(check-type mutation-type object-type-definition)
(with-slots (selection-set) mutation
- (let ((results (make-hash-table :test #'equal)))
- (setf (gethash "data" results)
- (execute-selection-set (selections selection-set) mutation-type initial-value variable-values))
- (setf (gethash "errors" results) *errors*)
- results))))
+ (setf (gethash "data" *result*)
+ (execute-selection-set (selections selection-set) mutation-type initial-value variable-values))
+ (when *errors*
+ ;; TODO: This might be too strict. It may be okay to leave some data here.
+ (setf (gethash "data" *result*) nil)
+ (setf (gethash "errors" *result*) *errors*))
+ *result*)))
(defun subscribe (subscription variable-values initial-value)
;; TODO: https://spec.graphql.org/draft/#Subscribe()
@@ 307,8 311,7 @@
(defun execute-request (document operation-name variable-values initial-value)
;; https://spec.graphql.org/draft/#sec-Executing-Requests
- (let* ((*errors* nil)
- (operation (get-operation document operation-name))
+ (let* ((operation (get-operation document operation-name))
(coerced-vars (coerce-vars operation variable-values)))
(string-case (operation-type operation)
("Query" (execute-query operation coerced-vars initial-value))
@@ 346,3 349,12 @@
:for selection :in (selections field-selection-set)
:do (push selection selection-set))
:finally (return (nreverse selection-set))))
+
+(defun execute (document operation-name variable-values initial-value)
+ (let ((*result* (make-hash-table :test #'equal))
+ (*errors* nil))
+ (validate document)
+ (if *errors*
+ (setf (gethash "errors" *result*) *errors*)
+ (execute-request document operation-name variable-values initial-value))
+ *result*))
M src/language.lisp +1 -2
@@ 34,8 34,7 @@
(every-definition-executable-p definitions)
(operation-name-unique-p definitions)
(single-anonymous-operation-definition-p definitions)
- (subscription-operation-valid-p)
- (values *data* *errors*)))
+ (subscription-operation-valid-p)))
:generator (defgenerator document ()
"~{~a~%~}" (gather-nodes (definitions node) indent-level)))
M src/package.lisp +1 -2
@@ 6,9 6,8 @@
#:gql
#:build-schema
#:generate
- #:validate
#:with-schema
- #:execute-request
+ #:execute
#:*resolvers*
#:resolve
#:bool
M src/specials.lisp +2 -2
@@ 24,8 24,8 @@ ensure we have initialized the schema.")
"Hash-table containing all types from schema *SCHEMA*.
Should be bound together with *schema* when needed.")
-(defvar *data* nil
- "Data to be returned to client after validation and execution.")
+(defvar *result* nil
+ "Hash table to contain the results of an execution.")
(defvar *errors* nil
"Errors to be returned to client after validation and execution.")
M src/utils.lisp +22 -7
@@ 66,18 66,33 @@ documents."
(setf (gethash (name name) node-table) node))))))
(defclass* errors
- nodes
- message)
+ message
+ locations
+ path
+ extensions)
+
+(defclass* error-location
+ line
+ column)
(defun make-error (message nodes)
- (let ((error-nodes (if (listp nodes) nodes (list nodes))))
- (push (make-instance 'errors
- :message message
- :nodes error-nodes)
+ (let ((node-list (if (listp nodes) nodes (list nodes))))
+ (push (make-instance
+ 'errors
+ :message message
+ :locations (mapcar
+ (lambda (node)
+ (let ((start-token (start-token (location node))))
+ (make-instance
+ 'error-location
+ :line (line start-token)
+ :column (column start-token))))
+ node-list)
+ :path nil
+ :extensions nil)
*errors*)))
(defun name-or-alias (field)
- ;; TODO: This one is probably no good
(with-slots (alias name) field
(if alias
(name alias)
M t/execution-tests.lisp +14 -14
@@ 45,11 45,11 @@
(setf (gethash "name" dog-resolver) (lambda (arg) (declare (ignorable arg))
"Bingo-bongo"))
(setf (gethash "owner" dog-resolver) (lambda (arg) (declare (ignorable arg)) t))
- (let* ((res (gql::execute-request (build-schema "query { dog { name } dog { owner { name } } }") nil (make-hash-table) nil))
+ (let* ((res (gql::execute (build-schema "query { dog { name } dog { owner { name } } }") nil (make-hash-table) nil))
(data (gethash "data" res))
(dog-res (gethash "dog" data)))
(ok (typep res 'hash-table))
- (ok (= (hash-table-count res) 2))
+ (ok (= (hash-table-count res) 1))
(ok (= (hash-table-count dog-res) 2))
(ok (gethash "name" dog-res))
(ok (gethash "owner" dog-res))))))
@@ 68,11 68,11 @@
(setf (gethash "name" dog-resolver) (lambda (arg) (declare (ignorable arg))
"Bingo-bongo"))
(setf (gethash "owner" dog-resolver) (lambda (arg) (declare (ignorable arg)) t))
- (let* ((res (gql::execute-request (build-schema "query { dog { name owner { name: nameAlias } } }") nil (make-hash-table) nil))
+ (let* ((res (gql::execute (build-schema "query { dog { name owner { name: nameAlias } } }") nil (make-hash-table) nil))
(data (gethash "data" res))
(dog-res (gethash "dog" data)))
(ok (typep res 'hash-table))
- (ok (= (hash-table-count res) 2))
+ (ok (= (hash-table-count res) 1))
(ok (= (hash-table-count dog-res) 2))
(ok (gethash "name" dog-res))
(ok (gethash "owner" dog-res))))))
@@ 91,7 91,7 @@
(lambda (arg args) (declare (ignorable arg))
(if (string= (gethash "dogCommand" args) "SIT")
'true 'false)))
- (let* ((res (gql::execute-request
+ (let* ((res (gql::execute
(build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }")
nil
variable-values
@@ 140,13 140,13 @@
(lambda (arg) (declare (ignorable arg))
(make-instance 'dog :name "Bingo-bongo")))
(setf (gethash "name" dog-resolver) (lambda (dog) (name dog)))
- (let* ((res (gql::execute-request
+ (let* ((res (gql::execute
(build-schema "query { dog { name } }") nil (make-hash-table) nil))
(data (gethash "data" res))
(dog (gethash "dog" data))
(name (gethash "name" dog)))
(ok (string= name "Bingo-bongo")))
- (let* ((res (gql::execute-request
+ (let* ((res (gql::execute
(build-schema "query { dog { name: bongo } }") nil (make-hash-table) nil))
(data (gethash "data" res))
(dog (gethash "dog" data))
@@ 177,7 177,7 @@
:test #'equal)
'true 'false))))
- (let* ((res (gql::execute-request
+ (let* ((res (gql::execute
(build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }")
nil
variable-values
@@ 187,7 187,7 @@
(command (gethash "doesKnowCommand" dog)))
(ok (string= command "true")))
(setf (gethash "sit" variable-values) "SITT")
- (let* ((res (gql::execute-request
+ (let* ((res (gql::execute
(build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }")
nil
variable-values
@@ 197,7 197,7 @@
(command (gethash "doesKnowCommand" dog)))
(ok (string= command "false")))
;; (setf (gethash "sit" variable-values) "SIT")
- ;; (let* ((res (gql::execute-request
+ ;; (let* ((res (gql::execute
;; (build-schema "query { dog { doesKnowCommand(dogCommand: \"SIT\") } }")
;; nil
;; variable-values
@@ 206,7 206,7 @@
;; (dog (gethash "dog" data))
;; (command (gethash "doesKnowCommand" dog)))
;; (ok (string= command "true")))
- (let* ((res (gql::execute-request
+ (let* ((res (gql::execute
(build-schema "query { dog { doesKnowCommand(dogCommand: \"LOL\") } }")
nil
variable-values
@@ 301,13 301,13 @@
(flet ((doggo-test (query)
(with-schema (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))
- (let* ((res (gql::execute-request (build-schema query) nil (make-hash-table :test #'equal) nil)))
+ (let* ((res (gql::execute (build-schema query) nil (make-hash-table :test #'equal) nil)))
(format nil "~a" (cl-json:encode-json-to-string res))))))
(ok (string=
(doggo-test "query { dog { name owner { name pets { name nickname } } } }")
- "{\"data\":{\"dog\":{\"name\":\"Bingo-Bongo\",\"owner\":{\"name\":\"Wingle Wangle\",\"pets\":[{\"name\":\"Bingo-Bongo\",\"nickname\":\"Hund!\"},{\"name\":\"Bango-Wango\",\"nickname\":\"Mjausig\"}]}}},\"errors\":null}"))
+ "{\"data\":{\"dog\":{\"name\":\"Bingo-Bongo\",\"owner\":{\"name\":\"Wingle Wangle\",\"pets\":[{\"name\":\"Bingo-Bongo\",\"nickname\":\"Hund!\"},{\"name\":\"Bango-Wango\",\"nickname\":\"Mjausig\"}]}}}}"))
(ok (string=
(doggo-test "query { dog: doggo { name: Bingo owner { name: Wingle pets: dogs { name nickname: thisIsFun } } } }")
- "{\"data\":{\"doggo\":{\"Bingo\":\"Bingo-Bongo\",\"owner\":{\"Wingle\":\"Wingle Wangle\",\"dogs\":[{\"name\":\"Bingo-Bongo\",\"thisIsFun\":\"Hund!\"},{\"name\":\"Bango-Wango\",\"thisIsFun\":\"Mjausig\"}]}}},\"errors\":null}"))))))
+ "{\"data\":{\"doggo\":{\"Bingo\":\"Bingo-Bongo\",\"owner\":{\"Wingle\":\"Wingle Wangle\",\"dogs\":[{\"name\":\"Bingo-Bongo\",\"thisIsFun\":\"Hund!\"},{\"name\":\"Bango-Wango\",\"thisIsFun\":\"Mjausig\"}]}}}}"))))))
M t/utils.lisp +5 -6
@@ 33,15 33,14 @@
(defun generator-test (input output)
(ok (string-equal (generate (build-schema input)) output)))
-(defun validator-test (input &key no-schema)
+(defun validator-test-helper (input &key no-schema)
(with-schema (if no-schema
(build-schema input)
(build-schema (asdf:system-relative-pathname
'gql-tests
#p"t/test-files/validation-schema.graphql")))
- (setf gql::*errors* nil)
- (setf gql::*data* nil)
- (validate (build-schema input))))
+ (let ((gql::*errors* nil))
+
+ (gql::validate (build-schema input))
+ (cl-json:encode-json-to-string gql::*errors*))))
-(defun validator-errors-p (input &key no-schema)
- (nth-value 1 (validator-test input :no-schema no-schema)))
M t/validation-tests.lisp +26 -177
@@ 3,181 3,30 @@
(deftest validation
(testing "Only allows ExecutableDefintition in a Document"
;; https://spec.graphql.org/draft/#sec-Executable-Definitions
- (ok
- (validator-errors-p
- "query getDogName {
- dog {
- name
- color
- }
-}
-
-extend type Dog {
- color: String
-}
-"))
- (ok
- (validator-errors-p
- "query getDogName {
- dog {
- name
- color
- }
-}
-
-mutation dogOperation {
- mutateDog {
- id
- }
-}
-
-extend type Dog {
- color: String
-}
-"))
- (ng
- (validator-test
- "query getDogName {
- dog {
- name
- color
- }
-}
-"))
- (ng
- (validator-test
- "query getDogName {
- dog {
- name
- color
- }
-}
-mutation dogOperation {
- mutateDog {
- id
- }
-}
-
-fragment friendFields on User {
- id
- name
- profilePic(size: 50)
-}"))
- (ng
- (validator-test ;; multiple queries with unique names are ok
- "query getDogName {
- dog {
- name
- }
-}
-
-query getOwnerName {
- dog {
- owner {
- name
- }
- }
-}
-"))
- (ok
- (validator-errors-p
- "query getName {
- dog {
- name
- }
-}
+ (ok (string= "[{\"message\":\"Each definition must be executable.\",\"locations\":[{\"line\":1,\"column\":40}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper
+ "query getDogName { dog { name color } } extend type Dog { color: String }")))
+ (ok (string= "[{\"message\":\"Each definition must be executable.\",\"locations\":[{\"line\":1,\"column\":83}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper
+ "query getDogName { dog { name color } } mutation dogOperation { mutateDog { id } } extend type Dog { color: String }")))
+ (ok (string= "null" (validator-test-helper "query getDogName { dog { name color } }")))
+ (ok (string= "null" (validator-test-helper "query getDogName { dog { name color } } mutation dogOperation { mutateDog { id } } fragment friendFields on User { id name profilePic(size: 50) }")))
+ (ok (string= "null" (validator-test-helper "query getDogName { dog { name } } query getOwnerName { dog { owner { name } } }")))
+ (ok (string= "[{\"message\":\"Each operation must have a unique name.\",\"locations\":[{\"line\":1,\"column\":0},{\"line\":1,\"column\":31}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper "query getName { dog { name } } query getName { dog { owner { name } } } ")))
+ (ok (string= "[{\"message\":\"Each operation must have a unique name.\",\"locations\":[{\"line\":1,\"column\":0},{\"line\":1,\"column\":36}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper "query dogOperation { dog { name } } mutation dogOperation { mutateDog { id } } ")))
+ (ok (string= "[{\"message\":\"An anonymous definition must be alone.\",\"locations\":[{\"line\":1,\"column\":0}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper "{ dog { name } } query getName { dog { owner { name } } }"))))
+ (testing "Subscription validation"
+ (ok (string= "null" (validator-test-helper "subscription sub { newMessage { body sender } } ")))
+ (ok (string= "[{\"message\":\"A subscription must have exactly one entry.\",\"locations\":[{\"line\":1,\"column\":0}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper "subscription sub { newMessage { body sender } disallowedSecondRootField }" :no-schema t)))
+ (ok (string= "[{\"message\":\"A subscription must have exactly one entry.\",\"locations\":[{\"line\":1,\"column\":0}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper "subscription sub { ...multipleSubscriptions } fragment multipleSubscriptions on Subscription { newMessage { body sender } disallowedSecondRootField }" :no-schema t)))
+ (ok (string= "[{\"message\":\"Root field must not begin with \\\"__\\\" which is reserved by GraphQL introspection.\",\"locations\":[{\"line\":1,\"column\":0}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper "subscription sub { __typename }" :no-schema t))))
+ (testing "Each fragment’s name must be unique within a document"
+ (ok (string= "[{\"message\":\"An anonymous definition must be alone.\",\"locations\":[{\"line\":1,\"column\":0}],\"path\":null,\"extensions\":null},{\"message\":\"Each operation must have a unique name.\",\"locations\":[{\"line\":1,\"column\":27},{\"line\":1,\"column\":64}],\"path\":null,\"extensions\":null}]"
+ (validator-test-helper "{ dog { ...fragmentOne } } fragment fragmentOne on Dog { name } fragment fragmentOne on Dog { owner { name } }")))))
-query getName {
- dog {
- owner {
- name
- }
- }
-}
-"))
- (ok
- (validator-errors-p
- "query dogOperation {
- dog {
- name
- }
-}
-
-mutation dogOperation {
- mutateDog {
- id
- }
-}
-"))
- (ok
- (validator-errors-p
- "{
- dog {
- name
- }
-}
-
-query getName {
- dog {
- owner {
- name
- }
- }
-}")))
- (testing "Subscription validation"
- (ng
- (validator-errors-p
- "subscription sub {
- newMessage {
- body
- sender
- }
-}
-"))
- (ok
- (validator-errors-p
- "subscription sub {
- newMessage {
- body
- sender
- }
- disallowedSecondRootField
-}" :no-schema t))
- (ok
- (validator-errors-p
- "subscription sub {
- ...multipleSubscriptions
-}
-
-fragment multipleSubscriptions on Subscription {
- newMessage {
- body
- sender
- }
- disallowedSecondRootField
-}" :no-schema t))
- (ok
- (validator-errors-p
- "subscription sub {
- __typename
-}" :no-schema t))
- )
- (testing "Each fragment’s name must be unique within a document"
- (ok
- (validator-errors-p
- "{
- dog {
- ...fragmentOne
- }
-}
-
-fragment fragmentOne on Dog {
- name
-}
-
-fragment fragmentOne on Dog {
- owner {
- name
- }
-}"))))
-
M wiki/examples/example1.md +1 -1
@@ 82,7 82,7 @@ The last few things is running a server
("Query" . query-resolvers))))
(with-schema *example-schema*
- (let ((result (execute-request (query item) nil *variable-values* nil)))
+ (let ((result (execute (query item) nil *variable-values* nil)))
(format nil "~a~%" (cl-json:encode-json-to-string result)))))))
```
M wiki/examples/example2.md +1 -1
@@ 93,7 93,7 @@ queries simple. Our function looks like
```lisp
(defun example2 (query)
(with-schema (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))
- (let* ((res (gql::execute-request
+ (let* ((res (gql::execute
(build-schema query) nil (make-hash-table :test #'equal) nil)))
(format t "~a" (cl-json:encode-json-to-string res)))))
```