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 @@ $#
#{desc} +
+