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.
This commit is contained in:
fr33domlover
parent
77e576ccb2
commit
bb6785de75
16 changed files with 237 additions and 113 deletions
|
|
@ -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
|
||||
|
|
|
|||
11
migrations/2020_05_16_tcl.model
Normal file
11
migrations/2020_05_16_tcl.model
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
TicketProjectLocal
|
||||
context TicketContextLocalId
|
||||
project ProjectId
|
||||
|
||||
UniqueTicketProjectLocal context
|
||||
|
||||
TicketRepoLocal
|
||||
context TicketContextLocalId
|
||||
repo RepoId
|
||||
|
||||
UniqueTicketRepoLocal context
|
||||
19
migrations/2020_05_16_tcl_mig.model
Normal file
19
migrations/2020_05_16_tcl_mig.model
Normal file
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.&&.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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,11 +144,17 @@ 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
|
||||
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 $ t1 ^. TicketId ==. tpl1 ^. TicketProjectLocalTicket
|
||||
on $ tcl1 ^. TicketContextLocalId ==. tpl1 ^. TicketProjectLocalContext
|
||||
on $ t1 ^. TicketId ==. tcl1 ^. TicketContextLocalTicket
|
||||
where_ $
|
||||
tpl1 ^. TicketProjectLocalProject ==. val jid &&.
|
||||
tpl2 ^. TicketProjectLocalProject ==. val jid
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue