Support PUT and PATCH requests

Resolves #1431
factor · Sep 16, 2018 · b52fc78 · b52fc78
1 parent 84d4807
commit b52fc78
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 4 deletions.
diff --git a/basis/furnace/actions/actions-docs.factor b/basis/furnace/actions/actions-docs.factor
@@ -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 "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." ;
 

diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor
@@ -19,7 +19,7 @@ IN: furnace.actions
 
 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
@@ -83,6 +83,26 @@ CONSTANT: revalidate-url-key "__u"
         ] [ 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* ;
 
@@ -93,9 +113,11 @@ CONSTANT: revalidate-url-key "__u"
 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 ;