From 9dfc29b7d23a4c8b23286531cce54ad148d737b8 Mon Sep 17 00:00:00 2001 From: "W. Kosior" Date: Thu, 18 Jul 2024 21:29:08 +0200 Subject: Improve the mechanism of conditions tied to HTTP error codes. Tere's now an extra `&condition-with-http-code' type that can be raised to trigger an appropriate HTTP response. This is meant to be used for all HTTP codes other than those few that have their own condition types. --- src/guile/cantius.scm | 55 ++++++++++++++++++++++++++++++++++++++++++--------- 1 file 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) '())))))))))) -- cgit v1.2.3