;;; Copyright © 2019 - 2022 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program 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
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.

(use-modules (ice-9 match)
             (jakob dynamic captcha)
             (jakob dynamic capabilities comment-form)
             (jakob dynamic capabilities comments)
             (jakob dynamic capabilities gallery)
             (jakob dynamic capabilities rsvp)
             (jakob dynamic errors)
             (jakob dynamic logging)
             (jakob dynamic rate-limiter)
             (json)
             (rnrs conditions)
             (rnrs exceptions)
             (srfi srfi-1)
             (web request)
             (web response)
             (web server)
             (web uri))

(define (not-found request)
  "Build a (somewhat) descriptive response for a non-existent resource."
  (values (build-response #:code 404)
          (string-append "Resource not found: "
                         (uri->string (request-uri request)))))

(define (format-error-response condition)
  "Format CONDITION, a &reportable-condition, as an HTTP response"
  (values (build-response #:code (reportable-condition-code condition))
          (scm->json-string
           `((success . #f)
             (error . ,(reportable-condition-message condition))))))

(define-syntax values->list
  (syntax-rules ()
    ((values-list exp)
     (call-with-values (lambda () exp) list))))

(define (handle-api-request request body endpoint)
  "Route handler for the API server."
  (let ((method (request-method request))
        (originating-ip (assoc-ref (request-headers request) 'x-forwarded-for))
        (args (uri-query (request-uri request))))
    (log-append! 'info (if args
                           (format #f "~a ~a (~a) (~a)" method endpoint args originating-ip)
                           (format #f "~a ~a (~a)" method endpoint originating-ip))))
  ;; Somewhat painful wrap/unwrap of values because there isn't support for
  ;; returning multiple values from a `guard' clause.
  (apply values
    (guard (ex ((reportable-condition? ex)
                (values->list (format-error-response ex))))
      (values->list
       ((rate-limit-wrap
         (match (cons (request-method request) endpoint)
           (('GET "comment-form" _) get-comment-form)
           ('(GET "challenge" "proof-of-work") make-pow-challenge!)
           ('(GET "challenge" "captcha") make-captcha-challenge!)
           ;; ('(GET "comments") get-comments)
           (('POST "comment") put-comment)
           (('GET "gallery") get-gallery)
           (('GET "gallery" "image") get-image)
           (('GET "rsvp" "event-info") get-event-info)
           (('POST "rsvp") post-event-rsvp)
           (_ (lambda (. args) (not-found request)))))
        request body)))))

(define (main-request-handler request body)
  "Server entry-point; parse `request' and defer to routing system."
  (define (wrap-response response)
    ;; This is either a response, or an alist of headers. The latter case is
    ;; simple to handle, but the former requires us to do a (rather unweildy)
    ;; copy of the response to inject our headers.
    (if (response? response)
        (build-response
         #:version           (response-version       response)
         #:code              (response-code          response)
         #:reason-phrase     (response-reason-phrase response)
         #:headers           (cons '(Access-Control-Allow-Origin . "*")
                                    (response-headers response))
         #:port              (response-port          response)
         #:validate-headers? #t)
        (cons '(Access-Control-Allow-Origin . "*") response)))
  (let* ((path-encoded (uri-path (request-uri request)))
         (path (split-and-decode-uri-path path-encoded)))
    (define-values (response resp-body)
      (if (string= "api" (first path))
          (handle-api-request request body (drop path 1))
          (not-found request)))
    (values (wrap-response response) resp-body)))

;; (run-server main-request-handler)
(run-server main-request-handler 'http '(#:port 8081))