diff options
| -rw-r--r-- | src/guile/cantius.scm | 55 |
1 files changed, 46 insertions, 9 deletions
diff --git a/src/guile/cantius.scm b/src/guile/cantius.scm index bd67a24..e51a32e 100644 --- a/src/guile/cantius.scm +++ b/src/guile/cantius.scm @@ -34,6 +34,18 @@ (s35:define-condition-type &forbidden s35:&condition forbidden-condition?) +(export &bad-request) +(export bad-request-condition?) +(s35:define-condition-type &bad-request s35:&condition + bad-request-condition?) + +(export &condition-with-http-code) +(export condition-with-http-code?) + +(s35:define-condition-type &condition-with-http-code s35:&condition + condition-with-http-code? + (http-code condition-http-code)) + (define-public (normalize-path path) (define absolute? (eqv? #\/ (string-ref path 0))) @@ -111,20 +123,32 @@ (define-public %default-headers (make-parameter *%default-headers)) -(define-public %default-handler - (make-parameter (lambda (request body . _) +(define (make-handler-parameter http-code default-message) + (make-parameter (lambda* (request body #:key message) (values (build-response* #:headers *%default-headers - #:code 404) - "There's no page with this address :(")))) + #:code http-code) + (or message default-message))))) (define-public %not-found-handler - (make-parameter (%default-handler))) + (make-handler-parameter 404 "There's no page with this address :(")) (define-public %forbidden-handler - (make-parameter (lambda (request body . _) + (make-handler-parameter 403 "You. Shall not. Pass. (forbidden)")) + +(define-public %bad-request-handler + (make-handler-parameter 400 "Bad Request (you or your software seems to have messed sth up).")) + +(define-public %default-handler + (let ((not-found-handler (%not-found-handler))) + (make-parameter (lambda (request body . _) + (not-found-handler request body))))) + +(define-public %other-codes-handler + (make-parameter (lambda* (request body http-code #:key message) (values (build-response* #:headers *%default-headers - #:code 403) - "You. Shall not. Pass. (forbidden)")))) + #:code http-code) + (or message + (format #f "HTTP code ~d" http-code)))))) @@ -429,8 +453,21 @@ (start-stack 'cantius-request (guard (ex ((s35:condition-has-type? ex ¬-found) ((%not-found-handler) request body)) + ((s35:condition-has-type? ex &forbidden) - ((%forbidden-handler) request body))) + ((%forbidden-handler) request body)) + + ((s35:condition-has-type? ex &bad-request) + ((%bad-request-handler) request body)) + + ((s35:condition-has-type? + ex &condition-with-http-code) + ((%other-codes-handler) request body + (condition-http-code ex) + #:message + (and (s35:condition-has-type? ex s35:&message) + (s35:condition-message ex))))) + (apply (endpoint-handler endpoint) request body (or (and=> path-tail list) '())))))))))) |