From bb6785de7575a72ee72ac1afdacef72a6b26f62f Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 18 May 2020 10:28:43 +0000 Subject: [PATCH] DB: Generalize TicketProjectLocal into TicketContextLocal This is the first step preparing for patches and merge requests. The work-item aspect of MRs will reuse the Ticket related tables, except MRs will live under repos. So, the context of tickets will no longer be just projects, but will also be repos. So, TicketProjectLocal turns into TicketContextLocal, and there are 2 new tables that refer to it: TicketProjectLocal and TicketRepoLocal. Tickets will have the former, MRs will have the latter. --- config/models | 23 +++++-- migrations/2020_05_16_tcl.model | 11 ++++ migrations/2020_05_16_tcl_mig.model | 19 ++++++ src/Vervis/API.hs | 44 +++++++------ src/Vervis/ActivityPub.hs | 9 +-- src/Vervis/Client.hs | 11 ++-- src/Vervis/Federation/Discussion.hs | 6 +- src/Vervis/Federation/Offer.hs | 8 ++- src/Vervis/Federation/Ticket.hs | 22 ++++--- src/Vervis/Field/Ticket.hs | 5 +- src/Vervis/Handler/Discussion.hs | 5 +- src/Vervis/Handler/Sharer.hs | 4 +- src/Vervis/Handler/Ticket.hs | 95 ++++++++++++++++------------- src/Vervis/Migration.hs | 16 +++++ src/Vervis/Migration/Model.hs | 10 +++ src/Vervis/Ticket.hs | 62 ++++++++++++------- 16 files changed, 237 insertions(+), 113 deletions(-) create mode 100644 migrations/2020_05_16_tcl.model create mode 100644 migrations/2020_05_16_tcl_mig.model diff --git a/config/models b/config/models index 676a070..8264a10 100644 --- a/config/models +++ b/config/models @@ -385,13 +385,24 @@ RemoteTicket UniqueRemoteTicketIdent ident UniqueRemoteTicketDiscuss discuss -TicketProjectLocal +TicketContextLocal ticket TicketId - project ProjectId accept OutboxItemId - UniqueTicketProjectLocal ticket - UniqueTicketProjectLocalAccept accept + UniqueTicketContextLocal ticket + UniqueTicketContextLocalAccept accept + +TicketProjectLocal + context TicketContextLocalId + project ProjectId + + UniqueTicketProjectLocal context + +TicketRepoLocal + context TicketContextLocalId + repo RepoId + + UniqueTicketRepoLocal context TicketProjectRemote ticket TicketAuthorLocalId @@ -418,7 +429,7 @@ TicketAuthorLocal UniqueTicketAuthorLocalOpen open TicketAuthorRemote - ticket TicketProjectLocalId + ticket TicketContextLocalId author RemoteActorId open RemoteActivityId @@ -426,7 +437,7 @@ TicketAuthorRemote UniqueTicketAuthorRemoteOpen open TicketUnderProject - project TicketProjectLocalId + project TicketContextLocalId author TicketAuthorLocalId UniqueTicketUnderProjectProject project diff --git a/migrations/2020_05_16_tcl.model b/migrations/2020_05_16_tcl.model new file mode 100644 index 0000000..4822321 --- /dev/null +++ b/migrations/2020_05_16_tcl.model @@ -0,0 +1,11 @@ +TicketProjectLocal + context TicketContextLocalId + project ProjectId + + UniqueTicketProjectLocal context + +TicketRepoLocal + context TicketContextLocalId + repo RepoId + + UniqueTicketRepoLocal context diff --git a/migrations/2020_05_16_tcl_mig.model b/migrations/2020_05_16_tcl_mig.model new file mode 100644 index 0000000..95f1491 --- /dev/null +++ b/migrations/2020_05_16_tcl_mig.model @@ -0,0 +1,19 @@ +Ticket + +Project + +OutboxItem + +TicketContextLocal + ticket TicketId + project ProjectId + accept OutboxItemId + + UniqueTicketContextLocal ticket + UniqueTicketContextLocalAccept accept + +TicketProjectLocal + context TicketContextLocalId + project ProjectId + + UniqueTicketProjectLocal context diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 81e56f7..9a501a1 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -343,11 +343,11 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note = runEx fromMaybeE mticket "Note context no such local sharer-hosted ticket" mproj <- case project of - Left (Entity _ tpl) -> lift $ Just <$> getProject tpl + Left (_, Entity _ tpl) -> lift $ Just <$> getProject tpl 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 (shr, prj), localTicketDiscuss lt) @@ -373,12 +373,13 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note = runEx merd <- getBy $ UniqueRemoteDiscussionIdent roid case merd of Just (Entity rdid rd) -> do - mproj <- do - mrt <- getValBy $ UniqueRemoteTicketDiscuss rdid - for mrt $ \ rt -> do - tar <- getJust $ remoteTicketTicket rt - tpl <- getJust $ ticketAuthorRemoteTicket tar - getProject tpl + mproj <- runMaybeT $ do + rt <- MaybeT $ getValBy $ UniqueRemoteTicketDiscuss rdid + tar <- lift $ getJust $ remoteTicketTicket rt + let tclid = ticketAuthorRemoteTicket tar + tpl <- + MaybeT $ getValBy $ UniqueTicketProjectLocal tclid + lift $ getProject tpl return (mproj, rd, False) Nothing -> do did <- insert Discussion @@ -627,11 +628,14 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT , ticketAuthorLocalOpen = obiidCreate } case project of - Left (_shr, Entity jid _j, obiidAccept) -> + Left (_shr, Entity jid _j, obiidAccept) -> do + tclid <- insert TicketContextLocal + { ticketContextLocalTicket = tid + , ticketContextLocalAccept = obiidAccept + } insert_ TicketProjectLocal - { ticketProjectLocalTicket = tid + { ticketProjectLocalContext = tclid , ticketProjectLocalProject = jid - , ticketProjectLocalAccept = obiidAccept } Right (Entity raid _ra, mroid) -> insert_ TicketProjectRemote @@ -836,9 +840,10 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = run Entity jid project <- MaybeT $ getBy $ UniqueProject prj sid ltid <- decodeKeyHashidM ltkhid lticket <- MaybeT $ get ltid - tpl <- - MaybeT $ getValBy $ - UniqueTicketProjectLocal $ localTicketTicket lticket + tclid <- + MaybeT $ getKeyBy $ + UniqueTicketContextLocal $ localTicketTicket lticket + tpl <- MaybeT $ getValBy $ UniqueTicketProjectLocal tclid guard $ ticketProjectLocalProject tpl == jid return (lticket, project) (lticket, project) <- fromMaybeE mproject "Follow object: No such project ticket in DB" @@ -1159,10 +1164,13 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT , localTicketDiscuss = did , localTicketFollowers = fsid } - tplid <- insert TicketProjectLocal - { ticketProjectLocalTicket = tid + tclid <- insert TicketContextLocal + { ticketContextLocalTicket = tid + , ticketContextLocalAccept = obiidAccept + } + insert_ TicketProjectLocal + { ticketProjectLocalContext = tclid , ticketProjectLocalProject = jid - , ticketProjectLocalAccept = obiidAccept } talid <- insert TicketAuthorLocal { ticketAuthorLocalTicket = ltid @@ -1170,7 +1178,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT , ticketAuthorLocalOpen = obiid } insert_ TicketUnderProject - { ticketUnderProjectProject = tplid + { ticketUnderProjectProject = tclid , ticketUnderProjectAuthor = talid } --insertMany_ $ map (TicketDependency tid) tidsDeps diff --git a/src/Vervis/ActivityPub.hs b/src/Vervis/ActivityPub.hs index 68076bb..e890b59 100644 --- a/src/Vervis/ActivityPub.hs +++ b/src/Vervis/ActivityPub.hs @@ -947,10 +947,11 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci , localRecipTicketFollowers t ] ltids <- catMaybes <$> traverse decodeKeyHashid ltkhids - E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` tpl `E.LeftOuterJoin` tup `E.LeftOuterJoin` tar) -> do - E.on $ E.just (tpl E.^. TicketProjectLocalId) E.==. tar E.?. TicketAuthorRemoteTicket - E.on $ E.just (tpl E.^. TicketProjectLocalId) E.==. tup E.?. TicketUnderProjectProject - E.on $ t E.^. TicketId E.==. tpl E.^. TicketProjectLocalTicket + E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` tcl `E.InnerJoin` tpl `E.LeftOuterJoin` tup `E.LeftOuterJoin` tar) -> do + E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tar E.?. TicketAuthorRemoteTicket + E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tup E.?. TicketUnderProjectProject + E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext + E.on $ t E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket E.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid E.&&. diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 76e7c6d..f4b80d5 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -413,11 +413,14 @@ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee = ltid <- decodeKeyHashidE numFollowee "Invalid hashid for context" mlt <- lift $ get ltid lt <- fromMaybeE mlt "Unfollow target no such local ticket" + tclid <- do + mtclid <- + lift $ getKeyBy $ + UniqueTicketContextLocal $ localTicketTicket lt + fromMaybeE mtclid "Unfollow target ticket isn't of local context" tpl <- do - mtpl <- - lift $ getValBy $ - UniqueTicketProjectLocal $ localTicketTicket lt - fromMaybeE mtpl "Unfollow target ticket isn't of local project" + mtpl <- lift $ getValBy $ UniqueTicketProjectLocal tclid + fromMaybeE mtpl "Unfollow target ticket local ctx isn't a project" unless (ticketProjectLocalProject tpl == jid) $ throwE "Hashid doesn't match sharer/project" return $ localTicketFollowers lt diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index 28758ee..0932553 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -305,7 +305,7 @@ sharerCreateNoteF now shrRecip author body 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 @@ -368,7 +368,7 @@ projectCreateNoteF now shrRecip prjRecip author body note = do mticket <- lift $ getSharerTicket shr talid fromMaybeE mticket "Context: No such sharer-ticket" case project of - Left (Entity _ tpl) + Left (_, Entity _ tpl) | ticketProjectLocalProject tpl == jid -> do mractid <- lift $ insertToInbox now author body ibid luCreate False case mractid of @@ -399,7 +399,7 @@ projectCreateNoteF now shrRecip prjRecip author body 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 diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index 84d23b3..cc04966 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -430,8 +430,10 @@ projectFollowF shr prj = mt <- for mltkhid $ \ ltkhid -> do ltid <- decodeKeyHashid404 ltkhid lt <- get404 ltid + tclid <- + getKeyBy404 $ UniqueTicketContextLocal $ localTicketTicket lt tpl <- - getValBy404 $ UniqueTicketProjectLocal $ localTicketTicket lt + getValBy404 $ UniqueTicketProjectLocal tclid unless (ticketProjectLocalProject tpl == jid) notFound return lt return (j, mt) @@ -590,7 +592,9 @@ projectUndoF shr prj = case mlt of Nothing -> return $ Just "Undo object is a RemoteFollow, but isn't under this project" Just lt -> do - mtpl <- getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt + mtpl <- runMaybeT $ do + tclid <- MaybeT $ getKeyBy $ UniqueTicketContextLocal $ localTicketTicket lt + MaybeT $ getValBy $ UniqueTicketProjectLocal tclid return $ case mtpl of Just tpl diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index 8b8eedf..3e6e654 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -310,13 +310,16 @@ projectOfferTicketF , localTicketDiscuss = did , localTicketFollowers = fsid } - tplid <- insert TicketProjectLocal - { ticketProjectLocalTicket = tid + tclid <- insert TicketContextLocal + { ticketContextLocalTicket = tid + , ticketContextLocalAccept = obiidAccept + } + insert_ TicketProjectLocal + { ticketProjectLocalContext = tclid , ticketProjectLocalProject = jid - , ticketProjectLocalAccept = obiidAccept } insert_ TicketAuthorRemote - { ticketAuthorRemoteTicket = tplid + { ticketAuthorRemoteTicket = tclid , ticketAuthorRemoteAuthor = raidAuthor , ticketAuthorRemoteOpen = ractid } @@ -689,19 +692,23 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do , ticketClosed = UTCTime (ModifiedJulianDay 0) 0 , ticketCloser = Nothing } + tclid <- insert TicketContextLocal + { ticketContextLocalTicket = tid + , ticketContextLocalAccept = obiidAccept + } tplid <- insert TicketProjectLocal - { ticketProjectLocalTicket = tid + { ticketProjectLocalContext = tclid , ticketProjectLocalProject = jid - , ticketProjectLocalAccept = obiidAccept } mtarid <- insertUnique TicketAuthorRemote - { ticketAuthorRemoteTicket = tplid + { ticketAuthorRemoteTicket = tclid , ticketAuthorRemoteAuthor = remoteAuthorId author , ticketAuthorRemoteOpen = ractidCreate } case mtarid of Nothing -> do delete tplid + delete tclid delete tid return $ Left False Just tarid -> do @@ -724,6 +731,7 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do Nothing -> do delete tarid delete tplid + delete tclid delete tid return $ Left True Just _rtid -> return $ Right () diff --git a/src/Vervis/Field/Ticket.hs b/src/Vervis/Field/Ticket.hs index fe16295..17f2d1b 100644 --- a/src/Vervis/Field/Ticket.hs +++ b/src/Vervis/Field/Ticket.hs @@ -71,8 +71,9 @@ selectTicketDep jid tid = checkDep tid $ checkNotSelf tid $ selectField $ do - ts <- runDB $ select $ from $ \ (t `InnerJoin` tpl) -> do - on $ t ^. TicketId ==. tpl ^. TicketProjectLocalTicket + ts <- runDB $ select $ from $ \ (t `InnerJoin` tcl `InnerJoin` tpl) -> do + on $ tcl ^. TicketContextLocalId ==. tpl ^. TicketProjectLocalContext + on $ t ^. TicketId ==. tcl ^. TicketContextLocalTicket where_ $ tpl ^. TicketProjectLocalProject ==. val jid &&. t ^. TicketId !=. val tid diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index 843cbf9..9b1ad41 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -26,6 +26,7 @@ where import Control.Monad import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe import Data.Maybe import Data.Time.Clock (getCurrentTime) import Database.Persist @@ -136,7 +137,9 @@ getDiscussionMessage shr lmid = do (Just _, Just _) -> fail $ "DiscussionId #" ++ show did ++ " has both ticket and remote contexts" (Just (Entity ltid lt), Nothing) -> do tpl <- do - mtpl <- getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt + mtpl <- runMaybeT $ do + tclid <- MaybeT $ getKeyBy $ UniqueTicketContextLocal $ localTicketTicket lt + MaybeT $ getValBy $ UniqueTicketProjectLocal tclid case mtpl of Nothing -> error "No TPL" Just v -> return v diff --git a/src/Vervis/Handler/Sharer.hs b/src/Vervis/Handler/Sharer.hs index 65561a3..d380e2d 100644 --- a/src/Vervis/Handler/Sharer.hs +++ b/src/Vervis/Handler/Sharer.hs @@ -150,12 +150,14 @@ getSharerFollowingR shr = do E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` + tcl `E.InnerJoin` tpl `E.InnerJoin` j `E.InnerJoin` s) -> do E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId E.on $ tpl E.^. TicketProjectLocalProject E.==. j E.^. ProjectId - E.on $ t E.^. TicketId E.==. tpl E.^. TicketProjectLocalTicket + E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext + E.on $ t E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket E.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId E.where_ $ lt E.^. LocalTicketId `E.in_` E.valList ltids return diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 01f286d..d50f8fc 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -175,20 +175,20 @@ getProjectTicketsR shr prj = selectRep $ do Entity jid _ <- getBy404 $ UniqueProject prj sid let countAllTickets = count [TicketProjectLocalProject ==. jid] selectTickets off lim = do - tids <- - map (ticketProjectLocalTicket . entityVal) <$> - selectList - [TicketProjectLocalProject ==. jid] - [ Desc TicketProjectLocalTicket - , OffsetBy off - , LimitTo lim - ] + tids <- E.select $ E.from $ \ (tcl `E.InnerJoin` tpl) -> do + E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext + E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid + E.orderBy [E.desc $ tcl E.^. TicketContextLocalTicket] + E.offset $ fromIntegral off + E.limit $ fromIntegral lim + return $ tcl E.^. TicketContextLocalTicket + let tids' = map E.unValue tids locals <- E.select $ E.from $ \ (lt `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s `E.LeftOuterJoin` tup)) -> do E.on $ tal E.?. TicketAuthorLocalId E.==. tup E.?. TicketUnderProjectAuthor E.on $ p E.?. PersonIdent E.==. s E.?. SharerId E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId E.on $ E.just (lt E.^. LocalTicketId) E.==. tal E.?. TicketAuthorLocalTicket - E.where_ $ lt E.^. LocalTicketTicket `E.in_` E.valList tids + E.where_ $ lt E.^. LocalTicketTicket `E.in_` E.valList tids' E.orderBy [E.desc $ lt E.^. LocalTicketTicket] return ( lt E.^. LocalTicketTicket @@ -198,15 +198,15 @@ getProjectTicketsR shr prj = selectRep $ do , tup E.?. TicketUnderProjectId ) ) - remotes <- E.select $ E.from $ \ (tpl `E.InnerJoin` tar `E.InnerJoin` rt `E.InnerJoin` ro `E.InnerJoin` i) -> do + remotes <- E.select $ E.from $ \ (tcl `E.InnerJoin` tar `E.InnerJoin` rt `E.InnerJoin` ro `E.InnerJoin` i) -> do E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId E.on $ rt E.^. RemoteTicketIdent E.==. ro E.^. RemoteObjectId E.on $ tar E.^. TicketAuthorRemoteId E.==. rt E.^. RemoteTicketTicket - E.on $ tpl E.^. TicketProjectLocalId E.==. tar E.^. TicketAuthorRemoteTicket - E.where_ $ tpl E.^. TicketProjectLocalTicket `E.in_` E.valList tids - E.orderBy [E.desc $ tpl E.^. TicketProjectLocalTicket] + E.on $ tcl E.^. TicketContextLocalId E.==. tar E.^. TicketAuthorRemoteTicket + E.where_ $ tcl E.^. TicketContextLocalTicket `E.in_` E.valList tids' + E.orderBy [E.desc $ tcl E.^. TicketContextLocalTicket] return - ( tpl E.^. TicketProjectLocalTicket + ( tcl E.^. TicketContextLocalTicket , ( i E.^. InstanceHost , ro E.^. RemoteObjectIdent ) @@ -298,7 +298,7 @@ getProjectTicketR shar proj ltkhid = do author, massignee, mcloser, ticket, lticket, tparams, eparams, cparams, deps, rdeps) <- runDB $ do - (Entity sid sharer, Entity jid project, Entity tid ticket, Entity _ lticket, _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 <- @@ -428,7 +428,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, _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 @@ -502,7 +502,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, _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 @@ -512,7 +512,7 @@ postProjectTicketAcceptR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html postProjectTicketAcceptR shr prj ltkhid = do succ <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _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] @@ -530,7 +530,7 @@ postProjectTicketCloseR shr prj ltkhid = do pid <- requireAuthId now <- liftIO getCurrentTime succ <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid case ticketStatus ticket of TSClosed -> return False _ -> do @@ -553,7 +553,7 @@ postProjectTicketOpenR shr prj ltkhid = do pid <- requireAuthId now <- liftIO getCurrentTime succ <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid case ticketStatus ticket of TSClosed -> do update tid @@ -573,7 +573,7 @@ postProjectTicketClaimR postProjectTicketClaimR shr prj ltkhid = do pid <- requireAuthId mmsg <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _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 $ @@ -595,7 +595,7 @@ postProjectTicketUnclaimR postProjectTicketUnclaimR shr prj ltkhid = do pid <- requireAuthId mmsg <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _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." @@ -619,7 +619,7 @@ getProjectTicketAssignR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html getProjectTicketAssignR shr prj ltkhid = do vpid <- requireAuthId - (_es, Entity jid _, Entity tid ticket, _elt, _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 @@ -636,7 +636,7 @@ postProjectTicketAssignR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html postProjectTicketAssignR shr prj ltkhid = do vpid <- requireAuthId - (_es, Entity jid _, Entity tid ticket, _elt, _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 @@ -668,7 +668,7 @@ postProjectTicketUnassignR postProjectTicketUnassignR shr prj ltkhid = do pid <- requireAuthId mmsg <- runDB $ do - (_es, _ej, Entity tid ticket, _elt, _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." @@ -694,10 +694,11 @@ getClaimRequestsPersonR :: Handler Html getClaimRequestsPersonR = do pid <- requireAuthId rqs <- runDB $ E.select $ E.from $ - \ (tcr `E.InnerJoin` ticket `E.InnerJoin` lticket `E.InnerJoin` tpl `E.InnerJoin` project `E.InnerJoin` sharer) -> do + \ (tcr `E.InnerJoin` ticket `E.InnerJoin` lticket `E.InnerJoin` tcl `E.InnerJoin` tpl `E.InnerJoin` project `E.InnerJoin` sharer) -> do E.on $ project E.^. ProjectSharer E.==. sharer E.^. SharerId E.on $ tpl E.^. TicketProjectLocalProject E.==. project E.^. ProjectId - E.on $ ticket E.^. TicketId E.==. tpl E.^. TicketProjectLocalTicket + E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext + E.on $ ticket E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket E.on $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId E.where_ $ tcr E.^. TicketClaimRequestPerson E.==. E.val pid @@ -722,13 +723,15 @@ getClaimRequestsProjectR shr prj = do \ ( tcr `E.InnerJoin` ticket `E.InnerJoin` lticket `E.InnerJoin` + tcl `E.InnerJoin` tpl `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 - E.on $ ticket E.^. TicketId E.==. tpl E.^. TicketProjectLocalTicket + E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext + E.on $ ticket E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket E.on $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid @@ -747,7 +750,7 @@ getClaimRequestsTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html getClaimRequestsTicketR shr prj ltkhid = do rqs <- runDB $ do - (_es, _ej, Entity tid _, _elt, _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 @@ -771,7 +774,7 @@ postClaimRequestsTicketR shr prj ltkhid = do now <- liftIO getCurrentTime pid <- requireAuthId runDB $ do - (_es, _ej, Entity tid _, _elt, _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 @@ -791,7 +794,7 @@ postClaimRequestsTicketR shr prj ltkhid = do selectDiscussionId :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> AppDB DiscussionId selectDiscussionId shr prj ltkhid = do - (_es, _ej, _et, Entity _ lticket, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, _et, Entity _ lticket, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid return $ localTicketDiscuss lticket getProjectTicketDiscussionR @@ -878,11 +881,12 @@ getTicketDeps forward shr prj ltkhid = do if forward then TicketDependencyParent else TicketDependencyChild to' = if forward then TicketDependencyChild else TicketDependencyParent - (_es, _ej, Entity tid _, _elt, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (_es, _ej, Entity tid _, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid fmap (map toRow) $ E.select $ E.from $ \ ( td `E.InnerJoin` t `E.InnerJoin` lt + `E.InnerJoin` tcl `E.InnerJoin` tpl `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s) `E.LeftOuterJoin` (tar `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) @@ -890,11 +894,12 @@ getTicketDeps forward shr prj ltkhid = do E.on $ ro E.?. RemoteObjectInstance E.==. i E.?. InstanceId E.on $ ra E.?. RemoteActorIdent E.==. ro E.?. RemoteObjectId E.on $ tar E.?. TicketAuthorRemoteAuthor E.==. ra E.?. RemoteActorId - E.on $ E.just (tpl E.^. TicketProjectLocalId) E.==. tar E.?. TicketAuthorRemoteTicket + E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tar E.?. TicketAuthorRemoteTicket E.on $ p E.?. PersonIdent E.==. s E.?. SharerId E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId E.on $ E.just (lt E.^. LocalTicketId) E.==. tal E.?. TicketAuthorLocalTicket - E.on $ t E.^. TicketId E.==. tpl E.^. TicketProjectLocalTicket + E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext + E.on $ t E.^. TicketId E.==. tcl E.^. TicketContextLocalTicket E.on $ t E.^. TicketId E.==. lt E.^. LocalTicketTicket E.on $ td E.^. to' E.==. t E.^. TicketId E.where_ $ td E.^. from' E.==. E.val tid @@ -951,7 +956,7 @@ getProjectTicketDepsR = getTicketDeps True postProjectTicketDepsR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html postProjectTicketDepsR shr prj ltkhid = do - (_es, Entity jid _, Entity tid _, _elt, _etpl, _author) <- runDB $ getProjectTicket404 shr prj ltkhid + (_es, Entity jid _, Entity tid _, _elt, _etcl, _etpl, _author) <- runDB $ getProjectTicket404 shr prj ltkhid ((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid case result of FormSuccess ctid -> do @@ -979,7 +984,7 @@ postProjectTicketDepsR shr prj ltkhid = do getProjectTicketDepNewR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html getProjectTicketDepNewR shr prj ltkhid = do - (_es, Entity jid _, Entity tid _, _elt, _etpl, _author) <- runDB $ getProjectTicket404 shr prj ltkhid + (_es, Entity jid _, Entity tid _, _elt, _etcl, _etpl, _author) <- runDB $ getProjectTicket404 shr prj ltkhid ((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid defaultLayout $(widgetFile "ticket/dep/new") @@ -995,12 +1000,13 @@ deleteTicketDepOldR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid LocalTicket -> Handler Html deleteTicketDepOldR shr prj pnum cnum = do runDB $ do - (_es, Entity jid _, Entity ptid _, _elt, _etpl, _author) <- getProjectTicket404 shr prj pnum + (_es, Entity jid _, Entity ptid _, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj pnum cltid <- decodeKeyHashid404 cnum clt <- get404 cltid let ctid = localTicketTicket clt - ctpl <- getValBy404 $ UniqueTicketProjectLocal ctid + ctclid <- getKeyBy404 $ UniqueTicketContextLocal ctid + ctpl <- getValBy404 $ UniqueTicketProjectLocal ctclid unless (ticketProjectLocalProject ctpl == jid) notFound Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid @@ -1053,8 +1059,13 @@ getTicketDepR tdkhid = do case mltid of Nothing -> error "No LocalTicket" Just v -> return v + tclid <- do + mtclid <- getKeyBy $ UniqueTicketContextLocal tid + case mtclid of + Nothing -> error "No TicketContextLocal" + Just v -> return v tpl <- do - mtpl <- getValBy $ UniqueTicketProjectLocal tid + mtpl <- getValBy $ UniqueTicketProjectLocal tclid case mtpl of Nothing -> error "No TicketProjectLocal" Just v -> return v @@ -1072,14 +1083,14 @@ getProjectTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFs where here = ProjectTicketParticipantsR shr prj ltkhid getFsid = do - (_es, _ej, _et, Entity _ lt, _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, _etpl, _author) <- getProjectTicket404 shr prj ltkhid + (Entity sid _, _ej, _et, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid id_ <- requireEitherAlt (getKeyBy $ UniquePersonIdent sid) @@ -1195,7 +1206,7 @@ getSharerTicketR shr talkhid = do (_, _, Entity _ t, tp) <- getSharerTicket404 shr talkhid (,,) t <$> bitraverse - (\ (Entity _ tpl) -> do + (\ (_, Entity _ tpl) -> do j <- getJust $ ticketProjectLocalProject tpl s <- getJust $ projectSharer j return (s, j) diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 037af95..08d8c66 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -1562,6 +1562,22 @@ changes hLocal ctx = insertMany_ $ map makeSender fwds -- 242 , removeField "Forwarding" "sender" + -- 243 + , renameEntity "TicketProjectLocal" "TicketContextLocal" + -- 244 + , renameUnique "TicketContextLocal" "UniqueTicketProjectLocal" "UniqueTicketContextLocal" + -- 245 + , renameUnique "TicketContextLocal" "UniqueTicketProjectLocalAccept" "UniqueTicketContextLocalAccept" + -- 246 + , addEntities model_2020_05_16 + -- 247 + , unchecked $ lift $ do + tcls <- selectList ([] :: [Filter TicketContextLocal247]) [] + let makeTPL (Entity tclid tcl) = + TicketProjectLocal247 tclid (ticketContextLocal247Project tcl) + insertMany_ $ map makeTPL tcls + -- 248 + , removeField "TicketContextLocal" "project" ] migrateDB diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index bc8037f..9bce159 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -193,6 +193,10 @@ module Vervis.Migration.Model , Forwarding241 , Forwarding241Generic (..) , ForwarderProject241Generic (..) + , model_2020_05_16 + , TicketContextLocal247 + , TicketContextLocal247Generic (..) + , TicketProjectLocal247Generic (..) ) where @@ -381,3 +385,9 @@ model_2020_05_12 = $(schema "2020_05_12_fwd_sender") makeEntitiesMigration "241" $(modelFile "migrations/2020_05_12_fwd_sender_mig.model") + +model_2020_05_16 :: [Entity SqlBackend] +model_2020_05_16 = $(schema "2020_05_16_tcl") + +makeEntitiesMigration "247" + $(modelFile "migrations/2020_05_16_tcl_mig.model") diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index 910aa05..1e196c9 100644 --- a/src/Vervis/Ticket.hs +++ b/src/Vervis/Ticket.hs @@ -68,6 +68,7 @@ getTicketSummaries mfilt morder offlim jid = do tickets <- select $ from $ \ ( t `InnerJoin` lt + `InnerJoin` tcl `InnerJoin` tpl `LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s `LeftOuterJoin` tup) `LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i) @@ -79,12 +80,13 @@ getTicketSummaries mfilt morder offlim jid = do on $ ro ?. RemoteObjectInstance ==. i ?. InstanceId on $ ra ?. RemoteActorIdent ==. ro ?. RemoteObjectId on $ tar ?. TicketAuthorRemoteAuthor ==. ra ?. RemoteActorId - on $ just (tpl ^. TicketProjectLocalId) ==. tar ?. TicketAuthorRemoteTicket + on $ just (tcl ^. TicketContextLocalId) ==. tar ?. TicketAuthorRemoteTicket on $ tal ?. TicketAuthorLocalId ==. tup ?. TicketUnderProjectAuthor on $ p ?. PersonIdent ==. s ?. SharerId on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId on $ just (lt ^. LocalTicketId) ==. tal ?. TicketAuthorLocalTicket - on $ t ^. TicketId ==. tpl ^. TicketProjectLocalTicket + on $ tcl ^. TicketContextLocalId ==. tpl ^. TicketProjectLocalContext + on $ t ^. TicketId ==. tcl ^. TicketContextLocalTicket on $ t ^. TicketId ==. lt ^. LocalTicketTicket where_ $ tpl ^. TicketProjectLocalProject ==. val jid groupBy @@ -142,16 +144,22 @@ getTicketSummaries mfilt morder offlim jid = do getTicketDepEdges :: ProjectId -> AppDB [(Int64, Int64)] getTicketDepEdges jid = fmap (map $ fromSqlKey . unValue *** fromSqlKey . unValue) $ - select $ from $ \ (t1 `InnerJoin` tpl1 `InnerJoin` td `InnerJoin` t2 `InnerJoin` tpl2) -> do - on $ t2 ^. TicketId ==. tpl2 ^. TicketProjectLocalTicket - on $ t2 ^. TicketId ==. td ^. TicketDependencyParent - on $ t1 ^. TicketId ==. td ^. TicketDependencyChild - on $ t1 ^. TicketId ==. tpl1 ^. TicketProjectLocalTicket - where_ $ - tpl1 ^. TicketProjectLocalProject ==. val jid &&. - tpl2 ^. TicketProjectLocalProject ==. val jid - orderBy [asc $ t1 ^. TicketId, asc $ t2 ^. TicketId] - return (t1 ^. TicketId, t2 ^. TicketId) + select $ from $ + \ (t1 `InnerJoin` tcl1 `InnerJoin` tpl1 `InnerJoin` + td `InnerJoin` + t2 `InnerJoin` tcl2 `InnerJoin` tpl2 + ) -> do + on $ tcl2 ^. TicketContextLocalId ==. tpl2 ^. TicketProjectLocalContext + on $ t2 ^. TicketId ==. tcl2 ^. TicketContextLocalTicket + on $ t2 ^. TicketId ==. td ^. TicketDependencyParent + on $ t1 ^. TicketId ==. td ^. TicketDependencyChild + on $ tcl1 ^. TicketContextLocalId ==. tpl1 ^. TicketProjectLocalContext + on $ t1 ^. TicketId ==. tcl1 ^. TicketContextLocalTicket + where_ $ + tpl1 ^. TicketProjectLocalProject ==. val jid &&. + tpl2 ^. TicketProjectLocalProject ==. val jid + orderBy [asc $ t1 ^. TicketId, asc $ t2 ^. TicketId] + return (t1 ^. TicketId, t2 ^. TicketId) data WorkflowFieldFilter = WorkflowFieldFilter { wffNew :: Bool @@ -431,7 +439,9 @@ getSharerTicket , Entity LocalTicket , Entity Ticket , Either - (Entity TicketProjectLocal) + ( Entity TicketContextLocal + , Entity TicketProjectLocal + ) ( Entity TicketProjectRemote , Maybe (Entity TicketProjectRemoteAccept) ) @@ -449,14 +459,15 @@ getSharerTicket shr talid = runMaybeT $ do t <- lift $ getJust tid project <- requireEitherAlt - (do mtpl <- lift $ getBy $ UniqueTicketProjectLocal tid - for mtpl $ \ etpl@(Entity tplid tpl) -> do - mtup1 <- lift $ getBy $ UniqueTicketUnderProjectProject tplid + (do mtcl <- lift $ getBy $ UniqueTicketContextLocal tid + for mtcl $ \ etcl@(Entity tclid tcl) -> do + etpl <- MaybeT $ getBy $ UniqueTicketProjectLocal tclid + mtup1 <- lift $ getBy $ UniqueTicketUnderProjectProject tclid mtup2 <- lift $ getBy $ UniqueTicketUnderProjectAuthor talid unless (isJust mtup1 == isJust mtup2) $ - error "TUP points to unrelated TAL and TPL!" + error "TUP points to unrelated TAL and TCL!" guard $ not $ isJust mtup1 - return etpl + return (etcl, etpl) ) (do mtpr <- lift $ getBy $ UniqueTicketProjectRemote talid lift $ for mtpr $ \ etpr@(Entity tprid _) -> @@ -474,7 +485,9 @@ getSharerTicket404 , Entity LocalTicket , Entity Ticket , Either - (Entity TicketProjectLocal) + ( Entity TicketContextLocal + , Entity TicketProjectLocal + ) ( Entity TicketProjectRemote , Maybe (Entity TicketProjectRemoteAccept) ) @@ -496,6 +509,7 @@ getProjectTicket , Entity Project , Entity Ticket , Entity LocalTicket + , Entity TicketContextLocal , Entity TicketProjectLocal , Either (Entity TicketAuthorLocal, Entity TicketUnderProject) @@ -508,22 +522,23 @@ getProjectTicket shr prj ltid = runMaybeT $ do lt <- MaybeT $ get ltid let tid = localTicketTicket lt t <- MaybeT $ get tid - etpl@(Entity tplid tpl) <- MaybeT $ getBy $ UniqueTicketProjectLocal tid + etcl@(Entity tclid _) <- MaybeT $ getBy $ UniqueTicketContextLocal tid + etpl@(Entity _ tpl) <- MaybeT $ getBy $ UniqueTicketProjectLocal tclid guard $ ticketProjectLocalProject tpl == jid author <- requireEitherAlt (do mtal <- lift $ getBy $ UniqueTicketAuthorLocal ltid for mtal $ \ tal@(Entity talid _) -> do - tupid1 <- MaybeT $ getKeyBy $ UniqueTicketUnderProjectProject tplid + tupid1 <- MaybeT $ getKeyBy $ UniqueTicketUnderProjectProject tclid tup@(Entity tupid2 _) <- MaybeT $ getBy $ UniqueTicketUnderProjectAuthor talid unless (tupid1 == tupid2) $ error "TAL and TPL used by different TUPs!" return (tal, tup) ) - (lift $ getBy $ UniqueTicketAuthorRemote tplid) + (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, etpl, author) + return (es, ej, Entity tid t, Entity ltid lt, etcl, etpl, author) getProjectTicket404 :: ShrIdent @@ -534,6 +549,7 @@ getProjectTicket404 , Entity Project , Entity Ticket , Entity LocalTicket + , Entity TicketContextLocal , Entity TicketProjectLocal , Either (Entity TicketAuthorLocal, Entity TicketUnderProject)