From de5d24edca96b5ba32b20d7936969e33dbda78d1 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Wed, 5 Aug 2020 11:04:00 +0000 Subject: [PATCH] When grabbing ticket/patch from DB, grab the TicketResolve* record too --- src/Vervis/API.hs | 16 +++++----- src/Vervis/Federation/Discussion.hs | 16 +++++----- src/Vervis/Federation/Offer.hs | 8 ++--- src/Vervis/Federation/Ticket.hs | 20 ++++++------ src/Vervis/Handler/Patch.hs | 24 +++++++------- src/Vervis/Handler/Ticket.hs | 42 ++++++++++++------------- src/Vervis/Patch.hs | 49 +++++++++++++++++++++++++++-- src/Vervis/Ticket.hs | 49 +++++++++++++++++++++++++++-- src/Vervis/WorkItem.hs | 8 ++--- 9 files changed, 161 insertions(+), 71 deletions(-) diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 1c179d2..aa552bb 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -350,7 +350,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge (mproject, did) <- case context of NoteContextSharerTicket shr talid False -> do - (_, Entity _ lt, _, project) <- do + (_, Entity _ lt, _, project, _) <- do mticket <- lift $ getSharerTicket shr talid fromMaybeE mticket "Note context no such local sharer-hosted ticket" mproj <- @@ -359,7 +359,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge Right _ -> return Nothing return (mproj, localTicketDiscuss lt) NoteContextSharerTicket shr talid True -> do - (_, Entity _ lt, _, repo, _) <- do + (_, Entity _ lt, _, repo, _, _) <- do mticket <- lift $ getSharerPatch shr talid fromMaybeE mticket "Note context no such local sharer-hosted patch" mproj <- @@ -368,12 +368,12 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge Right _ -> return Nothing return (mproj, localTicketDiscuss lt) NoteContextProjectTicket shr prj ltid -> do - (_, _, _, Entity _ lt, _, _, _) <- do + (_, _, _, Entity _ lt, _, _, _, _) <- do mticket <- lift $ getProjectTicket shr prj ltid fromMaybeE mticket "Note context no such local project-hosted ticket" return (Just $ Left (shr, prj), localTicketDiscuss lt) NoteContextRepoPatch shr rp ltid -> do - (_, _, _, Entity _ lt, _, _, _, _) <- do + (_, _, _, Entity _ lt, _, _, _, _, _) <- do mticket <- lift $ getRepoPatch shr rp ltid fromMaybeE mticket "Note context no such local project-hosted ticket" return (Just $ Right (shr, rp), localTicketDiscuss lt) @@ -1141,7 +1141,7 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do Left person -> return (personFollowers person, personInbox person, True, personOutbox person) Right _group -> throwE "Follow object is a group" getFollowee (FolloweeSharerTicket shr talkhid) = do - (Entity _ tal, Entity _ lt, _, _) <- do + (Entity _ tal, Entity _ lt, _, _, _) <- do mticket <- lift $ runMaybeT $ do talid <- decodeKeyHashidM talkhid MaybeT $ getSharerTicket shr talid @@ -1149,7 +1149,7 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do p <- lift $ getJust $ ticketAuthorLocalAuthor tal return (localTicketFollowers lt, personInbox p, True, personOutbox p) getFollowee (FolloweeSharerPatch shr talkhid) = do - (Entity _ tal, Entity _ lt, _, _, _) <- do + (Entity _ tal, Entity _ lt, _, _, _, _) <- do mticket <- lift $ runMaybeT $ do talid <- decodeKeyHashidM talkhid MaybeT $ getSharerPatch shr talid @@ -1163,7 +1163,7 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do project <- fromMaybeE mproject "Follow object: No such project in DB" return (projectFollowers project, projectInbox project, False, projectOutbox project) getFollowee (FolloweeProjectTicket shr prj ltkhid) = do - (_, Entity _ j, _, Entity _ lt, _, _, _) <- do + (_, Entity _ j, _, Entity _ lt, _, _, _, _) <- do mticket <- lift $ runMaybeT $ do ltid <- decodeKeyHashidM ltkhid MaybeT $ getProjectTicket shr prj ltid @@ -1176,7 +1176,7 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do repo <- fromMaybeE mrepo "Follow object: No such repo in DB" return (repoFollowers repo, repoInbox repo, False, repoOutbox repo) getFollowee (FolloweeRepoPatch shr rp ltkhid) = do - (_, Entity _ r, _, Entity _ lt, _, _, _, _) <- do + (_, Entity _ r, _, Entity _ lt, _, _, _, _, _) <- do mticket <- lift $ runMaybeT $ do ltid <- decodeKeyHashidM ltkhid MaybeT $ getRepoPatch shr rp ltid diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index 75214ea..26a9482 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -235,12 +235,12 @@ sharerCreateNoteF now shrRecip author body mfwd luCreate note = do (tal, lt, followers) <- if patch then do - (Entity _ tal, Entity _ lt, _, _, _) <- do + (Entity _ tal, Entity _ lt, _, _, _, _) <- do mticket <- lift $ getSharerPatch shr talid fromMaybeE mticket "Context: No such sharer-patch" return (tal, lt, LocalPersonCollectionSharerPatchFollowers) else do - (Entity _ tal, Entity _ lt, _, _) <- do + (Entity _ tal, Entity _ lt, _, _, _) <- do mticket <- lift $ getSharerTicket shr talid fromMaybeE mticket "Context: No such sharer-ticket" return (tal, lt, LocalPersonCollectionSharerTicketFollowers) @@ -287,7 +287,7 @@ sharerCreateNoteF now shrRecip author body mfwd luCreate note = do personRecip <- lift $ do sid <- getKeyBy404 $ UniqueSharer shrRecip getValBy404 $ UniquePersonIdent sid - (_, _, _, Entity _ lt, _, _, _) <- do + (_, _, _, Entity _ lt, _, _, _, _) <- do mticket <- lift $ getProjectTicket shr prj ltid fromMaybeE mticket "Context: No such project-ticket" let did = localTicketDiscuss lt @@ -301,7 +301,7 @@ sharerCreateNoteF now shrRecip author body mfwd luCreate note = do personRecip <- lift $ do sid <- getKeyBy404 $ UniqueSharer shrRecip getValBy404 $ UniquePersonIdent sid - (_, _, _, Entity _ lt, _, _, _, _) <- do + (_, _, _, Entity _ lt, _, _, _, _, _) <- do mticket <- lift $ getRepoPatch shr rp ltid fromMaybeE mticket "Context: No such repo-patch" let did = localTicketDiscuss lt @@ -356,7 +356,7 @@ projectCreateNoteF now shrRecip prjRecip author body mfwd luCreate note = do Left (NoteContextSharerTicket shr talid False) -> do mremotesHttp <- runDBExcept $ do (jid, ibid) <- lift getProjectRecip404 - (_, _, _, project) <- do + (_, _, _, project, _) <- do mticket <- lift $ getSharerTicket shr talid fromMaybeE mticket "Context: No such sharer-ticket" case project of @@ -392,7 +392,7 @@ projectCreateNoteF now shrRecip prjRecip author body mfwd luCreate note = do Left (NoteContextProjectTicket shr prj ltid) -> do mremotesHttp <- runDBExcept $ do (jid, ibid) <- lift getProjectRecip404 - (_, _, _, Entity _ lt, _, Entity _ tpl, _) <- do + (_, _, _, Entity _ lt, _, Entity _ tpl, _, _) <- do mticket <- lift $ getProjectTicket shr prj ltid fromMaybeE mticket "Context: No such project-ticket" if ticketProjectLocalProject tpl == jid @@ -455,7 +455,7 @@ repoCreateNoteF now shrRecip rpRecip author body mfwd luCreate note = do Left (NoteContextSharerTicket shr talid True) -> do mremotesHttp <- runDBExcept $ do (rid, ibid) <- lift getRepoRecip404 - (_, _, _, repo, _) <- do + (_, _, _, repo, _, _) <- do mticket <- lift $ getSharerPatch shr talid fromMaybeE mticket "Context: No such sharer-ticket" case repo of @@ -492,7 +492,7 @@ repoCreateNoteF now shrRecip rpRecip author body mfwd luCreate note = do Left (NoteContextRepoPatch shr rp ltid) -> do mremotesHttp <- runDBExcept $ do (rid, ibid) <- lift getRepoRecip404 - (_, _, _, Entity _ lt, _, Entity _ trl, _, _) <- do + (_, _, _, Entity _ lt, _, Entity _ trl, _, _, _) <- do mticket <- lift $ getRepoPatch shr rp ltid fromMaybeE mticket "Context: No such repo-patch" if ticketRepoLocalRepo trl == rid diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index 987d3cc..e9051c0 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -436,10 +436,10 @@ sharerFollowF shr = talid <- decodeKeyHashidM talkhid if patch then do - (_, Entity _ lt, _, _, _) <- MaybeT $ getSharerPatch shr talid + (_, Entity _ lt, _, _, _, _) <- MaybeT $ getSharerPatch shr talid return lt else do - (_, Entity _ lt, _, _) <- MaybeT $ getSharerTicket shr talid + (_, Entity _ lt, _, _, _) <- MaybeT $ getSharerTicket shr talid return lt return $ case mmt of @@ -481,7 +481,7 @@ projectFollowF shr prj = j <- getValBy404 $ UniqueProject prj sid mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do ltid <- decodeKeyHashidM ltkhid - (_, _, _, Entity _ lt, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid + (_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid return lt return $ case mmt of @@ -523,7 +523,7 @@ repoFollowF shr rp = r <- getValBy404 $ UniqueRepo rp sid mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do ltid <- decodeKeyHashidM ltkhid - (_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getRepoPatch shr rp ltid + (_, _, _, Entity _ lt, _, _, _, _, _) <- MaybeT $ getRepoPatch shr rp ltid return lt return $ case mmt of diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index 6025be6..178c363 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -1075,7 +1075,7 @@ sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do (,) <$> getRoid roidT <*> traverse getRoid mroidJ if patch then do - (_, Entity ltid _, _, context, _) <- do + (_, Entity ltid _, _, context, _, _) <- do mticket <- lift $ getSharerPatch shrRecip talid fromMaybeE mticket $ "Parent" <> ": No such sharer-patch" context' <- @@ -1090,7 +1090,7 @@ sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do context return (ltid, context') else do - (_, Entity ltid _, _, context) <- do + (_, Entity ltid _, _, context, _) <- do mticket <- lift $ getSharerTicket shrRecip talid fromMaybeE mticket $ "Parent" <> ": No such sharer-ticket" context' <- @@ -1169,12 +1169,12 @@ sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do ltid <- if patch then do - (_, Entity ltid _, _, _, _) <- do + (_, Entity ltid _, _, _, _, _) <- do mticket <- lift $ getSharerPatch shrRecip talid fromMaybeE mticket $ "Child" <> ": No such sharer-patch" return ltid else do - (_, Entity ltid _, _, _) <- do + (_, Entity ltid _, _, _, _) <- do mticket <- lift $ getSharerTicket shrRecip talid fromMaybeE mticket $ "Child" <> ": No such sharer-ticket" return ltid @@ -1307,7 +1307,7 @@ projectOfferDepF now shrRecip prjRecip author body mfwd luOffer dep uTarget = do relevantParent <- for (ticketRelevance shrRecip prjRecip parent) $ \ parentLtid -> do parentAuthor <- runSiteDBExcept $ do - (_, _, _, _, _, _, author) <- do + (_, _, _, _, _, _, author, _) <- do mticket <- lift $ getProjectTicket shrRecip prjRecip parentLtid fromMaybeE mticket $ "Parent" <> ": No such project-ticket" lift $ getWorkItemAuthorDetail author @@ -1468,7 +1468,7 @@ repoOfferDepF now shrRecip rpRecip author body mfwd luOffer dep uTarget = do relevantParent <- for (ticketRelevance shrRecip rpRecip parent) $ \ parentLtid -> do parentAuthor <- runSiteDBExcept $ do - (_, _, _, _, _, _, author, _) <- do + (_, _, _, _, _, _, author, _, _) <- do mticket <- lift $ getRepoPatch shrRecip rpRecip parentLtid fromMaybeE mticket $ "Parent" <> ": No such repo-patch" lift $ getWorkItemAuthorDetail author @@ -1724,12 +1724,12 @@ sharerResolveF now shrRecip author body mfwd luResolve (Resolve uObject) = do relevantObject _ = Nothing getObjectLtid talid True = do - (_, Entity ltid _, Entity tid _, _, _) <- do + (_, Entity ltid _, Entity tid _, _, _, _) <- do mticket <- lift $ getSharerPatch shrRecip talid fromMaybeE mticket $ "Object" <> ": No such sharer-patch" return (ltid, tid) getObjectLtid talid False = do - (_, Entity ltid _, Entity tid _, _) <- do + (_, Entity ltid _, Entity tid _, _, _) <- do mticket <- lift $ getSharerTicket shrRecip talid fromMaybeE mticket $ "Object" <> ": No such sharer-ticket" return (ltid, tid) @@ -1857,7 +1857,7 @@ projectResolveF now shrRecip prjRecip author body mfwd luResolve (Resolve uObjec relevantObject _ = Nothing getObjectLtid ltid = do - (_, _, Entity tid _, _, _, _, _) <- do + (_, _, Entity tid _, _, _, _, _, _) <- do mticket <- lift $ getProjectTicket shrRecip prjRecip ltid fromMaybeE mticket $ "Object" <> ": No such project-ticket" return tid @@ -1986,7 +1986,7 @@ repoResolveF now shrRecip rpRecip author body mfwd luResolve (Resolve uObject) = relevantObject _ = Nothing getObjectLtid ltid = do - (_, _, Entity tid _, _, _, _, _, _) <- do + (_, _, Entity tid _, _, _, _, _, _, _) <- do mticket <- lift $ getRepoPatch shrRecip rpRecip ltid fromMaybeE mticket $ "Object" <> ": No such repo-patch" return tid diff --git a/src/Vervis/Handler/Patch.hs b/src/Vervis/Handler/Patch.hs index d249a5a..a9b0498 100644 --- a/src/Vervis/Handler/Patch.hs +++ b/src/Vervis/Handler/Patch.hs @@ -113,7 +113,7 @@ getSharerPatchR :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent getSharerPatchR shr talkhid = do (ticket, ptid, repo, massignee) <- runDB $ do - (_, _, Entity tid t, tp, ptid :| _) <- getSharerPatch404 shr talkhid + (_, _, Entity tid t, tp, _, ptid :| _) <- getSharerPatch404 shr talkhid (,,,) t ptid <$> bitraverse (\ (_, Entity _ trl) -> do @@ -211,7 +211,7 @@ getSharerPatchDiscussionR :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent getSharerPatchDiscussionR shr talkhid = getRepliesCollection (SharerPatchDiscussionR shr talkhid) $ do - (_, Entity _ lt, _, _, _) <- getSharerPatch404 shr talkhid + (_, Entity _ lt, _, _, _, _) <- getSharerPatch404 shr talkhid return $ localTicketDiscuss lt getSharerPatchDepsR @@ -221,7 +221,7 @@ getSharerPatchDepsR shr talkhid = where here = SharerPatchDepsR shr talkhid getTicket404 = do - (_, Entity ltid _, _, _, _) <- getSharerPatch404 shr talkhid + (_, Entity ltid _, _, _, _, _) <- getSharerPatch404 shr talkhid return ltid getSharerPatchReverseDepsR @@ -231,7 +231,7 @@ getSharerPatchReverseDepsR shr talkhid = where here = SharerPatchDepsR shr talkhid getTicket404 = do - (_, Entity ltid _, _, _, _) <- getSharerPatch404 shr talkhid + (_, Entity ltid _, _, _, _, _) <- getSharerPatch404 shr talkhid return ltid getSharerPatchFollowersR @@ -240,7 +240,7 @@ getSharerPatchFollowersR shr talkhid = getFollowersCollection here getFsid where here = SharerPatchFollowersR shr talkhid getFsid = do - (_, Entity _ lt, _, _, _) <- getSharerPatch404 shr talkhid + (_, Entity _ lt, _, _, _, _) <- getSharerPatch404 shr talkhid return $ localTicketFollowers lt getSharerPatchEventsR @@ -258,7 +258,7 @@ getSharerPatchVersionR -> Handler TypedContent getSharerPatchVersionR shr talkhid ptkhid = do (vcs, patch, (versions, mcurr)) <- runDB $ do - (_, _, Entity tid _, repo, v :| vs) <- getSharerPatch404 shr talkhid + (_, _, Entity tid _, repo, _, v :| vs) <- getSharerPatch404 shr talkhid ptid <- decodeKeyHashid404 ptkhid (,,) <$> case repo of Left (_, Entity _ trl) -> @@ -405,7 +405,7 @@ getRepoPatchR :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent getRepoPatchR shr rp ltkhid = do (ticket, ptid, trl, author, massignee) <- runDB $ do - (_, _, Entity tid t, _, _, Entity _ trl, ta, ptid :| _) <- getRepoPatch404 shr rp ltkhid + (_, _, Entity tid t, _, _, Entity _ trl, ta, _, ptid :| _) <- getRepoPatch404 shr rp ltkhid (,,,,) t ptid trl <$> bitraverse (\ (Entity _ tal, _) -> do @@ -492,7 +492,7 @@ getRepoPatchDiscussionR :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent getRepoPatchDiscussionR shr rp ltkhid = getRepliesCollection (RepoPatchDiscussionR shr rp ltkhid) $ do - (_, _, _, Entity _ lt, _, _, _, _) <- getRepoPatch404 shr rp ltkhid + (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid return $ localTicketDiscuss lt getRepoPatchDepsR @@ -502,7 +502,7 @@ getRepoPatchDepsR shr rp ltkhid = where here = RepoPatchDepsR shr rp ltkhid getTicketId404 = do - (_, _, _, Entity ltid _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid + (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid return ltid getRepoPatchReverseDepsR @@ -512,7 +512,7 @@ getRepoPatchReverseDepsR shr rp ltkhid = where here = RepoPatchReverseDepsR shr rp ltkhid getTicketId404 = do - (_, _, _, Entity ltid _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid + (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid return ltid getRepoPatchFollowersR @@ -521,7 +521,7 @@ getRepoPatchFollowersR shr rp ltkhid = getFollowersCollection here getFsid where here = RepoPatchFollowersR shr rp ltkhid getFsid = do - (_, _, _, Entity _ lt, _, _, _, _) <- getRepoPatch404 shr rp ltkhid + (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid return $ localTicketFollowers lt getRepoPatchEventsR @@ -540,7 +540,7 @@ getRepoPatchVersionR -> Handler TypedContent getRepoPatchVersionR shr rp ltkhid ptkhid = do (vcs, patch, author, (versions, mcurr)) <- runDB $ do - (_, Entity _ repo, Entity tid _, _, _, _, ta, v :| vs) <- getRepoPatch404 shr rp ltkhid + (_, Entity _ repo, Entity tid _, _, _, _, ta, _, v :| vs) <- getRepoPatch404 shr rp ltkhid ptid <- decodeKeyHashid404 ptkhid (repoVcs repo,,,) <$> do pt <- get404 ptid diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 4159cba..95682eb 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -299,7 +299,7 @@ getProjectTicketR shar proj ltkhid = do ( wshr, wfl, author, massignee, ticket, lticket, tparams, eparams, cparams) <- runDB $ do - (Entity sid sharer, Entity jid project, Entity tid ticket, Entity _ lticket, _etcl, _etpl, author) <- getProjectTicket404 shar proj ltkhid + (Entity sid sharer, Entity jid project, Entity tid ticket, Entity _ lticket, _etcl, _etpl, author, _) <- getProjectTicket404 shar proj ltkhid (wshr, wid, wfl) <- do w <- get404 $ projectWorkflow project wsharer <- @@ -410,7 +410,7 @@ getProjectTicketR shar proj ltkhid = do putProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html putProjectTicketR shr prj ltkhid = do (tid, ticket, wid) <- runDB $ do - (_es, Entity _ project, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, Entity _ project, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid return (tid, ticket, projectWorkflow project) ((result, widget), enctype) <- runFormPost $ editTicketContentForm tid ticket wid @@ -484,7 +484,7 @@ postProjectTicketR shr prj ltkhid = do getProjectTicketEditR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html getProjectTicketEditR shr prj ltkhid = do (tid, ticket, wid) <- runDB $ do - (_es, Entity _ project, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, Entity _ project, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid return (tid, ticket, projectWorkflow project) ((_result, widget), enctype) <- runFormPost $ editTicketContentForm tid ticket wid @@ -494,7 +494,7 @@ postProjectTicketAcceptR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html postProjectTicketAcceptR shr prj ltkhid = do succ <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid case ticketStatus ticket of TSNew -> do update tid [TicketStatus =. TSTodo] @@ -511,7 +511,7 @@ postProjectTicketClaimR postProjectTicketClaimR shr prj ltkhid = do pid <- requireAuthId mmsg <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid case (ticketStatus ticket, ticketAssignee ticket) of (TSNew, _) -> return $ @@ -533,7 +533,7 @@ postProjectTicketUnclaimR postProjectTicketUnclaimR shr prj ltkhid = do pid <- requireAuthId mmsg <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of (Nothing, _) -> return $ Just "The ticket is already unassigned." @@ -557,7 +557,7 @@ getProjectTicketAssignR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html getProjectTicketAssignR shr prj ltkhid = do vpid <- requireAuthId - (_es, Entity jid _, Entity tid ticket, _elt, _etcl, _etpl, _author) <- runDB $ getProjectTicket404 shr prj ltkhid + (_es, Entity jid _, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- runDB $ getProjectTicket404 shr prj ltkhid let msg t = do setMessage t redirect $ ProjectTicketR shr prj ltkhid @@ -574,7 +574,7 @@ postProjectTicketAssignR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html postProjectTicketAssignR shr prj ltkhid = do vpid <- requireAuthId - (_es, Entity jid _, Entity tid ticket, _elt, _etcl, _etpl, _author) <- runDB $ getProjectTicket404 shr prj ltkhid + (_es, Entity jid _, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- runDB $ getProjectTicket404 shr prj ltkhid let msg t = do setMessage t redirect $ ProjectTicketR shr prj ltkhid @@ -606,7 +606,7 @@ postProjectTicketUnassignR postProjectTicketUnassignR shr prj ltkhid = do pid <- requireAuthId mmsg <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of (Nothing, _) -> return $ Just "The ticket is already unassigned." @@ -688,7 +688,7 @@ getClaimRequestsTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html getClaimRequestsTicketR shr prj ltkhid = do rqs <- runDB $ do - (_es, _ej, Entity tid _, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid _, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid E.select $ E.from $ \ (tcr `E.InnerJoin` person `E.InnerJoin` sharer) -> do E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId E.on $ tcr E.^. TicketClaimRequestPerson E.==. person E.^. PersonId @@ -712,7 +712,7 @@ postClaimRequestsTicketR shr prj ltkhid = do now <- liftIO getCurrentTime pid <- requireAuthId runDB $ do - (_es, _ej, Entity tid _, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid _, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid let cr = TicketClaimRequest { ticketClaimRequestPerson = pid , ticketClaimRequestTicket = tid @@ -732,7 +732,7 @@ postClaimRequestsTicketR shr prj ltkhid = do selectDiscussionId :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> AppDB DiscussionId selectDiscussionId shr prj ltkhid = do - (_es, _ej, _et, Entity _ lticket, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, _et, Entity _ lticket, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid return $ localTicketDiscuss lticket getProjectTicketDiscussionR @@ -813,7 +813,7 @@ getProjectTicketDepsR shr prj ltkhid = where here = ProjectTicketDepsR shr prj ltkhid getLocalTicketId404 = do - (_, _, _, Entity ltid _, _, _, _) <- getProjectTicket404 shr prj ltkhid + (_, _, _, Entity ltid _, _, _, _, _) <- getProjectTicket404 shr prj ltkhid return ltid postProjectTicketDepsR @@ -893,7 +893,7 @@ getProjectTicketReverseDepsR shr prj ltkhid = where here = ProjectTicketReverseDepsR shr prj ltkhid getLocalTicketId404 = do - (_, _, _, Entity ltid _, _, _, _) <- getProjectTicket404 shr prj ltkhid + (_, _, _, Entity ltid _, _, _, _, _) <- getProjectTicket404 shr prj ltkhid return ltid getTicketDepR :: KeyHashid LocalTicketDependency -> Handler TypedContent @@ -971,14 +971,14 @@ getProjectTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFs where here = ProjectTicketParticipantsR shr prj ltkhid getFsid = do - (_es, _ej, _et, Entity _ lt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, _et, Entity _ lt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid return $ localTicketFollowers lt getProjectTicketTeamR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent getProjectTicketTeamR shr prj ltkhid = do memberShrs <- runDB $ do - (Entity sid _, _ej, _et, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (Entity sid _, _ej, _et, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid id_ <- requireEitherAlt (getKeyBy $ UniquePersonIdent sid) @@ -1052,7 +1052,7 @@ getSharerTicketR :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent getSharerTicketR shr talkhid = do (ticket, project, massignee) <- runDB $ do - (_, _, Entity _ t, tp) <- getSharerTicket404 shr talkhid + (_, _, Entity _ t, tp, _) <- getSharerTicket404 shr talkhid (,,) t <$> bitraverse (\ (_, Entity _ tpl) -> do @@ -1129,7 +1129,7 @@ getSharerTicketDiscussionR :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent getSharerTicketDiscussionR shr talkhid = getRepliesCollection (SharerTicketDiscussionR shr talkhid) $ do - (_, Entity _ lt, _, _) <- getSharerTicket404 shr talkhid + (_, Entity _ lt, _, _, _) <- getSharerTicket404 shr talkhid return $ localTicketDiscuss lt getSharerTicketDepsR @@ -1139,7 +1139,7 @@ getSharerTicketDepsR shr talkhid = where here = SharerTicketDepsR shr talkhid getLocalTicketId404 = do - (_, Entity ltid _, _, _) <- getSharerTicket404 shr talkhid + (_, Entity ltid _, _, _, _) <- getSharerTicket404 shr talkhid return ltid getSharerTicketReverseDepsR @@ -1149,7 +1149,7 @@ getSharerTicketReverseDepsR shr talkhid = where here = SharerTicketReverseDepsR shr talkhid getLocalTicketId404 = do - (_, Entity ltid _, _, _) <- getSharerTicket404 shr talkhid + (_, Entity ltid _, _, _, _) <- getSharerTicket404 shr talkhid return ltid getSharerTicketFollowersR @@ -1158,7 +1158,7 @@ getSharerTicketFollowersR shr talkhid = getFollowersCollection here getFsid where here = SharerTicketFollowersR shr talkhid getFsid = do - (_, Entity _ lt, _, _) <- getSharerTicket404 shr talkhid + (_, Entity _ lt, _, _, _) <- getSharerTicket404 shr talkhid return $ localTicketFollowers lt getSharerTicketTeamR diff --git a/src/Vervis/Patch.hs b/src/Vervis/Patch.hs index 22069c9..a6ef98b 100644 --- a/src/Vervis/Patch.hs +++ b/src/Vervis/Patch.hs @@ -42,6 +42,25 @@ import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident +getResolved + :: MonadIO m + => LocalTicketId + -> ReaderT SqlBackend m + (Maybe + ( Entity TicketResolve + , Either (Entity TicketResolveLocal) (Entity TicketResolveRemote) + ) + ) +getResolved ltid = do + metr <- getBy $ UniqueTicketResolve ltid + for metr $ \ etr@(Entity trid _) -> + (etr,) <$> + requireEitherAlt + (getBy $ UniqueTicketResolveLocal trid) + (getBy $ UniqueTicketResolveRemote trid) + "No TRX" + "Both TRL and TRR" + getSharerPatch :: MonadIO m => ShrIdent @@ -58,6 +77,12 @@ getSharerPatch ( Entity TicketProjectRemote , Maybe (Entity TicketProjectRemoteAccept) ) + , Maybe + ( Entity TicketResolve + , Either + (Entity TicketResolveLocal) + (Entity TicketResolveRemote) + ) , NonEmpty PatchId ) ) @@ -92,7 +117,8 @@ getSharerPatch shr talid = runMaybeT $ do ) "MR doesn't have context" "MR has both local and remote context" - return (Entity talid tal, Entity ltid lt, Entity tid t, repo, ptids) + mresolved <- lift $ getResolved ltid + return (Entity talid tal, Entity ltid lt, Entity tid t, repo, mresolved, ptids) getSharerPatch404 :: ShrIdent @@ -108,6 +134,12 @@ getSharerPatch404 ( Entity TicketProjectRemote , Maybe (Entity TicketProjectRemoteAccept) ) + , Maybe + ( Entity TicketResolve + , Either + (Entity TicketResolveLocal) + (Entity TicketResolveRemote) + ) , NonEmpty PatchId ) getSharerPatch404 shr talkhid = do @@ -133,6 +165,12 @@ getRepoPatch , Either (Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorRemote) + , Maybe + ( Entity TicketResolve + , Either + (Entity TicketResolveLocal) + (Entity TicketResolveRemote) + ) , NonEmpty PatchId ) ) @@ -161,7 +199,8 @@ getRepoPatch shr rp ltid = runMaybeT $ do (lift $ getBy $ UniqueTicketAuthorRemote tclid) "MR doesn't have author" "MR has both local and remote author" - return (es, er, Entity tid t, Entity ltid lt, etcl, etrl, author, ptids) + mresolved <- lift $ getResolved ltid + return (es, er, Entity tid t, Entity ltid lt, etcl, etrl, author, mresolved, ptids) getRepoPatch404 :: ShrIdent @@ -177,6 +216,12 @@ getRepoPatch404 , Either (Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorRemote) + , Maybe + ( Entity TicketResolve + , Either + (Entity TicketResolveLocal) + (Entity TicketResolveRemote) + ) , NonEmpty PatchId ) getRepoPatch404 shr rp ltkhid = do diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index 4e44341..8916f42 100644 --- a/src/Vervis/Ticket.hs +++ b/src/Vervis/Ticket.hs @@ -478,6 +478,12 @@ getSharerTicket ( Entity TicketProjectRemote , Maybe (Entity TicketProjectRemoteAccept) ) + , Maybe + ( Entity TicketResolve + , Either + (Entity TicketResolveLocal) + (Entity TicketResolveRemote) + ) ) ) getSharerTicket shr talid = runMaybeT $ do @@ -510,7 +516,8 @@ getSharerTicket shr talid = runMaybeT $ do ) "Ticket doesn't have project" "Ticket has both local and remote project" - return (Entity talid tal, Entity ltid lt, Entity tid t, project) + mresolved <- lift $ getResolved ltid + return (Entity talid tal, Entity ltid lt, Entity tid t, project, mresolved) getSharerTicket404 :: ShrIdent @@ -526,6 +533,12 @@ getSharerTicket404 ( Entity TicketProjectRemote , Maybe (Entity TicketProjectRemoteAccept) ) + , Maybe + ( Entity TicketResolve + , Either + (Entity TicketResolveLocal) + (Entity TicketResolveRemote) + ) ) getSharerTicket404 shr talkhid = do talid <- decodeKeyHashid404 talkhid @@ -534,6 +547,25 @@ getSharerTicket404 shr talkhid = do Nothing -> notFound Just ticket -> return ticket +getResolved + :: MonadIO m + => LocalTicketId + -> ReaderT SqlBackend m + (Maybe + ( Entity TicketResolve + , Either (Entity TicketResolveLocal) (Entity TicketResolveRemote) + ) + ) +getResolved ltid = do + metr <- getBy $ UniqueTicketResolve ltid + for metr $ \ etr@(Entity trid _) -> + (etr,) <$> + requireEitherAlt + (getBy $ UniqueTicketResolveLocal trid) + (getBy $ UniqueTicketResolveRemote trid) + "No TRX" + "Both TRL and TRR" + getProjectTicket :: MonadIO m => ShrIdent @@ -550,6 +582,12 @@ getProjectTicket , Either (Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorRemote) + , Maybe + ( Entity TicketResolve + , Either + (Entity TicketResolveLocal) + (Entity TicketResolveRemote) + ) ) ) getProjectTicket shr prj ltid = runMaybeT $ do @@ -576,7 +614,8 @@ getProjectTicket shr prj ltid = runMaybeT $ do (lift $ getBy $ UniqueTicketAuthorRemote tclid) "Ticket doesn't have author" "Ticket has both local and remote author" - return (es, ej, Entity tid t, Entity ltid lt, etcl, etpl, author) + mresolved <- lift $ getResolved ltid + return (es, ej, Entity tid t, Entity ltid lt, etcl, etpl, author, mresolved) getProjectTicket404 :: ShrIdent @@ -592,6 +631,12 @@ getProjectTicket404 , Either (Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorRemote) + , Maybe + ( Entity TicketResolve + , Either + (Entity TicketResolveLocal) + (Entity TicketResolveRemote) + ) ) getProjectTicket404 shr prj ltkhid = do ltid <- decodeKeyHashid404 ltkhid diff --git a/src/Vervis/WorkItem.hs b/src/Vervis/WorkItem.hs index 5d7f73c..9efdc77 100644 --- a/src/Vervis/WorkItem.hs +++ b/src/Vervis/WorkItem.hs @@ -172,7 +172,7 @@ getWorkItemDetail name v = do return $ WorkItemDetail childId childCtx' childAuthor where getWorkItem name (WorkItemSharerTicket shr talid False) = do - (_, Entity ltid _, _, context) <- do + (_, Entity ltid _, _, context, _) <- do mticket <- lift $ getSharerTicket shr talid fromMaybeE mticket $ name <> ": No such sharer-ticket" context' <- @@ -197,7 +197,7 @@ getWorkItemDetail name v = do context return (ltid, context', Left shr) getWorkItem name (WorkItemSharerTicket shr talid True) = do - (_, Entity ltid _, _, context, _) <- do + (_, Entity ltid _, _, context, _, _) <- do mticket <- lift $ getSharerPatch shr talid fromMaybeE mticket $ name <> ": No such sharer-patch" context' <- @@ -223,13 +223,13 @@ getWorkItemDetail name v = do return (ltid, context', Left shr) getWorkItem name (WorkItemProjectTicket shr prj ltid) = do mticket <- lift $ getProjectTicket shr prj ltid - (Entity _ s, Entity _ j, _, _, _, _, author) <- + (Entity _ s, Entity _ j, _, _, _, _, author, _) <- fromMaybeE mticket $ name <> ": No such project-ticket" author' <- lift $ getWorkItemAuthorDetail author return (ltid, Left $ Left (sharerIdent s, projectIdent j), author') getWorkItem name (WorkItemRepoPatch shr rp ltid) = do mticket <- lift $ getRepoPatch shr rp ltid - (Entity _ s, Entity _ r, _, _, _, _, author, _) <- + (Entity _ s, Entity _ r, _, _, _, _, author, _, _) <- fromMaybeE mticket $ name <> ": No such repo-patch" author' <- lift $ getWorkItemAuthorDetail author return (ltid, Left $ Right (sharerIdent s, repoIdent r), author')