diff options
| -rw-r--r-- | kolam/http.scm | 64 |
1 files changed, 64 insertions, 0 deletions
diff --git a/kolam/http.scm b/kolam/http.scm new file mode 100644 index 0000000..b4d4beb --- /dev/null +++ b/kolam/http.scm @@ -0,0 +1,64 @@ +;;; kolam --- GraphQL implementation +;;; Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of kolam. +;;; +;;; kolam is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU Affero General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; kolam is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with kolam. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (kolam http) + #:use-module (rnrs io ports) + #:use-module (ice-9 match) + #:use-module (web request) + #:use-module (web uri) + #:use-module (json) + #:use-module (kolam graphql) + #:use-module (kolam parse) + #:export (graphql-handler)) + +(define transcoder + (make-transcoder (utf-8-codec) 'none 'raise)) + +(define (graphql-request-alist request body) + "Return an association list containing graphql request parameters +corresponding to REQUEST and request BODY." + (case (request-method request) + ((GET) + (map (lambda (arg) + (match (string-split arg #\=) + ((name value) + (cons (uri-decode name) + (uri-decode value))))) + (string-split (uri-query (request-uri request)) + #\&))) + ((POST) + (json-string->scm + (bytevector->string body transcoder))) + (else (error "Unsupported GraphQL request method" + (request-method request))))) + +(define (graphql-handler schema) + "Return a graphql handler for graphql SCHEMA. The handler accepts +two arguments---a REQUEST and a BODY---and returns two values---a +response and a response body. This function is suitable for use with +run-server from guile's (web server)." + (let ((evaluator (graphql-evaluator schema))) + (lambda (request body) + (values '((content-type application-json)) + (scm->json-string + (match (graphql-string->scm + (assoc-ref (graphql-request-alist request body) + "query")) + (('document operations ...) + `(("data" . ,(map evaluator operations)))))))))) |