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 @@ $# . $maybe desc <- repoDesc repository

#{desc} +

+

+ + +

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 @@ $# . $maybe desc <- repoDesc repository

#{desc} +

+ + + +

Commits