Ticket un/assign (like un/claim but for other people)

config/routes

@@ -98,6 +98,8 @@
 /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/assign       TicketAssignR     GET POST
+/s/#ShrIdent/p/#PrjIdent/t/#Int/unassign     TicketUnassignR   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

src/Vervis/Field/Ticket.hs

@@ -0,0 +1,46 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Vervis.Field.Ticket
+    ( selectAssigneeFromProject
+    )
+where
+
+import Prelude
+
+import Control.Arrow ((***))
+import Database.Esqueleto
+import Yesod.Form.Fields (selectField, optionsPairs)
+import Yesod.Form.Types (Field)
+import Yesod.Persist.Core (runDB)
+
+import Vervis.Foundation (Handler)
+import Vervis.Model
+import Vervis.Model.Ident (shr2text)
+
+-- | Select an assignee for a ticket, from the list of collaborators of
+-- the project it belongs to. It can be any collaborator of the project, except
+-- for the person doing the assignment.
+selectAssigneeFromProject :: PersonId -> ProjectId -> Field Handler PersonId
+selectAssigneeFromProject pid jid = selectField $ do
+    l <- runDB $ select $ from $
+        \ (pcollab `InnerJoin` person `InnerJoin` sharer) -> do
+            on $ person ^. PersonIdent           ==. sharer ^. SharerId
+            on $ pcollab ^. ProjectCollabPerson  ==. person ^. PersonId
+            where_ $
+                pcollab ^. ProjectCollabProject ==. val jid &&.
+                person ^. PersonId              !=. val pid
+            return (sharer ^. SharerIdent, person ^. PersonId)
+    optionsPairs $ map (shr2text . unValue *** unValue) l

src/Vervis/Form/Ticket.hs

@@ -17,6 +17,7 @@ module Vervis.Form.Ticket
     ( NewTicket (..)
     , newTicketForm
     , editTicketContentForm
+    , assignTicketForm
     , ticketFilterForm
     )
 where
@@ -30,6 +31,7 @@ import Data.Time.Calendar (Day (..))
 import Data.Time.Clock (getCurrentTime, UTCTime (..))
 import Yesod.Form
 
+import Vervis.Field.Ticket
 import Vervis.Foundation (Form, Handler)
 import Vervis.Model
 import Vervis.TicketFilter (TicketFilter (..))
@@ -79,6 +81,13 @@ editTicketContentAForm ticket = Ticket
 editTicketContentForm :: Ticket -> Form Ticket
 editTicketContentForm t = renderDivs $ editTicketContentAForm t
 
+assignTicketAForm :: PersonId -> ProjectId -> AForm Handler PersonId
+assignTicketAForm pid jid =
+    areq (selectAssigneeFromProject pid jid) "Assignee*" Nothing
+
+assignTicketForm :: PersonId -> ProjectId -> Form PersonId
+assignTicketForm pid jid = renderDivs $ assignTicketAForm pid jid
+
 ticketFilterAForm :: AForm Handler TicketFilter
 ticketFilterAForm = TicketFilter
     <$> areq (selectFieldList status) "Status*" (Just Nothing)

src/Vervis/Foundation.hs

@@ -166,12 +166,17 @@ instance Yesod App where
         (TicketOpenR user _ _      , _   ) -> person user
         (TicketClaimR s j _        , _   ) -> projOp ProjOpClaimTicket s j
         (TicketUnclaimR s j _      , _   ) -> projOp ProjOpUnclaimTicket s j
+        (TicketAssignR s j _       , _   ) -> projOp ProjOpAssignTicket s j
+        (TicketUnassignR s j _     , _   ) -> projOp ProjOpUnassignTicket s j
         (TicketDiscussionR _ _ _   , True) -> personAny
         (TicketMessageR _ _ _ _    , True) -> personAny
         (TicketTopReplyR _ _ _     , _   ) -> personAny
         (TicketReplyR _ _ _ _      , _   ) -> personAny
         _                                  -> return Authorized
         where
+        nobody :: Handler AuthResult
+        nobody = return $ Unauthorized "This operation is currently disabled"
+
         personAnd
             :: (Entity Person -> Handler AuthResult) -> Handler AuthResult
         personAnd f = do
@@ -439,6 +444,10 @@ instance YesodBreadcrumbs App where
         TicketOpenR _shar _proj _num     -> ("", Nothing)
         TicketClaimR _shar _proj _num    -> ("", Nothing)
         TicketUnclaimR _shar _proj _num  -> ("", Nothing)
+        TicketAssignR shr prj num        -> ( "Assign"
+                                            , Just $ TicketR shr prj num
+                                            )
+        TicketUnassignR _shr _prj _num   -> ("", Nothing)
         TicketDiscussionR shar proj num  -> ( "Discussion"
                                             , Just $ TicketR shar proj num
                                             )

src/Vervis/Handler/Ticket.hs

@@ -26,6 +26,9 @@ module Vervis.Handler.Ticket
     , postTicketOpenR
     , postTicketClaimR
     , postTicketUnclaimR
+    , getTicketAssignR
+    , postTicketAssignR
+    , postTicketUnassignR
     , getTicketDiscussionR
     , postTicketDiscussionR
     , getTicketMessageR
@@ -41,6 +44,7 @@ import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger (logWarn)
 import Data.Default.Class (def)
 import Data.Maybe (fromMaybe)
+import Data.Monoid ((<>))
 import Data.Text (Text)
 import Data.Time.Calendar (Day (..))
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
@@ -306,6 +310,81 @@ postTicketUnclaimR shr prj num = do
     setMessage $ fromMaybe "The ticket is now unassigned." mmsg
     redirect $ TicketR shr prj num
 
+getTicketAssignR :: ShrIdent -> PrjIdent -> Int -> Handler Html
+getTicketAssignR shr prj num = do
+    vpid <- requireAuthId
+    (jid, Entity tid ticket) <- runDB $ do
+        Entity s _ <- getBy404 $ UniqueSharer shr
+        Entity j _ <- getBy404 $ UniqueProject prj s
+        et <- getBy404 $ UniqueTicket j num
+        return (j, et)
+    let msg t = do
+            setMessage t
+            redirect $ TicketR shr prj num
+    case (ticketDone ticket, ticketAssignee ticket) of
+        (True, _) -> msg "The ticket is closed. Can’t assign closed tickets."
+        (False, Just _) -> msg "The ticket is already assigned to someone."
+        (False, Nothing) -> do
+            ((_result, widget), enctype) <-
+                runFormPost $ assignTicketForm vpid jid
+            defaultLayout $(widgetFile "ticket/assign")
+
+postTicketAssignR :: ShrIdent -> PrjIdent -> Int -> Handler Html
+postTicketAssignR shr prj num = do
+    vpid <- requireAuthId
+    (jid, Entity tid ticket) <- runDB $ do
+        Entity s _ <- getBy404 $ UniqueSharer shr
+        Entity j _ <- getBy404 $ UniqueProject prj s
+        et <- getBy404 $ UniqueTicket j num
+        return (j, et)
+    let msg t = do
+            setMessage t
+            redirect $ TicketR shr prj num
+    case (ticketDone ticket, ticketAssignee ticket) of
+        (True, _) -> msg "The ticket is closed. Can’t assign closed tickets."
+        (False, Just _) -> msg "The ticket is already assigned to someone."
+        (False, Nothing) -> do
+            ((result, widget), enctype) <-
+                runFormPost $ assignTicketForm vpid jid
+            case result of
+                FormSuccess pid -> do
+                    sharer <- runDB $ do
+                        update tid [TicketAssignee =. Just pid]
+                        person <- getJust pid
+                        getJust $ personIdent person
+                    let si = sharerIdent sharer
+                    msg $ toHtml $
+                        "The ticket is now assigned to " <> shr2text si <> "."
+                FormMissing -> do
+                    setMessage "Field(s) missing."
+                    defaultLayout $(widgetFile "ticket/assign")
+                FormFailure _l -> do
+                    setMessage "Ticket assignment failed, see errors below."
+                    defaultLayout $(widgetFile "ticket/assign")
+
+postTicketUnassignR :: ShrIdent -> PrjIdent -> Int -> Handler Html
+postTicketUnassignR 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 True, _) ->
+                return $ Just "The ticket is assigned to you, unclaim instead."
+            (Just False, True) -> do
+                $logWarn "Found a closed claimed ticket, this is invalid"
+                return $
+                    Just "The ticket is closed. Can’t unclaim closed tickets."
+            (Just False, 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

src/Vervis/Model/Role.hs

@@ -30,6 +30,8 @@ derivePersistField "RepoOperation"
 data ProjectOperation
     = ProjOpClaimTicket
     | ProjOpUnclaimTicket
+    | ProjOpAssignTicket
+    | ProjOpUnassignTicket
     deriving (Eq, Show, Read, Enum, Bounded)
 
 derivePersistField "ProjectOperation"

templates/ticket/assign.hamlet

@@ -0,0 +1,17 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+<form method=POST action=@{TicketAssignR shr prj num} enctype=#{enctype}>
+  ^{widget}
+  <input type=submit>

templates/ticket/edit.hamlet

@@ -12,8 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-Enter the details and click "Submit" to update the ticket.
-
 <form method=POST action=@{TicketR shar proj num} enctype=#{enctype}>
   <input type=hidden name=_method value=PUT>
   ^{widget}

templates/ticket/one.hamlet

@@ -33,12 +33,20 @@ $if not $ ticketDone ticket
           <input type=submit value="Unclaim this ticket">
       $else
         Assigned to ^{personLinkW assignee}.
+
+        <form method=POST action=@{TicketUnassignR shar proj num}>
+          <input type=submit value="Unassign this ticket">
     $nothing
       Not assigned.
 
       <form method=POST action=@{TicketClaimR shar proj num}>
         <input type=submit value="Claim this ticket">
 
+      or
+
+      <a href=@{TicketAssignR shar proj num}>Assign to someone else
+      .
+
 <p>
   Status: #
   $if ticketDone ticket

vervis.cabal

@@ -87,6 +87,7 @@ library
                        Vervis.Field.Repo
                        Vervis.Field.Role
                        Vervis.Field.Sharer
+                       Vervis.Field.Ticket
                        Vervis.Form.Discussion
                        Vervis.Form.Group
                        Vervis.Form.Key