diff --git a/src/Vervis/Handler/Cloth.hs b/src/Vervis/Handler/Cloth.hs
index f39932d..b7b9732 100644
--- a/src/Vervis/Handler/Cloth.hs
+++ b/src/Vervis/Handler/Cloth.hs
@@ -284,10 +284,10 @@ getClothR loomHash clothHash = do
where
getClothHtml = do
mpid <- maybeAuthId
- (ticket, targetRepo, author, tparams, eparams, cparams, moriginRepo, mbundle) <- handlerToWidget $ runDB $ do
- (Entity _ loom, Entity _ cloth, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr, proposal) <-
+ (ticket, targetRepo, author, tparams, eparams, cparams, resolved, moriginRepo, mbundle) <- handlerToWidget $ runDB $ do
+ (Entity _ loom, Entity _ cloth, Entity ticketID ticket, author, maybeResolve, proposal) <-
getCloth404 loomHash clothHash
- (ticket,,,,,,,)
+ (ticket,,,,,,,,)
<$> getLocalRepo' (loomRepo loom) (ticketLoomBranch cloth)
<*> bitraverse
(\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
@@ -304,6 +304,7 @@ getClothR loomHash clothHash = do
<*> getTicketTextParams ticketID --wid
<*> getTicketEnumParams ticketID --wid
<*> getTicketClasses ticketID --wid
+ <*> traverse getTicketResolve maybeResolve
<*> traverse
(bitraverse
(\ (Entity _(MergeOriginLocal _ originRepoID maybeBranch)) ->
@@ -327,9 +328,9 @@ getClothR loomHash clothHash = do
diffs = NE.map (patchContent . entityVal) $ NE.reverse patches
(repoID, _, _, maybeBranch) = targetRepo
maybeErrorOrCanApply <-
- case ticketStatus ticket of
- TSClosed -> pure Nothing
- _ -> Just <$> runExceptT (canApplyPatches repoID maybeBranch diffs)
+ case resolved of
+ Just _ -> pure Nothing
+ Nothing -> Just <$> runExceptT (canApplyPatches repoID maybeBranch diffs)
return (bundleID, patchIDs, maybeErrorOrCanApply)
hashMessageKey <- handlerToWidget getEncodeKeyHashid
let desc :: Widget
diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs
index 9f3f8fd..147312b 100644
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@@ -251,10 +251,10 @@ getTicketR deckHash ticketHash = do
where
getTicketHtml = do
mpid <- maybeAuthId
- (ticket, author, tparams, eparams, cparams) <- handlerToWidget $ runDB $ do
- (_deck, _ticketdeck, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr) <-
+ (ticket, author, tparams, eparams, cparams, resolved) <- handlerToWidget $ runDB $ do
+ (_deck, _ticketdeck, Entity ticketID ticket, author, maybeResolve) <-
getTicket404 deckHash ticketHash
- (ticket,,,,)
+ (ticket,,,,,)
<$> bitraverse
(\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
p <- getJust personID
@@ -270,6 +270,7 @@ getTicketR deckHash ticketHash = do
<*> getTicketTextParams ticketID --wid
<*> getTicketEnumParams ticketID --wid
<*> getTicketClasses ticketID --wid
+ <*> traverse getTicketResolve maybeResolve
hashMessageKey <- handlerToWidget getEncodeKeyHashid
let desc :: Widget
desc = toWidget $ markupHTML $ ticketDescription ticket
diff --git a/src/Vervis/Persist/Actor.hs b/src/Vervis/Persist/Actor.hs
index 39ddda5..a8726f7 100644
--- a/src/Vervis/Persist/Actor.hs
+++ b/src/Vervis/Persist/Actor.hs
@@ -15,6 +15,7 @@
module Vervis.Persist.Actor
( getLocalActor
+ , getLocalActorEnt
, getLocalActorEntity
, verifyLocalActivityExistsInDB
, getRemoteActorURI
@@ -30,6 +31,7 @@ import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
+import Data.Barbie
import Data.Text (Text)
import Data.Traversable
import Database.Persist
@@ -60,12 +62,16 @@ import Vervis.Settings
getLocalActor
:: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Key)
-getLocalActor actorID = do
- mp <- getKeyBy $ UniquePersonActor actorID
- mg <- getKeyBy $ UniqueGroupActor actorID
- mr <- getKeyBy $ UniqueRepoActor actorID
- md <- getKeyBy $ UniqueDeckActor actorID
- ml <- getKeyBy $ UniqueLoomActor actorID
+getLocalActor = fmap (bmap entityKey) . getLocalActorEnt
+
+getLocalActorEnt
+ :: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Entity)
+getLocalActorEnt actorID = do
+ mp <- getBy $ UniquePersonActor actorID
+ mg <- getBy $ UniqueGroupActor actorID
+ mr <- getBy $ UniqueRepoActor actorID
+ md <- getBy $ UniqueDeckActor actorID
+ ml <- getBy $ UniqueLoomActor actorID
return $
case (mp, mg, mr, md, ml) of
(Nothing, Nothing, Nothing, Nothing, Nothing) -> error "Unused ActorId"
diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs
index 1e92bae..f7607f1 100644
--- a/src/Vervis/Ticket.hs
+++ b/src/Vervis/Ticket.hs
@@ -47,6 +47,8 @@ module Vervis.Ticket
, parseProposalBundle
, checkDepAndTarget
+
+ , getTicketResolve
)
where
@@ -56,6 +58,7 @@ import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
+import Data.Bitraversable
import Data.Either
import Data.Foldable (for_)
import Data.Maybe
@@ -88,6 +91,7 @@ import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Workflow
import Vervis.Paginate
+import Vervis.Persist.Actor
import Vervis.Recipient
import Vervis.Widget.Ticket
@@ -786,3 +790,29 @@ checkDepAndTarget
checkParentAndTarget (Left _) (Right _) = throwE "Local parent but remote target"
checkParentAndTarget (Right _) (Left _) = throwE "Local target but remote parent"
checkParentAndTarget (Right _) (Right _) = return ()
+
+getTicketResolve (Entity _ tr, resolve) = do
+ time <- outboxItemPublished <$> getJust (ticketResolveAccept tr)
+ closer <- bitraverse getCloserLocal getCloserRemote resolve
+ return (time, closer)
+ where
+ getCloserLocal (Entity _ trl) = do
+ outboxID <-
+ outboxItemOutbox <$>
+ getJust (ticketResolveLocalActivity trl)
+ Entity actorID actor <- do
+ maybeActor <- getBy $ UniqueActorOutbox outboxID
+ case maybeActor of
+ Nothing -> error "No actor for outbox"
+ Just a -> pure a
+ actorByEntity <- getLocalActorEnt actorID
+ person <-
+ case actorByEntity of
+ LocalActorPerson p -> pure p
+ _ -> error "Surprise! Ticket closer isn't a Person"
+ return (person, actor)
+ getCloserRemote (Entity _ trr) = do
+ ra <- getJust $ ticketResolveRemoteActor trr
+ ro <- getJust $ remoteActorIdent ra
+ i <- getJust $ remoteObjectInstance ro
+ return (i, ro, ra)
diff --git a/templates/cloth/one.hamlet b/templates/cloth/one.hamlet
index e3b67d2..6f3b243 100644
--- a/templates/cloth/one.hamlet
+++ b/templates/cloth/one.hamlet
@@ -130,20 +130,12 @@ $# .
Status: #
- $case ticketStatus ticket
- $of TSNew
- Open, new.
-
-$# ^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR loomHash clothHash)}
-$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR loomHash clothHash)}
- $of TSTodo
- Open, to do.
-
-$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR loomHash clothHash)}
- $of TSClosed
- Closed on ___ by ___.
-
-$# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR loomHash clothHash)}
+ $maybe (closed, closer) <- resolved
+ Closed on #{showDate closed} by ^{personLinkFedW closer}
+$# ^{buttonW POST "Reopen this MR" (ProjectTicketOpenR loomHash clothHash)}
+ $nothing
+ Open
+$# ^{buttonW POST "Close this MR" (ProjectTicketCloseR loomHash clothHash)}
Custom fields
diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet
index 8c4be11..60d0278 100644
--- a/templates/ticket/one.hamlet
+++ b/templates/ticket/one.hamlet
@@ -65,21 +65,12 @@ $# .
Status: #
- $case ticketStatus ticket
- $of TSNew
- Open, new.
-
-$# ^{buttonW POST "Accept this ticket" (ProjectTicketAcceptR deckHash ticketHash)}
-$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR deckHash ticketHash)}
- $of TSTodo
- Open, to do.
-
-$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR deckHash ticketHash)}
- $of TSClosed
- Closed on ___ by ___.
-
-$# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR deckHash ticketHash)}
-
+ $maybe (closed, closer) <- resolved
+ Closed on #{showDate closed} by ^{personLinkFedW closer}
+$# ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR deckHash ticketHash)}
+ $nothing
+ Open
+$# ^{buttonW POST "Close this ticket" (ProjectTicketCloseR deckHash ticketHash)}
Custom fields