diff --git a/config/routes b/config/routes
index 7760bc7..a96f90a 100644
--- a/config/routes
+++ b/config/routes
@@ -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
diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs
index 8b9809b..62abad8 100644
--- a/src/Vervis/Form/Ticket.hs
+++ b/src/Vervis/Form/Ticket.hs
@@ -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)
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index 5592829..fc815cf 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -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
)
diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs
index ad85d29..dd1f294 100644
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@@ -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
diff --git a/src/Vervis/Model/Role.hs b/src/Vervis/Model/Role.hs
index 21235ab..0c1da37 100644
--- a/src/Vervis/Model/Role.hs
+++ b/src/Vervis/Model/Role.hs
@@ -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"
diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet
index d682659..4a341c9 100644
--- a/templates/ticket/one.hamlet
+++ b/templates/ticket/one.hamlet
@@ -25,24 +25,33 @@ $# .
$if not $ ticketDone ticket
- $maybe assignee <- massignee
- Assigned to ^{personLinkW assignee}
+ $maybe (assignee, me) <- massignee
+ $if me
+ Assigned to you.
+
+