;;; 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/graphql+json))
              (scm->json-string
               (match (graphql-string->scm
                       (assoc-ref (graphql-request-alist request body)
                                  "query"))
                 (('document operations ...)
                  `(("data" . ,(map evaluator operations))))))))))