From 298bbc57e4096d770b03cf86c4d35f0bb0f49bbc Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Fri, 13 May 2016 21:41:46 +0000
Subject: [PATCH] SSH key deletion button

---
 README.md                 |  4 ++--
 config/routes             |  2 +-
 src/Vervis/Handler/Key.hs | 23 +++++++++++++++++++++--
 templates/key/key.hamlet  |  5 +++++
 4 files changed, 29 insertions(+), 5 deletions(-)

diff --git a/README.md b/README.md
index d7eaab3..65c658b 100644
--- a/README.md
+++ b/README.md
@@ -63,7 +63,7 @@ an overview of more-or-less what's left to do before the first release.
         [/] Web
         [ ] SSH
       [ ] Delete repo
-        [ ] Web
+        [/] Web
         [ ] SSH
       [/] Clone
         [/] HTTP
@@ -82,7 +82,7 @@ an overview of more-or-less what's left to do before the first release.
         [/] Web
         [ ] SSH
       [ ] Delete repo
-        [ ] Web
+        [/] Web
         [ ] SSH
       [ ] Clone
         [ ] HTTP
diff --git a/config/routes b/config/routes
index d5bc4b0..ec9bbfc 100644
--- a/config/routes
+++ b/config/routes
@@ -38,7 +38,7 @@
 
 /u/#Text/k                              KeysR             GET POST
 /u/#Text/k/!new                         KeyNewR           GET
-/u/#Text/k/#Text                        KeyR              GET
+/u/#Text/k/#Text                        KeyR              GET DELETE POST
 
 /u/#Text/r                              ReposR            GET POST
 /u/#Text/r/!new                         RepoNewR          GET
diff --git a/src/Vervis/Handler/Key.hs b/src/Vervis/Handler/Key.hs
index 3597384..432648b 100644
--- a/src/Vervis/Handler/Key.hs
+++ b/src/Vervis/Handler/Key.hs
@@ -18,6 +18,8 @@ module Vervis.Handler.Key
     , postKeysR
     , getKeyNewR
     , getKeyR
+    , deleteKeyR
+    , postKeyR
     )
 where
 
@@ -31,7 +33,7 @@ import Data.Text.Encoding.Error (lenientDecode)
 import Database.Persist
 import Text.Blaze.Html (Html, toHtml)
 import Yesod.Core (defaultLayout)
-import Yesod.Core.Handler (setMessage, redirectUltDest)
+import Yesod.Core.Handler
 import Yesod.Core.Widget (setTitle)
 import Yesod.Form.Functions (runFormPost)
 import Yesod.Form.Types (FormResult (..))
@@ -65,7 +67,7 @@ postKeysR user = do
         FormSuccess key -> do
             runDB $ insert_ key
             setMessage "Key added."
-            redirectUltDest HomeR
+            redirect $ KeysR user
         FormMissing -> do
             setMessage "Field(s) missing"
             defaultLayout $(widgetFile "key/key-new")
@@ -96,3 +98,20 @@ getKeyR user tag = do
         setTitle $ toHtml $
             intercalate " > " ["Vervis", "People", user, "Keys", tag]
         $(widgetFile "key/key")
+
+deleteKeyR :: Text -> Text -> Handler Html
+deleteKeyR user tag = do
+    runDB $ do
+        Entity sid _s <- getBy404 $ UniqueSharerIdent user
+        Entity pid _p <- getBy404 $ UniquePersonIdent sid
+        Entity kid _k <- getBy404 $ UniqueSshKey pid tag
+        delete kid
+    setMessage "Key deleted."
+    redirect $ KeysR user
+
+postKeyR :: Text -> Text -> Handler Html
+postKeyR user tag = do
+    mmethod <- lookupPostParam "_method"
+    case mmethod of
+        Just "DELETE" -> deleteKeyR user tag
+        _             -> notFound
diff --git a/templates/key/key.hamlet b/templates/key/key.hamlet
index 60868d6..97faaf3 100644
--- a/templates/key/key.hamlet
+++ b/templates/key/key.hamlet
@@ -12,6 +12,11 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
+<p>
+  <form method=POST action=@{KeyR user tag}>
+    <input type=hidden name=_method value=DELETE>
+    <input type=submit value="Delete this key">
+
 <table>
   <tr>
     <td>Algorithm