From e8befc41ee475c60ea47009194c6416d2c9bb0ec Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Mon, 2 May 2016 11:34:11 +0000
Subject: [PATCH] Multiplex ticket PUT and DELETE over POST

HTML forms support only GET and POST methods. One way to bypass that is
to send the form using JS. But I don't want that. Another is to send a
POST with a hidden form field which specifies the read method. This is
what 'postTicketR' does.
---
 config/routes                |  2 +-
 src/Vervis/Handler/Ticket.hs | 11 ++++++++++-
 templates/ticket/edit.hamlet |  3 ++-
 templates/ticket/one.hamlet  |  3 ++-
 4 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/config/routes b/config/routes
index 2694682..09baab8 100644
--- a/config/routes
+++ b/config/routes
@@ -55,7 +55,7 @@
 
 /u/#Text/p/#Text/t                      TicketsR          GET POST
 /u/#Text/p/#Text/t/!new                 TicketNewR        GET
-/u/#Text/p/#Text/t/#Int                 TicketR           GET PUT DELETE
+/u/#Text/p/#Text/t/#Int                 TicketR           GET PUT DELETE POST
 /u/#Text/p/#Text/t/#Int/edit            TicketEditR       GET
 
 -- /u/#Text/p/#Text/w           WikiR      GET
diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs
index ff99cc6..6853def 100644
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@@ -20,6 +20,7 @@ module Vervis.Handler.Ticket
     , getTicketR
     , putTicketR
     , deleteTicketR
+    , postTicketR
     , getTicketEditR
     )
 where
@@ -34,7 +35,7 @@ import Database.Persist
 import Text.Blaze.Html (Html, toHtml)
 import Yesod.Auth (requireAuthId)
 import Yesod.Core (defaultLayout)
-import Yesod.Core.Handler (setMessage, redirect)
+import Yesod.Core.Handler (setMessage, redirect, lookupPostParam, notFound)
 import Yesod.Core.Widget (setTitle)
 import Yesod.Form.Functions (runFormPost)
 import Yesod.Form.Types (FormResult (..))
@@ -146,6 +147,14 @@ deleteTicketR shar proj num =
     --delete tickets?
     error "Not implemented"
 
+postTicketR :: Text -> Text -> Int -> Handler Html
+postTicketR shar proj num = do
+    mmethod <- lookupPostParam "_method"
+    case mmethod of
+        Just "PUT"    -> putTicketR shar proj num
+        Just "DELETE" -> deleteTicketR shar proj num
+        _             -> notFound
+
 getTicketEditR :: Text -> Text -> Int -> Handler Html
 getTicketEditR shar proj num = do
     Entity _tid ticket <- runDB $ do
diff --git a/templates/ticket/edit.hamlet b/templates/ticket/edit.hamlet
index e1e33eb..0f5a8dc 100644
--- a/templates/ticket/edit.hamlet
+++ b/templates/ticket/edit.hamlet
@@ -16,6 +16,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 Enter the details and click "Submit" to update the ticket.
 
-<form method=PUT action=@{TicketR shar proj num} enctype=#{enctype}>
+<form method=POST action=@{TicketR shar proj num} enctype=#{enctype}>
+  <input type=hidden name=_method value=PUT>
   ^{widget}
   <input type=submit>
diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet
index 22e4bf8..241345d 100644
--- a/templates/ticket/one.hamlet
+++ b/templates/ticket/one.hamlet
@@ -17,7 +17,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <p>
   <a href=@{TicketEditR shar proj num}>Edit this ticket
 <p>
-  <form method=DELETE action=@{TicketR shar proj num}>
+  <form method=POST action=@{TicketR shar proj num}>
+    <input type=hidden name=_method value=DELETE>
     <input type=submit value="Delete this ticket">
 
 <p>