aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kolam/http.scm64
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))))))))))