forge/Vervis
1
0
Fork 0
Code Pull requests Activity

When grabbing ticket/patch from DB, grab the TicketResolve* record too

Browse source
This commit is contained in:
fr33domlover 2020-08-05 11:04:00 +00:00
parent 7a74dcc55e
commit de5d24edca
9 changed files with 161 additions and 71 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
src/Vervis/API.hs
View file

@ -350,7 +350,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge
(mproject, did) <- (mproject, did) <-
case context of case context of
NoteContextSharerTicket shr talid False -> do NoteContextSharerTicket shr talid False -> do
(_, Entity _ lt, _, project) <- do (_, Entity _ lt, _, project, _) <- do
mticket <- lift $ getSharerTicket shr talid mticket <- lift $ getSharerTicket shr talid
fromMaybeE mticket "Note context no such local sharer-hosted ticket" fromMaybeE mticket "Note context no such local sharer-hosted ticket"
mproj <- mproj <-
@ -359,7 +359,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge
Right _ -> return Nothing Right _ -> return Nothing
return (mproj, localTicketDiscuss lt) return (mproj, localTicketDiscuss lt)
NoteContextSharerTicket shr talid True -> do NoteContextSharerTicket shr talid True -> do
(_, Entity _ lt, _, repo, _) <- do (_, Entity _ lt, _, repo, _, _) <- do
mticket <- lift $ getSharerPatch shr talid mticket <- lift $ getSharerPatch shr talid
fromMaybeE mticket "Note context no such local sharer-hosted patch" fromMaybeE mticket "Note context no such local sharer-hosted patch"
mproj <- mproj <-
@ -368,12 +368,12 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge
Right _ -> return Nothing Right _ -> return Nothing
return (mproj, localTicketDiscuss lt) return (mproj, localTicketDiscuss lt)
NoteContextProjectTicket shr prj ltid -> do NoteContextProjectTicket shr prj ltid -> do
(_, _, _, Entity _ lt, _, _, _) <- do (_, _, _, Entity _ lt, _, _, _, _) <- do
mticket <- lift $ getProjectTicket shr prj ltid mticket <- lift $ getProjectTicket shr prj ltid
fromMaybeE mticket "Note context no such local project-hosted ticket" fromMaybeE mticket "Note context no such local project-hosted ticket"
return (Just $ Left (shr, prj), localTicketDiscuss lt) return (Just $ Left (shr, prj), localTicketDiscuss lt)
NoteContextRepoPatch shr rp ltid -> do NoteContextRepoPatch shr rp ltid -> do
(_, _, _, Entity _ lt, _, _, _, _) <- do (_, _, _, Entity _ lt, _, _, _, _, _) <- do
mticket <- lift $ getRepoPatch shr rp ltid mticket <- lift $ getRepoPatch shr rp ltid
fromMaybeE mticket "Note context no such local project-hosted ticket" fromMaybeE mticket "Note context no such local project-hosted ticket"
return (Just $ Right (shr, rp), localTicketDiscuss lt) 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) Left person -> return (personFollowers person, personInbox person, True, personOutbox person)
Right _group -> throwE "Follow object is a group" Right _group -> throwE "Follow object is a group"
getFollowee (FolloweeSharerTicket shr talkhid) = do getFollowee (FolloweeSharerTicket shr talkhid) = do
(Entity _ tal, Entity _ lt, _, _) <- do (Entity _ tal, Entity _ lt, _, _, _) <- do
mticket <- lift $ runMaybeT $ do mticket <- lift $ runMaybeT $ do
talid <- decodeKeyHashidM talkhid talid <- decodeKeyHashidM talkhid
MaybeT $ getSharerTicket shr talid MaybeT $ getSharerTicket shr talid
@ -1149,7 +1149,7 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do
p <- lift $ getJust $ ticketAuthorLocalAuthor tal p <- lift $ getJust $ ticketAuthorLocalAuthor tal
return (localTicketFollowers lt, personInbox p, True, personOutbox p) return (localTicketFollowers lt, personInbox p, True, personOutbox p)
getFollowee (FolloweeSharerPatch shr talkhid) = do getFollowee (FolloweeSharerPatch shr talkhid) = do
(Entity _ tal, Entity _ lt, _, _, _) <- do (Entity _ tal, Entity _ lt, _, _, _, _) <- do
mticket <- lift $ runMaybeT $ do mticket <- lift $ runMaybeT $ do
talid <- decodeKeyHashidM talkhid talid <- decodeKeyHashidM talkhid
MaybeT $ getSharerPatch shr talid 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" project <- fromMaybeE mproject "Follow object: No such project in DB"
return (projectFollowers project, projectInbox project, False, projectOutbox project) return (projectFollowers project, projectInbox project, False, projectOutbox project)
getFollowee (FolloweeProjectTicket shr prj ltkhid) = do getFollowee (FolloweeProjectTicket shr prj ltkhid) = do
(_, Entity _ j, _, Entity _ lt, _, _, _) <- do (_, Entity _ j, _, Entity _ lt, _, _, _, _) <- do
mticket <- lift $ runMaybeT $ do mticket <- lift $ runMaybeT $ do
ltid <- decodeKeyHashidM ltkhid ltid <- decodeKeyHashidM ltkhid
MaybeT $ getProjectTicket shr prj ltid 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" repo <- fromMaybeE mrepo "Follow object: No such repo in DB"
return (repoFollowers repo, repoInbox repo, False, repoOutbox repo) return (repoFollowers repo, repoInbox repo, False, repoOutbox repo)
getFollowee (FolloweeRepoPatch shr rp ltkhid) = do getFollowee (FolloweeRepoPatch shr rp ltkhid) = do
(_, Entity _ r, _, Entity _ lt, _, _, _, _) <- do (_, Entity _ r, _, Entity _ lt, _, _, _, _, _) <- do
mticket <- lift $ runMaybeT $ do mticket <- lift $ runMaybeT $ do
ltid <- decodeKeyHashidM ltkhid ltid <- decodeKeyHashidM ltkhid
MaybeT $ getRepoPatch shr rp ltid MaybeT $ getRepoPatch shr rp ltid

16
src/Vervis/Federation/Discussion.hs
View file

@ -235,12 +235,12 @@ sharerCreateNoteF now shrRecip author body mfwd luCreate note = do
(tal, lt, followers) <- (tal, lt, followers) <-
if patch if patch
then do then do
(Entity _ tal, Entity _ lt, _, _, _) <- do (Entity _ tal, Entity _ lt, _, _, _, _) <- do
mticket <- lift $ getSharerPatch shr talid mticket <- lift $ getSharerPatch shr talid
fromMaybeE mticket "Context: No such sharer-patch" fromMaybeE mticket "Context: No such sharer-patch"
return (tal, lt, LocalPersonCollectionSharerPatchFollowers) return (tal, lt, LocalPersonCollectionSharerPatchFollowers)
else do else do
(Entity _ tal, Entity _ lt, _, _) <- do (Entity _ tal, Entity _ lt, _, _, _) <- do
mticket <- lift $ getSharerTicket shr talid mticket <- lift $ getSharerTicket shr talid
fromMaybeE mticket "Context: No such sharer-ticket" fromMaybeE mticket "Context: No such sharer-ticket"
return (tal, lt, LocalPersonCollectionSharerTicketFollowers) return (tal, lt, LocalPersonCollectionSharerTicketFollowers)
@ -287,7 +287,7 @@ sharerCreateNoteF now shrRecip author body mfwd luCreate note = do
personRecip <- lift $ do personRecip <- lift $ do
sid <- getKeyBy404 $ UniqueSharer shrRecip sid <- getKeyBy404 $ UniqueSharer shrRecip
getValBy404 $ UniquePersonIdent sid getValBy404 $ UniquePersonIdent sid
(_, _, _, Entity _ lt, _, _, _) <- do (_, _, _, Entity _ lt, _, _, _, _) <- do
mticket <- lift $ getProjectTicket shr prj ltid mticket <- lift $ getProjectTicket shr prj ltid
fromMaybeE mticket "Context: No such project-ticket" fromMaybeE mticket "Context: No such project-ticket"
let did = localTicketDiscuss lt let did = localTicketDiscuss lt
@ -301,7 +301,7 @@ sharerCreateNoteF now shrRecip author body mfwd luCreate note = do
personRecip <- lift $ do personRecip <- lift $ do
sid <- getKeyBy404 $ UniqueSharer shrRecip sid <- getKeyBy404 $ UniqueSharer shrRecip
getValBy404 $ UniquePersonIdent sid getValBy404 $ UniquePersonIdent sid
(_, _, _, Entity _ lt, _, _, _, _) <- do (_, _, _, Entity _ lt, _, _, _, _, _) <- do
mticket <- lift $ getRepoPatch shr rp ltid mticket <- lift $ getRepoPatch shr rp ltid
fromMaybeE mticket "Context: No such repo-patch" fromMaybeE mticket "Context: No such repo-patch"
let did = localTicketDiscuss lt let did = localTicketDiscuss lt
@ -356,7 +356,7 @@ projectCreateNoteF now shrRecip prjRecip author body mfwd luCreate note = do
Left (NoteContextSharerTicket shr talid False) -> do Left (NoteContextSharerTicket shr talid False) -> do
mremotesHttp <- runDBExcept $ do mremotesHttp <- runDBExcept $ do
(jid, ibid) <- lift getProjectRecip404 (jid, ibid) <- lift getProjectRecip404
(_, _, _, project) <- do (_, _, _, project, _) <- do
mticket <- lift $ getSharerTicket shr talid mticket <- lift $ getSharerTicket shr talid
fromMaybeE mticket "Context: No such sharer-ticket" fromMaybeE mticket "Context: No such sharer-ticket"
case project of case project of
@ -392,7 +392,7 @@ projectCreateNoteF now shrRecip prjRecip author body mfwd luCreate note = do
Left (NoteContextProjectTicket shr prj ltid) -> do Left (NoteContextProjectTicket shr prj ltid) -> do
mremotesHttp <- runDBExcept $ do mremotesHttp <- runDBExcept $ do
(jid, ibid) <- lift getProjectRecip404 (jid, ibid) <- lift getProjectRecip404
(_, _, _, Entity _ lt, _, Entity _ tpl, _) <- do (_, _, _, Entity _ lt, _, Entity _ tpl, _, _) <- do
mticket <- lift $ getProjectTicket shr prj ltid mticket <- lift $ getProjectTicket shr prj ltid
fromMaybeE mticket "Context: No such project-ticket" fromMaybeE mticket "Context: No such project-ticket"
if ticketProjectLocalProject tpl == jid if ticketProjectLocalProject tpl == jid
@ -455,7 +455,7 @@ repoCreateNoteF now shrRecip rpRecip author body mfwd luCreate note = do
Left (NoteContextSharerTicket shr talid True) -> do Left (NoteContextSharerTicket shr talid True) -> do
mremotesHttp <- runDBExcept $ do mremotesHttp <- runDBExcept $ do
(rid, ibid) <- lift getRepoRecip404 (rid, ibid) <- lift getRepoRecip404
(_, _, _, repo, _) <- do (_, _, _, repo, _, _) <- do
mticket <- lift $ getSharerPatch shr talid mticket <- lift $ getSharerPatch shr talid
fromMaybeE mticket "Context: No such sharer-ticket" fromMaybeE mticket "Context: No such sharer-ticket"
case repo of case repo of
@ -492,7 +492,7 @@ repoCreateNoteF now shrRecip rpRecip author body mfwd luCreate note = do
Left (NoteContextRepoPatch shr rp ltid) -> do Left (NoteContextRepoPatch shr rp ltid) -> do
mremotesHttp <- runDBExcept $ do mremotesHttp <- runDBExcept $ do
(rid, ibid) <- lift getRepoRecip404 (rid, ibid) <- lift getRepoRecip404
(_, _, _, Entity _ lt, _, Entity _ trl, _, _) <- do (_, _, _, Entity _ lt, _, Entity _ trl, _, _, _) <- do
mticket <- lift $ getRepoPatch shr rp ltid mticket <- lift $ getRepoPatch shr rp ltid
fromMaybeE mticket "Context: No such repo-patch" fromMaybeE mticket "Context: No such repo-patch"
if ticketRepoLocalRepo trl == rid if ticketRepoLocalRepo trl == rid

8
src/Vervis/Federation/Offer.hs
View file

@ -436,10 +436,10 @@ sharerFollowF shr =
talid <- decodeKeyHashidM talkhid talid <- decodeKeyHashidM talkhid
if patch if patch
then do then do
(_, Entity _ lt, _, _, _) <- MaybeT $ getSharerPatch shr talid (_, Entity _ lt, _, _, _, _) <- MaybeT $ getSharerPatch shr talid
return lt return lt
else do else do
(_, Entity _ lt, _, _) <- MaybeT $ getSharerTicket shr talid (_, Entity _ lt, _, _, _) <- MaybeT $ getSharerTicket shr talid
return lt return lt
return $ return $
case mmt of case mmt of
@ -481,7 +481,7 @@ projectFollowF shr prj =
j <- getValBy404 $ UniqueProject prj sid j <- getValBy404 $ UniqueProject prj sid
mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do
ltid <- decodeKeyHashidM ltkhid ltid <- decodeKeyHashidM ltkhid
(_, _, _, Entity _ lt, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid (_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid
return lt return lt
return $ return $
case mmt of case mmt of
@ -523,7 +523,7 @@ repoFollowF shr rp =
r <- getValBy404 $ UniqueRepo rp sid r <- getValBy404 $ UniqueRepo rp sid
mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do
ltid <- decodeKeyHashidM ltkhid ltid <- decodeKeyHashidM ltkhid
(_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getRepoPatch shr rp ltid (_, _, _, Entity _ lt, _, _, _, _, _) <- MaybeT $ getRepoPatch shr rp ltid
return lt return lt
return $ return $
case mmt of case mmt of

20
src/Vervis/Federation/Ticket.hs
View file

@ -1075,7 +1075,7 @@ sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do
(,) <$> getRoid roidT <*> traverse getRoid mroidJ (,) <$> getRoid roidT <*> traverse getRoid mroidJ
if patch if patch
then do then do
(_, Entity ltid _, _, context, _) <- do (_, Entity ltid _, _, context, _, _) <- do
mticket <- lift $ getSharerPatch shrRecip talid mticket <- lift $ getSharerPatch shrRecip talid
fromMaybeE mticket $ "Parent" <> ": No such sharer-patch" fromMaybeE mticket $ "Parent" <> ": No such sharer-patch"
context' <- context' <-
@ -1090,7 +1090,7 @@ sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do
context context
return (ltid, context') return (ltid, context')
else do else do
(_, Entity ltid _, _, context) <- do (_, Entity ltid _, _, context, _) <- do
mticket <- lift $ getSharerTicket shrRecip talid mticket <- lift $ getSharerTicket shrRecip talid
fromMaybeE mticket $ "Parent" <> ": No such sharer-ticket" fromMaybeE mticket $ "Parent" <> ": No such sharer-ticket"
context' <- context' <-
@ -1169,12 +1169,12 @@ sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do
ltid <- ltid <-
if patch if patch
then do then do
(_, Entity ltid _, _, _, _) <- do (_, Entity ltid _, _, _, _, _) <- do
mticket <- lift $ getSharerPatch shrRecip talid mticket <- lift $ getSharerPatch shrRecip talid
fromMaybeE mticket $ "Child" <> ": No such sharer-patch" fromMaybeE mticket $ "Child" <> ": No such sharer-patch"
return ltid return ltid
else do else do
(_, Entity ltid _, _, _) <- do (_, Entity ltid _, _, _, _) <- do
mticket <- lift $ getSharerTicket shrRecip talid mticket <- lift $ getSharerTicket shrRecip talid
fromMaybeE mticket $ "Child" <> ": No such sharer-ticket" fromMaybeE mticket $ "Child" <> ": No such sharer-ticket"
return ltid return ltid
@ -1307,7 +1307,7 @@ projectOfferDepF now shrRecip prjRecip author body mfwd luOffer dep uTarget = do
relevantParent <- relevantParent <-
for (ticketRelevance shrRecip prjRecip parent) $ \ parentLtid -> do for (ticketRelevance shrRecip prjRecip parent) $ \ parentLtid -> do
parentAuthor <- runSiteDBExcept $ do parentAuthor <- runSiteDBExcept $ do
(_, _, _, _, _, _, author) <- do (_, _, _, _, _, _, author, _) <- do
mticket <- lift $ getProjectTicket shrRecip prjRecip parentLtid mticket <- lift $ getProjectTicket shrRecip prjRecip parentLtid
fromMaybeE mticket $ "Parent" <> ": No such project-ticket" fromMaybeE mticket $ "Parent" <> ": No such project-ticket"
lift $ getWorkItemAuthorDetail author lift $ getWorkItemAuthorDetail author
@ -1468,7 +1468,7 @@ repoOfferDepF now shrRecip rpRecip author body mfwd luOffer dep uTarget = do
relevantParent <- relevantParent <-
for (ticketRelevance shrRecip rpRecip parent) $ \ parentLtid -> do for (ticketRelevance shrRecip rpRecip parent) $ \ parentLtid -> do
parentAuthor <- runSiteDBExcept $ do parentAuthor <- runSiteDBExcept $ do
(_, _, _, _, _, _, author, _) <- do (_, _, _, _, _, _, author, _, _) <- do
mticket <- lift $ getRepoPatch shrRecip rpRecip parentLtid mticket <- lift $ getRepoPatch shrRecip rpRecip parentLtid
fromMaybeE mticket $ "Parent" <> ": No such repo-patch" fromMaybeE mticket $ "Parent" <> ": No such repo-patch"
lift $ getWorkItemAuthorDetail author lift $ getWorkItemAuthorDetail author
@ -1724,12 +1724,12 @@ sharerResolveF now shrRecip author body mfwd luResolve (Resolve uObject) = do
relevantObject _ = Nothing relevantObject _ = Nothing
getObjectLtid talid True = do getObjectLtid talid True = do
(_, Entity ltid _, Entity tid _, _, _) <- do (_, Entity ltid _, Entity tid _, _, _, _) <- do
mticket <- lift $ getSharerPatch shrRecip talid mticket <- lift $ getSharerPatch shrRecip talid
fromMaybeE mticket $ "Object" <> ": No such sharer-patch" fromMaybeE mticket $ "Object" <> ": No such sharer-patch"
return (ltid, tid) return (ltid, tid)
getObjectLtid talid False = do getObjectLtid talid False = do
(_, Entity ltid _, Entity tid _, _) <- do (_, Entity ltid _, Entity tid _, _, _) <- do
mticket <- lift $ getSharerTicket shrRecip talid mticket <- lift $ getSharerTicket shrRecip talid
fromMaybeE mticket $ "Object" <> ": No such sharer-ticket" fromMaybeE mticket $ "Object" <> ": No such sharer-ticket"
return (ltid, tid) return (ltid, tid)
@ -1857,7 +1857,7 @@ projectResolveF now shrRecip prjRecip author body mfwd luResolve (Resolve uObjec
relevantObject _ = Nothing relevantObject _ = Nothing
getObjectLtid ltid = do getObjectLtid ltid = do
(_, _, Entity tid _, _, _, _, _) <- do (_, _, Entity tid _, _, _, _, _, _) <- do
mticket <- lift $ getProjectTicket shrRecip prjRecip ltid mticket <- lift $ getProjectTicket shrRecip prjRecip ltid
fromMaybeE mticket $ "Object" <> ": No such project-ticket" fromMaybeE mticket $ "Object" <> ": No such project-ticket"
return tid return tid
@ -1986,7 +1986,7 @@ repoResolveF now shrRecip rpRecip author body mfwd luResolve (Resolve uObject) =
relevantObject _ = Nothing relevantObject _ = Nothing
getObjectLtid ltid = do getObjectLtid ltid = do
(_, _, Entity tid _, _, _, _, _, _) <- do (_, _, Entity tid _, _, _, _, _, _, _) <- do
mticket <- lift $ getRepoPatch shrRecip rpRecip ltid mticket <- lift $ getRepoPatch shrRecip rpRecip ltid
fromMaybeE mticket $ "Object" <> ": No such repo-patch" fromMaybeE mticket $ "Object" <> ": No such repo-patch"
return tid return tid

24
src/Vervis/Handler/Patch.hs
View file

@ -113,7 +113,7 @@ getSharerPatchR
:: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerPatchR shr talkhid = do getSharerPatchR shr talkhid = do
(ticket, ptid, repo, massignee) <- runDB $ 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 (,,,) t ptid
<$> bitraverse <$> bitraverse
(\ (_, Entity _ trl) -> do (\ (_, Entity _ trl) -> do
@ -211,7 +211,7 @@ getSharerPatchDiscussionR
:: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerPatchDiscussionR shr talkhid = getSharerPatchDiscussionR shr talkhid =
getRepliesCollection (SharerPatchDiscussionR shr talkhid) $ do getRepliesCollection (SharerPatchDiscussionR shr talkhid) $ do
(_, Entity _ lt, _, _, _) <- getSharerPatch404 shr talkhid (_, Entity _ lt, _, _, _, _) <- getSharerPatch404 shr talkhid
return $ localTicketDiscuss lt return $ localTicketDiscuss lt
getSharerPatchDepsR getSharerPatchDepsR
@ -221,7 +221,7 @@ getSharerPatchDepsR shr talkhid =
where where
here = SharerPatchDepsR shr talkhid here = SharerPatchDepsR shr talkhid
getTicket404 = do getTicket404 = do
(_, Entity ltid _, _, _, _) <- getSharerPatch404 shr talkhid (_, Entity ltid _, _, _, _, _) <- getSharerPatch404 shr talkhid
return ltid return ltid
getSharerPatchReverseDepsR getSharerPatchReverseDepsR
@ -231,7 +231,7 @@ getSharerPatchReverseDepsR shr talkhid =
where where
here = SharerPatchDepsR shr talkhid here = SharerPatchDepsR shr talkhid
getTicket404 = do getTicket404 = do
(_, Entity ltid _, _, _, _) <- getSharerPatch404 shr talkhid (_, Entity ltid _, _, _, _, _) <- getSharerPatch404 shr talkhid
return ltid return ltid
getSharerPatchFollowersR getSharerPatchFollowersR
@ -240,7 +240,7 @@ getSharerPatchFollowersR shr talkhid = getFollowersCollection here getFsid
where where
here = SharerPatchFollowersR shr talkhid here = SharerPatchFollowersR shr talkhid
getFsid = do getFsid = do
(_, Entity _ lt, _, _, _) <- getSharerPatch404 shr talkhid (_, Entity _ lt, _, _, _, _) <- getSharerPatch404 shr talkhid
return $ localTicketFollowers lt return $ localTicketFollowers lt
getSharerPatchEventsR getSharerPatchEventsR
@ -258,7 +258,7 @@ getSharerPatchVersionR
-> Handler TypedContent -> Handler TypedContent
getSharerPatchVersionR shr talkhid ptkhid = do getSharerPatchVersionR shr talkhid ptkhid = do
(vcs, patch, (versions, mcurr)) <- runDB $ 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 ptid <- decodeKeyHashid404 ptkhid
(,,) <$> case repo of (,,) <$> case repo of
Left (_, Entity _ trl) -> Left (_, Entity _ trl) ->
@ -405,7 +405,7 @@ getRepoPatchR
:: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent
getRepoPatchR shr rp ltkhid = do getRepoPatchR shr rp ltkhid = do
(ticket, ptid, trl, author, massignee) <- runDB $ 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 (,,,,) t ptid trl
<$> bitraverse <$> bitraverse
(\ (Entity _ tal, _) -> do (\ (Entity _ tal, _) -> do
@ -492,7 +492,7 @@ getRepoPatchDiscussionR
:: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent :: ShrIdent -> RpIdent -> KeyHashid LocalTicket -> Handler TypedContent
getRepoPatchDiscussionR shr rp ltkhid = getRepoPatchDiscussionR shr rp ltkhid =
getRepliesCollection (RepoPatchDiscussionR shr rp ltkhid) $ do getRepliesCollection (RepoPatchDiscussionR shr rp ltkhid) $ do
(_, _, _, Entity _ lt, _, _, _, _) <- getRepoPatch404 shr rp ltkhid (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid
return $ localTicketDiscuss lt return $ localTicketDiscuss lt
getRepoPatchDepsR getRepoPatchDepsR
@ -502,7 +502,7 @@ getRepoPatchDepsR shr rp ltkhid =
where where
here = RepoPatchDepsR shr rp ltkhid here = RepoPatchDepsR shr rp ltkhid
getTicketId404 = do getTicketId404 = do
(_, _, _, Entity ltid _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid
return ltid return ltid
getRepoPatchReverseDepsR getRepoPatchReverseDepsR
@ -512,7 +512,7 @@ getRepoPatchReverseDepsR shr rp ltkhid =
where where
here = RepoPatchReverseDepsR shr rp ltkhid here = RepoPatchReverseDepsR shr rp ltkhid
getTicketId404 = do getTicketId404 = do
(_, _, _, Entity ltid _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid
return ltid return ltid
getRepoPatchFollowersR getRepoPatchFollowersR
@ -521,7 +521,7 @@ getRepoPatchFollowersR shr rp ltkhid = getFollowersCollection here getFsid
where where
here = RepoPatchFollowersR shr rp ltkhid here = RepoPatchFollowersR shr rp ltkhid
getFsid = do getFsid = do
(_, _, _, Entity _ lt, _, _, _, _) <- getRepoPatch404 shr rp ltkhid (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid
return $ localTicketFollowers lt return $ localTicketFollowers lt
getRepoPatchEventsR getRepoPatchEventsR
@ -540,7 +540,7 @@ getRepoPatchVersionR
-> Handler TypedContent -> Handler TypedContent
getRepoPatchVersionR shr rp ltkhid ptkhid = do getRepoPatchVersionR shr rp ltkhid ptkhid = do
(vcs, patch, author, (versions, mcurr)) <- runDB $ 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 ptid <- decodeKeyHashid404 ptkhid
(repoVcs repo,,,) (repoVcs repo,,,)
<$> do pt <- get404 ptid <$> do pt <- get404 ptid

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

@ -299,7 +299,7 @@ getProjectTicketR shar proj ltkhid = do
( wshr, wfl, ( wshr, wfl,
author, massignee, ticket, lticket, tparams, eparams, cparams) <- author, massignee, ticket, lticket, tparams, eparams, cparams) <-
runDB $ do 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 (wshr, wid, wfl) <- do
w <- get404 $ projectWorkflow project w <- get404 $ projectWorkflow project
wsharer <- wsharer <-
@ -410,7 +410,7 @@ getProjectTicketR shar proj ltkhid = do
putProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html putProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
putProjectTicketR shr prj ltkhid = do putProjectTicketR shr prj ltkhid = do
(tid, ticket, wid) <- runDB $ 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) return (tid, ticket, projectWorkflow project)
((result, widget), enctype) <- ((result, widget), enctype) <-
runFormPost $ editTicketContentForm tid ticket wid runFormPost $ editTicketContentForm tid ticket wid
@ -484,7 +484,7 @@ postProjectTicketR shr prj ltkhid = do
getProjectTicketEditR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html getProjectTicketEditR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getProjectTicketEditR shr prj ltkhid = do getProjectTicketEditR shr prj ltkhid = do
(tid, ticket, wid) <- runDB $ 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) return (tid, ticket, projectWorkflow project)
((_result, widget), enctype) <- ((_result, widget), enctype) <-
runFormPost $ editTicketContentForm tid ticket wid runFormPost $ editTicketContentForm tid ticket wid
@ -494,7 +494,7 @@ postProjectTicketAcceptR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketAcceptR shr prj ltkhid = do postProjectTicketAcceptR shr prj ltkhid = do
succ <- runDB $ 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 case ticketStatus ticket of
TSNew -> do TSNew -> do
update tid [TicketStatus =. TSTodo] update tid [TicketStatus =. TSTodo]
@ -511,7 +511,7 @@ postProjectTicketClaimR
postProjectTicketClaimR shr prj ltkhid = do postProjectTicketClaimR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
mmsg <- runDB $ do 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 case (ticketStatus ticket, ticketAssignee ticket) of
(TSNew, _) -> (TSNew, _) ->
return $ return $
@ -533,7 +533,7 @@ postProjectTicketUnclaimR
postProjectTicketUnclaimR shr prj ltkhid = do postProjectTicketUnclaimR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
mmsg <- runDB $ do 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 case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
(Nothing, _) -> (Nothing, _) ->
return $ Just "The ticket is already unassigned." return $ Just "The ticket is already unassigned."
@ -557,7 +557,7 @@ getProjectTicketAssignR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getProjectTicketAssignR shr prj ltkhid = do getProjectTicketAssignR shr prj ltkhid = do
vpid <- requireAuthId 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 let msg t = do
setMessage t setMessage t
redirect $ ProjectTicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
@ -574,7 +574,7 @@ postProjectTicketAssignR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketAssignR shr prj ltkhid = do postProjectTicketAssignR shr prj ltkhid = do
vpid <- requireAuthId 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 let msg t = do
setMessage t setMessage t
redirect $ ProjectTicketR shr prj ltkhid redirect $ ProjectTicketR shr prj ltkhid
@ -606,7 +606,7 @@ postProjectTicketUnassignR
postProjectTicketUnassignR shr prj ltkhid = do postProjectTicketUnassignR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
mmsg <- runDB $ do 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 case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
(Nothing, _) -> (Nothing, _) ->
return $ Just "The ticket is already unassigned." return $ Just "The ticket is already unassigned."
@ -688,7 +688,7 @@ getClaimRequestsTicketR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getClaimRequestsTicketR shr prj ltkhid = do getClaimRequestsTicketR shr prj ltkhid = do
rqs <- runDB $ 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.select $ E.from $ \ (tcr `E.InnerJoin` person `E.InnerJoin` sharer) -> do
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
E.on $ tcr E.^. TicketClaimRequestPerson E.==. person E.^. PersonId E.on $ tcr E.^. TicketClaimRequestPerson E.==. person E.^. PersonId
@ -712,7 +712,7 @@ postClaimRequestsTicketR shr prj ltkhid = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
pid <- requireAuthId pid <- requireAuthId
runDB $ do 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 let cr = TicketClaimRequest
{ ticketClaimRequestPerson = pid { ticketClaimRequestPerson = pid
, ticketClaimRequestTicket = tid , ticketClaimRequestTicket = tid
@ -732,7 +732,7 @@ postClaimRequestsTicketR shr prj ltkhid = do
selectDiscussionId selectDiscussionId
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> AppDB DiscussionId :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> AppDB DiscussionId
selectDiscussionId shr prj ltkhid = do 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 return $ localTicketDiscuss lticket
getProjectTicketDiscussionR getProjectTicketDiscussionR
@ -813,7 +813,7 @@ getProjectTicketDepsR shr prj ltkhid =
where where
here = ProjectTicketDepsR shr prj ltkhid here = ProjectTicketDepsR shr prj ltkhid
getLocalTicketId404 = do getLocalTicketId404 = do
(_, _, _, Entity ltid _, _, _, _) <- getProjectTicket404 shr prj ltkhid (_, _, _, Entity ltid _, _, _, _, _) <- getProjectTicket404 shr prj ltkhid
return ltid return ltid
postProjectTicketDepsR postProjectTicketDepsR
@ -893,7 +893,7 @@ getProjectTicketReverseDepsR shr prj ltkhid =
where where
here = ProjectTicketReverseDepsR shr prj ltkhid here = ProjectTicketReverseDepsR shr prj ltkhid
getLocalTicketId404 = do getLocalTicketId404 = do
(_, _, _, Entity ltid _, _, _, _) <- getProjectTicket404 shr prj ltkhid (_, _, _, Entity ltid _, _, _, _, _) <- getProjectTicket404 shr prj ltkhid
return ltid return ltid
getTicketDepR :: KeyHashid LocalTicketDependency -> Handler TypedContent getTicketDepR :: KeyHashid LocalTicketDependency -> Handler TypedContent
@ -971,14 +971,14 @@ getProjectTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFs
where where
here = ProjectTicketParticipantsR shr prj ltkhid here = ProjectTicketParticipantsR shr prj ltkhid
getFsid = do 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 return $ localTicketFollowers lt
getProjectTicketTeamR getProjectTicketTeamR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getProjectTicketTeamR shr prj ltkhid = do getProjectTicketTeamR shr prj ltkhid = do
memberShrs <- runDB $ 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_ <- id_ <-
requireEitherAlt requireEitherAlt
(getKeyBy $ UniquePersonIdent sid) (getKeyBy $ UniquePersonIdent sid)
@ -1052,7 +1052,7 @@ getSharerTicketR
:: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerTicketR shr talkhid = do getSharerTicketR shr talkhid = do
(ticket, project, massignee) <- runDB $ do (ticket, project, massignee) <- runDB $ do
(_, _, Entity _ t, tp) <- getSharerTicket404 shr talkhid (_, _, Entity _ t, tp, _) <- getSharerTicket404 shr talkhid
(,,) t (,,) t
<$> bitraverse <$> bitraverse
(\ (_, Entity _ tpl) -> do (\ (_, Entity _ tpl) -> do
@ -1129,7 +1129,7 @@ getSharerTicketDiscussionR
:: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent :: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerTicketDiscussionR shr talkhid = getSharerTicketDiscussionR shr talkhid =
getRepliesCollection (SharerTicketDiscussionR shr talkhid) $ do getRepliesCollection (SharerTicketDiscussionR shr talkhid) $ do
(_, Entity _ lt, _, _) <- getSharerTicket404 shr talkhid (_, Entity _ lt, _, _, _) <- getSharerTicket404 shr talkhid
return $ localTicketDiscuss lt return $ localTicketDiscuss lt
getSharerTicketDepsR getSharerTicketDepsR
@ -1139,7 +1139,7 @@ getSharerTicketDepsR shr talkhid =
where where
here = SharerTicketDepsR shr talkhid here = SharerTicketDepsR shr talkhid
getLocalTicketId404 = do getLocalTicketId404 = do
(_, Entity ltid _, _, _) <- getSharerTicket404 shr talkhid (_, Entity ltid _, _, _, _) <- getSharerTicket404 shr talkhid
return ltid return ltid
getSharerTicketReverseDepsR getSharerTicketReverseDepsR
@ -1149,7 +1149,7 @@ getSharerTicketReverseDepsR shr talkhid =
where where
here = SharerTicketReverseDepsR shr talkhid here = SharerTicketReverseDepsR shr talkhid
getLocalTicketId404 = do getLocalTicketId404 = do
(_, Entity ltid _, _, _) <- getSharerTicket404 shr talkhid (_, Entity ltid _, _, _, _) <- getSharerTicket404 shr talkhid
return ltid return ltid
getSharerTicketFollowersR getSharerTicketFollowersR
@ -1158,7 +1158,7 @@ getSharerTicketFollowersR shr talkhid = getFollowersCollection here getFsid
where where
here = SharerTicketFollowersR shr talkhid here = SharerTicketFollowersR shr talkhid
getFsid = do getFsid = do
(_, Entity _ lt, _, _) <- getSharerTicket404 shr talkhid (_, Entity _ lt, _, _, _) <- getSharerTicket404 shr talkhid
return $ localTicketFollowers lt return $ localTicketFollowers lt
getSharerTicketTeamR getSharerTicketTeamR

49
src/Vervis/Patch.hs
View file

@ -42,6 +42,25 @@ import Vervis.Foundation
import Vervis.Model import Vervis.Model
import Vervis.Model.Ident 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 getSharerPatch
:: MonadIO m :: MonadIO m
=> ShrIdent => ShrIdent
@ -58,6 +77,12 @@ getSharerPatch
( Entity TicketProjectRemote ( Entity TicketProjectRemote
, Maybe (Entity TicketProjectRemoteAccept) , Maybe (Entity TicketProjectRemoteAccept)
) )
, Maybe
( Entity TicketResolve
, Either
(Entity TicketResolveLocal)
(Entity TicketResolveRemote)
)
, NonEmpty PatchId , NonEmpty PatchId
) )
) )
@ -92,7 +117,8 @@ getSharerPatch shr talid = runMaybeT $ do
) )
"MR doesn't have context" "MR doesn't have context"
"MR has both local and remote 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 getSharerPatch404
:: ShrIdent :: ShrIdent
@ -108,6 +134,12 @@ getSharerPatch404
( Entity TicketProjectRemote ( Entity TicketProjectRemote
, Maybe (Entity TicketProjectRemoteAccept) , Maybe (Entity TicketProjectRemoteAccept)
) )
, Maybe
( Entity TicketResolve
, Either
(Entity TicketResolveLocal)
(Entity TicketResolveRemote)
)
, NonEmpty PatchId , NonEmpty PatchId
) )
getSharerPatch404 shr talkhid = do getSharerPatch404 shr talkhid = do
@ -133,6 +165,12 @@ getRepoPatch
, Either , Either
(Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorLocal, Entity TicketUnderProject)
(Entity TicketAuthorRemote) (Entity TicketAuthorRemote)
, Maybe
( Entity TicketResolve
, Either
(Entity TicketResolveLocal)
(Entity TicketResolveRemote)
)
, NonEmpty PatchId , NonEmpty PatchId
) )
) )
@ -161,7 +199,8 @@ getRepoPatch shr rp ltid = runMaybeT $ do
(lift $ getBy $ UniqueTicketAuthorRemote tclid) (lift $ getBy $ UniqueTicketAuthorRemote tclid)
"MR doesn't have author" "MR doesn't have author"
"MR has both local and remote 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 getRepoPatch404
:: ShrIdent :: ShrIdent
@ -177,6 +216,12 @@ getRepoPatch404
, Either , Either
(Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorLocal, Entity TicketUnderProject)
(Entity TicketAuthorRemote) (Entity TicketAuthorRemote)
, Maybe
( Entity TicketResolve
, Either
(Entity TicketResolveLocal)
(Entity TicketResolveRemote)
)
, NonEmpty PatchId , NonEmpty PatchId
) )
getRepoPatch404 shr rp ltkhid = do getRepoPatch404 shr rp ltkhid = do

49
src/Vervis/Ticket.hs
View file

@ -478,6 +478,12 @@ getSharerTicket
( Entity TicketProjectRemote ( Entity TicketProjectRemote
, Maybe (Entity TicketProjectRemoteAccept) , Maybe (Entity TicketProjectRemoteAccept)
) )
, Maybe
( Entity TicketResolve
, Either
(Entity TicketResolveLocal)
(Entity TicketResolveRemote)
)
) )
) )
getSharerTicket shr talid = runMaybeT $ do getSharerTicket shr talid = runMaybeT $ do
@ -510,7 +516,8 @@ getSharerTicket shr talid = runMaybeT $ do
) )
"Ticket doesn't have project" "Ticket doesn't have project"
"Ticket has both local and remote 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 getSharerTicket404
:: ShrIdent :: ShrIdent
@ -526,6 +533,12 @@ getSharerTicket404
( Entity TicketProjectRemote ( Entity TicketProjectRemote
, Maybe (Entity TicketProjectRemoteAccept) , Maybe (Entity TicketProjectRemoteAccept)
) )
, Maybe
( Entity TicketResolve
, Either
(Entity TicketResolveLocal)
(Entity TicketResolveRemote)
)
) )
getSharerTicket404 shr talkhid = do getSharerTicket404 shr talkhid = do
talid <- decodeKeyHashid404 talkhid talid <- decodeKeyHashid404 talkhid
@ -534,6 +547,25 @@ getSharerTicket404 shr talkhid = do
Nothing -> notFound Nothing -> notFound
Just ticket -> return ticket 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 getProjectTicket
:: MonadIO m :: MonadIO m
=> ShrIdent => ShrIdent
@ -550,6 +582,12 @@ getProjectTicket
, Either , Either
(Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorLocal, Entity TicketUnderProject)
(Entity TicketAuthorRemote) (Entity TicketAuthorRemote)
, Maybe
( Entity TicketResolve
, Either
(Entity TicketResolveLocal)
(Entity TicketResolveRemote)
)
) )
) )
getProjectTicket shr prj ltid = runMaybeT $ do getProjectTicket shr prj ltid = runMaybeT $ do
@ -576,7 +614,8 @@ getProjectTicket shr prj ltid = runMaybeT $ do
(lift $ getBy $ UniqueTicketAuthorRemote tclid) (lift $ getBy $ UniqueTicketAuthorRemote tclid)
"Ticket doesn't have author" "Ticket doesn't have author"
"Ticket has both local and remote 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 getProjectTicket404
:: ShrIdent :: ShrIdent
@ -592,6 +631,12 @@ getProjectTicket404
, Either , Either
(Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorLocal, Entity TicketUnderProject)
(Entity TicketAuthorRemote) (Entity TicketAuthorRemote)
, Maybe
( Entity TicketResolve
, Either
(Entity TicketResolveLocal)
(Entity TicketResolveRemote)
)
) )
getProjectTicket404 shr prj ltkhid = do getProjectTicket404 shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid

8
src/Vervis/WorkItem.hs
View file

@ -172,7 +172,7 @@ getWorkItemDetail name v = do
return $ WorkItemDetail childId childCtx' childAuthor return $ WorkItemDetail childId childCtx' childAuthor
where where
getWorkItem name (WorkItemSharerTicket shr talid False) = do getWorkItem name (WorkItemSharerTicket shr talid False) = do
(_, Entity ltid _, _, context) <- do (_, Entity ltid _, _, context, _) <- do
mticket <- lift $ getSharerTicket shr talid mticket <- lift $ getSharerTicket shr talid
fromMaybeE mticket $ name <> ": No such sharer-ticket" fromMaybeE mticket $ name <> ": No such sharer-ticket"
context' <- context' <-
@ -197,7 +197,7 @@ getWorkItemDetail name v = do
context context
return (ltid, context', Left shr) return (ltid, context', Left shr)
getWorkItem name (WorkItemSharerTicket shr talid True) = do getWorkItem name (WorkItemSharerTicket shr talid True) = do
(_, Entity ltid _, _, context, _) <- do (_, Entity ltid _, _, context, _, _) <- do
mticket <- lift $ getSharerPatch shr talid mticket <- lift $ getSharerPatch shr talid
fromMaybeE mticket $ name <> ": No such sharer-patch" fromMaybeE mticket $ name <> ": No such sharer-patch"
context' <- context' <-
@ -223,13 +223,13 @@ getWorkItemDetail name v = do
return (ltid, context', Left shr) return (ltid, context', Left shr)
getWorkItem name (WorkItemProjectTicket shr prj ltid) = do getWorkItem name (WorkItemProjectTicket shr prj ltid) = do
mticket <- lift $ getProjectTicket shr prj ltid mticket <- lift $ getProjectTicket shr prj ltid
(Entity _ s, Entity _ j, _, _, _, _, author) <- (Entity _ s, Entity _ j, _, _, _, _, author, _) <-
fromMaybeE mticket $ name <> ": No such project-ticket" fromMaybeE mticket $ name <> ": No such project-ticket"
author' <- lift $ getWorkItemAuthorDetail author author' <- lift $ getWorkItemAuthorDetail author
return (ltid, Left $ Left (sharerIdent s, projectIdent j), author') return (ltid, Left $ Left (sharerIdent s, projectIdent j), author')
getWorkItem name (WorkItemRepoPatch shr rp ltid) = do getWorkItem name (WorkItemRepoPatch shr rp ltid) = do
mticket <- lift $ getRepoPatch shr rp ltid mticket <- lift $ getRepoPatch shr rp ltid
(Entity _ s, Entity _ r, _, _, _, _, author, _) <- (Entity _ s, Entity _ r, _, _, _, _, author, _, _) <-
fromMaybeE mticket $ name <> ": No such repo-patch" fromMaybeE mticket $ name <> ": No such repo-patch"
author' <- lift $ getWorkItemAuthorDetail author author' <- lift $ getWorkItemAuthorDetail author
return (ltid, Left $ Right (sharerIdent s, repoIdent r), author') return (ltid, Left $ Right (sharerIdent s, repoIdent r), author')