parent
84d480700c
commit
b52fc788bf
|
@ -99,6 +99,8 @@ ARTICLE: "furnace.actions.config" "Furnace action configuration"
|
||||||
{ { $slot "display" } { "A quotation called after the " { $slot "init" } " quotation in a GET request. This quotation must return an HTTP " { $link response } "." } }
|
{ { $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 "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 "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." ;
|
"At least one of the " { $slot "display" } " and " { $slot "submit" } " slots must be set, otherwise the action will be useless." ;
|
||||||
|
|
||||||
|
|
|
@ -19,7 +19,7 @@ IN: furnace.actions
|
||||||
|
|
||||||
SYMBOL: rest
|
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-action ( class -- action )
|
||||||
new [ ] >>init [ ] >>validate [ ] >>authorize ; inline
|
new [ ] >>init [ ] >>validate [ ] >>authorize ; inline
|
||||||
|
@ -83,6 +83,26 @@ CONSTANT: revalidate-url-key "__u"
|
||||||
] [ drop <400> ] if
|
] [ drop <400> ] if
|
||||||
] with-exit-continuation ;
|
] 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 -- )
|
: handle-rest ( path action -- )
|
||||||
rest>> [ [ "/" join ] dip set-param ] [ drop ] if* ;
|
rest>> [ [ "/" join ] dip set-param ] [ drop ] if* ;
|
||||||
|
|
||||||
|
@ -93,9 +113,11 @@ CONSTANT: revalidate-url-key "__u"
|
||||||
M: action call-responder* ( path action -- response )
|
M: action call-responder* ( path action -- response )
|
||||||
[ init-action ] keep
|
[ init-action ] keep
|
||||||
request get method>> {
|
request get method>> {
|
||||||
{ "GET" [ handle-get ] }
|
{ "GET" [ handle-get ] }
|
||||||
{ "HEAD" [ handle-get ] }
|
{ "HEAD" [ handle-get ] }
|
||||||
{ "POST" [ handle-post ] }
|
{ "POST" [ handle-post ] }
|
||||||
|
{ "PUT" [ handle-put ] }
|
||||||
|
{ "PATCH" [ handle-patch ] }
|
||||||
[ 2drop <405> ]
|
[ 2drop <405> ]
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue