diff options
| -rw-r--r-- | src/endpoint.lisp | 12 | ||||
| -rw-r--r-- | src/package.lisp | 1 | ||||
| -rw-r--r-- | src/protocol.lisp | 25 |
3 files changed, 36 insertions, 2 deletions
diff --git a/src/endpoint.lisp b/src/endpoint.lisp index 00f681f..4ec68b6 100644 --- a/src/endpoint.lisp +++ b/src/endpoint.lisp @@ -356,6 +356,12 @@ the ;." :note "Error during the parsing of the body."))))))) + +(defun apply-slot-value-mappers (class initargs) + (loop :for (arg value) :on initargs :by #'cddr + :collect arg + :collect (slot-value-mapper class arg value))) + (defun instantiate-endpoint (class args) "This attempts to instantiate CLASS, filling slots found in ARGS by searching for their values in the hunchentoot:*request*. @@ -371,8 +377,10 @@ the ;." (body-args (extract-initargs args (collect-body class)))) (apply #'make-instance class - (reduce #'merge-plists - (list extracted-args params-args body-args))))) + (apply-slot-value-mappers + class + (reduce #'merge-plists + (list extracted-args params-args body-args)))))) (defun build-handler (class) "Create a hunchentoot dispatch function that instantiates and handles diff --git a/src/package.lisp b/src/package.lisp index 1563c07..094295b 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -14,6 +14,7 @@ (:export ;; HANDLER PROTOCOL #:check-request-compliance + #:slot-value-mapper #:authenticate #:authorize #:handle diff --git a/src/protocol.lisp b/src/protocol.lisp index 74019b1..6951077 100644 --- a/src/protocol.lisp +++ b/src/protocol.lisp @@ -112,6 +112,31 @@ on the size of request bodies.") (check-request-compliance (find-class epclass))) (:method ((epclass t)))) +(defgeneric slot-value-mapper (endpoint-class initarg slot-value) + (:documentation "Values arrive from clients in all manner of ways: in a JSON body, in +query arguments, as form body posts. Weekend allows users to register +body parsers, which transform post bodies according to the request's +mimetype. However, sometimes this isn't good enough. + +A value may require additional alteration before it fills an endpoint +slot. + +SLOT-VALUE-MAPPER is specialized on endpoints, initarg names, and slot +value types to parse or transform values to be what they out to be for +a slot's declared type. + +ENDPOINT-CLASS values MUST BE AN ENDPOINT CLASS. +INITARG values MUST BE A KEYWORD.") + + (:method :around (endpoint (initarg t) value) + (assert (keywordp initarg) (initarg) "Initarg is not a keyword ~a" + initarg) + (call-next-method)) + + (:method (endpoint initarg value) + value)) + + (defgeneric authenticate (endpoint) (:documentation "Returns a boolean. Any protected endpoint should implement this. Called before handling, should be used to supply |