diff options
Diffstat (limited to 'haunt/api.scm')
| -rw-r--r-- | haunt/api.scm | 54 |
1 files changed, 39 insertions, 15 deletions
diff --git a/haunt/api.scm b/haunt/api.scm index b1db096..1b24bc0 100644 --- a/haunt/api.scm +++ b/haunt/api.scm @@ -20,8 +20,12 @@ (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) @@ -34,25 +38,45 @@ (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)) + (originating-ip (assoc-ref (request-headers request) 'x-forwarded-for)) (args (uri-query (request-uri request)))) - (log-append! 'info (format #f "~a ~a (~a) (~a)" method endpoint args originating-ip))) - ((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)) + (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." |