From b52fc788bf416dfb50ed9c1d42ab6b2be10681f9 Mon Sep 17 00:00:00 2001
From: Benjamin Pollack <benjamin@bitquabit.com>
Date: Sat, 15 Sep 2018 15:39:51 -0400
Subject: [PATCH] Support PUT and PATCH requests

Resolves #1431
---
 basis/furnace/actions/actions-docs.factor |  2 ++
 basis/furnace/actions/actions.factor      | 30 ++++++++++++++++++++---
 2 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/basis/furnace/actions/actions-docs.factor b/basis/furnace/actions/actions-docs.factor
index 88bacd2c04..af5cac082a 100644
--- 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
index 4d3a179942..cdf088ee53 100644
--- 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 ;
 
-- 
2.34.1