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
$#
+