forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Ticket claim and unclaim routes with access checks

Browse source
This commit is contained in:
fr33domlover 2016-06-06 09:03:49 +00:00
parent 2881dd2e5f
commit a3af63d368
6 changed files with 91 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
config/routes
View file

@ -96,6 +96,8 @@
/s/#ShrIdent/p/#PrjIdent/t/#Int/edit TicketEditR GET
/s/#ShrIdent/p/#PrjIdent/t/#Int/close TicketCloseR POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/open TicketOpenR POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/claim TicketClaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/unclaim TicketUnclaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/d TicketDiscussionR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/d/#Int TicketMessageR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#Int/d/!reply TicketTopReplyR GET

29
src/Vervis/Form/Ticket.hs
View file

@ -57,35 +57,6 @@ newTicketAForm = NewTicket
newTicketForm :: Form NewTicket
newTicketForm = renderDivs newTicketAForm
{-
editTicketAForm :: Ticket -> PersonId -> AForm Handler Ticket
editTicketAForm ticket pid = fmap fixDone $ Ticket
<$> pure (ticketProject ticket)
<*> pure (ticketNumber ticket)
<*> pure (ticketCreated ticket)
<*> pure (ticketCreator ticket)
<*> areq textField "Title*" (Just $ ticketTitle ticket)
<*> ( maybe "" unTextarea <$>
aopt
textareaField
"Description (Markdown)"
(Just $ Just $ Textarea $ ticketDesc ticket)
)
<*> pure (ticketAssignee ticket)
<*> areq checkBoxField "Done*" (Just $ ticketDone ticket)
<*> now
<*> pure (ticketCloser ticket)
<*> pure (ticketDiscuss ticket)
where
fixDone result = case (ticketDone ticket, ticketDone result) of
(True, True) -> result { ticketClosed = ticketClosed ticket }
(False, False) -> result { ticketClosed = ticketClosed ticket }
(False, True) -> result { ticketCloser = pid }
(True, False) -> result { ticketClosed = defTime
, ticketCloser = ticketCreator ticket
}
-}
editTicketContentAForm :: Ticket -> AForm Handler Ticket
editTicketContentAForm ticket = Ticket
<$> pure (ticketProject ticket)

20
src/Vervis/Foundation.hs
View file

@ -35,6 +35,7 @@ import Text.Jasmine.Local (discardm)
import Vervis.Import.NoFoundation hiding (last)
import Vervis.Model.Group
import Vervis.Model.Ident
import Vervis.Model.Role
import Vervis.Widget (breadcrumbsW, revisionW)
-- | The foundation datatype for your application. This can be a good place to
@ -163,6 +164,8 @@ instance Yesod App where
(TicketEditR user _ _ , _ ) -> person user
(TicketCloseR user _ _ , _ ) -> person user
(TicketOpenR user _ _ , _ ) -> person user
(TicketClaimR s j _ , _ ) -> projOp ProjOpClaimTicket s j
(TicketUnclaimR s j _ , _ ) -> projOp ProjOpUnclaimTicket s j
(TicketDiscussionR _ _ _ , True) -> personAny
(TicketMessageR _ _ _ _ , True) -> personAny
(TicketTopReplyR _ _ _ , _ ) -> personAny
@ -202,6 +205,21 @@ instance Yesod App where
then Authorized
else Unauthorized "Not the expected group role"
projOp
:: ProjectOperation -> ShrIdent -> PrjIdent -> Handler AuthResult
projOp op shr prj = personAnd $ \ (Entity pid _p) -> do
ma <- runDB $ runMaybeT $ do
Entity sid _s <- MaybeT $ getBy $ UniqueSharer shr
Entity jid _j <- MaybeT $ getBy $ UniqueProject prj sid
Entity _cid c <- MaybeT $ getBy $ UniqueProjectCollab jid pid
let role = projectCollabRole c
MaybeT $ getBy $ UniqueProjectAccess role op
return $ case ma of
Nothing ->
Unauthorized
"You need a project role with that operation enabled"
Just _ -> Authorized
-- This function creates static content files in the static folder
-- and names them based on a hash of their content. This allows
-- expiration dates to be set far in the future without worry of
@ -381,6 +399,8 @@ instance YesodBreadcrumbs App where
)
TicketCloseR _shar _proj _num -> ("", Nothing)
TicketOpenR _shar _proj _num -> ("", Nothing)
TicketClaimR _shar _proj _num -> ("", Nothing)
TicketUnclaimR _shar _proj _num -> ("", Nothing)
TicketDiscussionR shar proj num -> ( "Discussion"
, Just $ TicketR shar proj num
)

55
src/Vervis/Handler/Ticket.hs
View file

@ -24,6 +24,8 @@ module Vervis.Handler.Ticket
, getTicketEditR
, postTicketCloseR
, postTicketOpenR
, postTicketClaimR
, postTicketUnclaimR
, getTicketDiscussionR
, postTicketDiscussionR
, getTicketMessageR
@ -36,6 +38,7 @@ where
import Prelude
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (logWarn)
import Data.Default.Class (def)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
@ -140,6 +143,7 @@ getTicketNewR shar proj = do
getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
getTicketR shar proj num = do
pid <- requireAuthId
(author, massignee, closer, ticket) <- runDB $ do
ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shar
@ -149,9 +153,10 @@ getTicketR shar proj num = do
author <- do
person <- get404 $ ticketCreator ticket
get404 $ personIdent person
massignee <- for (ticketAssignee ticket) $ \ pid -> do
person <- get404 pid
get404 $ personIdent person
massignee <- for (ticketAssignee ticket) $ \ apid -> do
person <- get404 apid
sharer <- get404 $ personIdent person
return (sharer, apid == pid)
closer <-
if ticketDone ticket
then do
@ -257,6 +262,50 @@ postTicketOpenR shr prj num = do
else "Ticket is already open."
redirect $ TicketR shr prj num
postTicketClaimR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postTicketClaimR shr prj num = do
pid <- requireAuthId
mmsg <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
getBy404 $ UniqueTicket p num
case (ticketDone ticket, ticketAssignee ticket) of
(True, _) ->
return $
Just "The ticket is closed. Can’t claim closed tickets."
(False, Just _) ->
return $
Just "The ticket is already assigned to someone."
(False, Nothing) -> do
update tid [TicketAssignee =. Just pid]
return Nothing
setMessage $ fromMaybe "The ticket is now assigned to you." mmsg
redirect $ TicketR shr prj num
postTicketUnclaimR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postTicketUnclaimR shr prj num = do
pid <- requireAuthId
mmsg <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
getBy404 $ UniqueTicket p num
case ((== pid) <$> ticketAssignee ticket, ticketDone ticket) of
(Nothing, _) ->
return $ Just "The ticket is already unassigned."
(Just False, _) ->
return $ Just "The ticket is assigned to someone else."
(Just True, True) -> do
$logWarn "Found a closed claimed ticket, this is invalid"
return $
Just "The ticket is closed. Can’t unclaim closed tickets."
(Just True, False) -> do
update tid [TicketAssignee =. Nothing]
return Nothing
setMessage $ fromMaybe "The ticket is now unassigned." mmsg
redirect $ TicketR shr prj num
selectDiscussionId :: ShrIdent -> PrjIdent -> Int -> AppDB DiscussionId
selectDiscussionId shar proj tnum = do
Entity sid _sharer <- getBy404 $ UniqueSharer shar

4
src/Vervis/Model/Role.hs
View file

@ -28,8 +28,8 @@ data RepoOperation = RepoOpPush deriving (Eq, Show, Read, Enum, Bounded)
derivePersistField "RepoOperation"
data ProjectOperation
= ProjOpAskToClaimTicket
| ProjOpClaimTicket
= ProjOpClaimTicket
| ProjOpUnclaimTicket
deriving (Eq, Show, Read, Enum, Bounded)
derivePersistField "ProjectOperation"

21
templates/ticket/one.hamlet
View file

@ -25,24 +25,33 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
$if not $ ticketDone ticket
<p>
$maybe assignee <- massignee
Assigned to ^{personLinkW assignee}
$maybe (assignee, me) <- massignee
$if me
Assigned to you.
<form method=POST action=@{TicketUnclaimR shar proj num}>
<input type=submit value="Unclaim this ticket">
$else
Assigned to ^{personLinkW assignee}.
$nothing
Not assigned
Not assigned.
<form method=POST action=@{TicketClaimR shar proj num}>
<input type=submit value="Claim this ticket">
<p>
Status:
Status: #
$if ticketDone ticket
Closed on #{showDate $ ticketClosed ticket} by
^{personLinkW closer}.
<form method=POST action=@{TicketOpenR shar proj num}>
<input type=submit value="Reopen this ticket.">
<input type=submit value="Reopen this ticket">
$else
Open.
<form method=POST action=@{TicketCloseR shar proj num}>
<input type=submit value="Close this ticket.">
<input type=submit value="Close this ticket">
<h2>#{ticketTitle ticket}