{ { $slot "display" } { "A quotation called after the " { $slot "init" } " quotation in a GET request. This quotation must return an HTTP " { $link response } "." } }
{ { $slot "validate" } { "A quotation called at the beginning of a POST request to validate POST parameters." } }
{ { $slot "submit" } { "A quotation called after the " { $slot "validate" } " quotation in a POST request. This quotation must return an HTTP " { $link response } "." } }
+ { { $slot "replace" } { "A quotation called after the " { $slot "validate" } " quotation in a PUT request. This quotation must return an HTTP " { $link response } "." } }
+ { { $slot "update" } { "A quotation called after the " { $slot "validate" } " quotation in a PATCH request. This quotation must return an HTTP " { $link response } "." } }
}
"At least one of the " { $slot "display" } " and " { $slot "submit" } " slots must be set, otherwise the action will be useless." ;
SYMBOL: rest
-TUPLE: action rest init authorize display validate submit ;
+TUPLE: action rest init authorize display validate submit update replace ;
: new-action ( class -- action )
new [ ] >>init [ ] >>validate [ ] >>authorize ; inline
] [ drop <400> ] if
] with-exit-continuation ;
+: handle-put ( action -- response )
+ '[
+ _ dup submit>> [
+ [ validate>> call( -- ) ]
+ [ authorize>> call( -- ) ]
+ [ replace>> call( -- response ) ]
+ tri
+ ] [ drop <400> ] if
+ ] with-exit-continuation ;
+
+: handle-patch ( action -- response )
+ '[
+ _ dup submit>> [
+ [ validate>> call( -- ) ]
+ [ authorize>> call( -- ) ]
+ [ update>> call( -- response ) ]
+ tri
+ ] [ drop <400> ] if
+ ] with-exit-continuation ;
+
: handle-rest ( path action -- )
rest>> [ [ "/" join ] dip set-param ] [ drop ] if* ;
M: action call-responder* ( path action -- response )
[ init-action ] keep
request get method>> {
- { "GET" [ handle-get ] }
- { "HEAD" [ handle-get ] }
- { "POST" [ handle-post ] }
+ { "GET" [ handle-get ] }
+ { "HEAD" [ handle-get ] }
+ { "POST" [ handle-post ] }
+ { "PUT" [ handle-put ] }
+ { "PATCH" [ handle-patch ] }
[ 2drop <405> ]
} case ;