From 4d16203e5d9b692abafb4b4a323b45416137098b Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Fri, 13 May 2016 19:23:56 +0000
Subject: [PATCH] Repo deletion button

---
 config/routes                      |  2 +-
 src/Vervis/Foundation.hs           |  2 ++
 src/Vervis/Handler/Repo.hs         | 35 +++++++++++++++++++++++++++---
 templates/repo/source-darcs.hamlet |  5 +++++
 templates/repo/source-git.hamlet   |  5 +++++
 5 files changed, 45 insertions(+), 4 deletions(-)

diff --git a/config/routes b/config/routes
index 75d41ec..d5bc4b0 100644
--- a/config/routes
+++ b/config/routes
@@ -42,7 +42,7 @@
 
 /u/#Text/r                              ReposR            GET POST
 /u/#Text/r/!new                         RepoNewR          GET
-/u/#Text/r/#Text                        RepoR             GET
+/u/#Text/r/#Text                        RepoR             GET DELETE POST
 /u/#Text/r/#Text/s/+Texts               RepoSourceR       GET
 /u/#Text/r/#Text/c                      RepoHeadChangesR  GET
 /u/#Text/r/#Text/c/#Text                RepoChangesR      GET
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index 2596b2f..0b3d6f9 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -125,6 +125,8 @@ instance Yesod App where
         loggedInAs user "You can’t watch keys of other users"
     isAuthorized (KeyNewR user) _ =
         loggedInAs user "You can’t add keys for other users"
+    isAuthorized (RepoR shar _) True =
+        loggedInAs shar "You can’t modify repos for other users"
     isAuthorized (TicketNewR _ _) _ = loggedIn
     isAuthorized (TicketR user _ _) True =
         loggedInAs user "Only project members can modify this ticket"
diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs
index 21c6959..fea37b6 100644
--- a/src/Vervis/Handler/Repo.hs
+++ b/src/Vervis/Handler/Repo.hs
@@ -18,6 +18,8 @@ module Vervis.Handler.Repo
     , postReposR
     , getRepoNewR
     , getRepoR
+    , deleteRepoR
+    , postRepoR
     , getRepoSourceR
     , getRepoHeadChangesR
     , getRepoChangesR
@@ -34,7 +36,7 @@ where
 -- [x] write the git and mkdir parts that actually create the repo
 -- [x] make repo view that shows a table of commits
 
-import ClassyPrelude.Conduit       hiding (last, unpack)
+import ClassyPrelude.Conduit       hiding (last, unpack, delete)
 import Yesod                       hiding (Header, parseTime, (==.))
 import Yesod.Auth
 
@@ -54,9 +56,10 @@ import Data.List (inits)
 import Data.Text (unpack)
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
-import Database.Esqueleto
+import Database.Esqueleto hiding (delete, (%))
 import Data.Hourglass (timeConvert)
-import System.Directory (createDirectoryIfMissing)
+import Formatting (sformat, stext, (%))
+import System.Directory
 import System.Hourglass (dateCurrent)
 
 import qualified Data.DList as D
@@ -149,6 +152,32 @@ getRepoR shar repo = do
             getGitRepoSource
                 repository shar repo (repoMainBranch repository) []
 
+deleteRepoR :: Text -> Text -> Handler Html
+deleteRepoR shar repo = do
+    runDB $ do
+        Entity sid _s <- getBy404 $ UniqueSharerIdent shar
+        Entity rid _r <- getBy404 $ UniqueRepo repo sid
+        delete rid
+    path <- askRepoDir shar repo
+    exists <- liftIO $ doesDirectoryExist path
+    if exists
+        then liftIO $ removeDirectoryRecursive path
+        else
+            $logWarn $ sformat
+                ( "Deleted repo " % stext % "/" % stext
+                % " from DB but repo dir doesn't exist"
+                )
+                shar repo
+    setMessage "Repo deleted."
+    redirect HomeR
+
+postRepoR :: Text -> Text -> Handler Html
+postRepoR shar repo = do
+    mmethod <- lookupPostParam "_method"
+    case mmethod of
+        Just "DELETE" -> deleteRepoR shar repo
+        _             -> notFound
+
 getRepoSourceR :: Text -> Text -> [Text] -> Handler Html
 getRepoSourceR shar repo refdir = do
     repository <- runDB $ selectRepo shar repo
diff --git a/templates/repo/source-darcs.hamlet b/templates/repo/source-darcs.hamlet
index a16ba36..0598998 100644
--- a/templates/repo/source-darcs.hamlet
+++ b/templates/repo/source-darcs.hamlet
@@ -15,6 +15,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 $maybe desc <- repoDesc repository
   <p>#{desc}
 
+<p>
+  <form method=POST action=@{RepoR user repo}>
+    <input type=hidden name=_method value=DELETE>
+    <input type=submit value="Delete this repo">
+
 <p>
   <a href=@{RepoHeadChangesR user repo}>Changes
 
diff --git a/templates/repo/source-git.hamlet b/templates/repo/source-git.hamlet
index 7841bc2..3261452 100644
--- a/templates/repo/source-git.hamlet
+++ b/templates/repo/source-git.hamlet
@@ -15,6 +15,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 $maybe desc <- repoDesc repository
   <p>#{desc}
 
+<p>
+  <form method=POST action=@{RepoR user repo}>
+    <input type=hidden name=_method value=DELETE>
+    <input type=submit value="Delete this repo">
+
 <p>
   <a href=@{RepoHeadChangesR user repo}>Commits