forge/Vervis
1
0
Fork 0
Code Pull requests Activity

DB: Generalize TicketProjectLocal into TicketContextLocal

Browse source 
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 2020-05-18 10:28:43 +00:00
parent 77e576ccb2
commit bb6785de75
16 changed files with 237 additions and 113 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
config/models
View file

@ -385,13 +385,24 @@ RemoteTicket
UniqueRemoteTicketIdent ident UniqueRemoteTicketIdent ident
UniqueRemoteTicketDiscuss discuss UniqueRemoteTicketDiscuss discuss
TicketProjectLocal TicketContextLocal
ticket TicketId ticket TicketId
project ProjectId
accept OutboxItemId accept OutboxItemId
UniqueTicketProjectLocal ticket UniqueTicketContextLocal ticket
UniqueTicketProjectLocalAccept accept UniqueTicketContextLocalAccept accept
TicketProjectLocal
context TicketContextLocalId
project ProjectId
UniqueTicketProjectLocal context
TicketRepoLocal
context TicketContextLocalId
repo RepoId
UniqueTicketRepoLocal context
TicketProjectRemote TicketProjectRemote
ticket TicketAuthorLocalId ticket TicketAuthorLocalId
@ -418,7 +429,7 @@ TicketAuthorLocal
UniqueTicketAuthorLocalOpen open UniqueTicketAuthorLocalOpen open
TicketAuthorRemote TicketAuthorRemote
ticket TicketProjectLocalId ticket TicketContextLocalId
author RemoteActorId author RemoteActorId
open RemoteActivityId open RemoteActivityId
@ -426,7 +437,7 @@ TicketAuthorRemote
UniqueTicketAuthorRemoteOpen open UniqueTicketAuthorRemoteOpen open
TicketUnderProject TicketUnderProject
project TicketProjectLocalId project TicketContextLocalId
author TicketAuthorLocalId author TicketAuthorLocalId
UniqueTicketUnderProjectProject project UniqueTicketUnderProjectProject project

11
migrations/2020_05_16_tcl.model Normal file
View 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
View 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

44
src/Vervis/API.hs
View file

@ -343,11 +343,11 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note = runEx
fromMaybeE mticket "Note context no such local sharer-hosted ticket" fromMaybeE mticket "Note context no such local sharer-hosted ticket"
mproj <- mproj <-
case project of case project of
Left (Entity _ tpl) -> lift $ Just <$> getProject tpl Left (_, Entity _ tpl) -> lift $ Just <$> getProject tpl
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 (shr, prj), localTicketDiscuss lt) return (Just (shr, prj), localTicketDiscuss lt)
@ -373,12 +373,13 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note = runEx
merd <- getBy $ UniqueRemoteDiscussionIdent roid merd <- getBy $ UniqueRemoteDiscussionIdent roid
case merd of case merd of
Just (Entity rdid rd) -> do Just (Entity rdid rd) -> do
mproj <- do mproj <- runMaybeT $ do
mrt <- getValBy $ UniqueRemoteTicketDiscuss rdid rt <- MaybeT $ getValBy $ UniqueRemoteTicketDiscuss rdid
for mrt $ \ rt -> do tar <- lift $ getJust $ remoteTicketTicket rt
tar <- getJust $ remoteTicketTicket rt let tclid = ticketAuthorRemoteTicket tar
tpl <- getJust $ ticketAuthorRemoteTicket tar tpl <-
getProject tpl MaybeT $ getValBy $ UniqueTicketProjectLocal tclid
lift $ getProject tpl
return (mproj, rd, False) return (mproj, rd, False)
Nothing -> do Nothing -> do
did <- insert Discussion did <- insert Discussion
@ -627,11 +628,14 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
, ticketAuthorLocalOpen = obiidCreate , ticketAuthorLocalOpen = obiidCreate
} }
case project of 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 insert_ TicketProjectLocal
{ ticketProjectLocalTicket = tid { ticketProjectLocalContext = tclid
, ticketProjectLocalProject = jid , ticketProjectLocalProject = jid
, ticketProjectLocalAccept = obiidAccept
} }
Right (Entity raid _ra, mroid) -> Right (Entity raid _ra, mroid) ->
insert_ TicketProjectRemote 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 Entity jid project <- MaybeT $ getBy $ UniqueProject prj sid
ltid <- decodeKeyHashidM ltkhid ltid <- decodeKeyHashidM ltkhid
lticket <- MaybeT $ get ltid lticket <- MaybeT $ get ltid
tpl <- tclid <-
MaybeT $ getValBy $ MaybeT $ getKeyBy $
UniqueTicketProjectLocal $ localTicketTicket lticket UniqueTicketContextLocal $ localTicketTicket lticket
tpl <- MaybeT $ getValBy $ UniqueTicketProjectLocal tclid
guard $ ticketProjectLocalProject tpl == jid guard $ ticketProjectLocalProject tpl == jid
return (lticket, project) return (lticket, project)
(lticket, project) <- fromMaybeE mproject "Follow object: No such project ticket in DB" (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 , localTicketDiscuss = did
, localTicketFollowers = fsid , localTicketFollowers = fsid
} }
tplid <- insert TicketProjectLocal tclid <- insert TicketContextLocal
{ ticketProjectLocalTicket = tid { ticketContextLocalTicket = tid
, ticketContextLocalAccept = obiidAccept
}
insert_ TicketProjectLocal
{ ticketProjectLocalContext = tclid
, ticketProjectLocalProject = jid , ticketProjectLocalProject = jid
, ticketProjectLocalAccept = obiidAccept
} }
talid <- insert TicketAuthorLocal talid <- insert TicketAuthorLocal
{ ticketAuthorLocalTicket = ltid { ticketAuthorLocalTicket = ltid
@ -1170,7 +1178,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
, ticketAuthorLocalOpen = obiid , ticketAuthorLocalOpen = obiid
} }
insert_ TicketUnderProject insert_ TicketUnderProject
{ ticketUnderProjectProject = tplid { ticketUnderProjectProject = tclid
, ticketUnderProjectAuthor = talid , ticketUnderProjectAuthor = talid
} }
--insertMany_ $ map (TicketDependency tid) tidsDeps --insertMany_ $ map (TicketDependency tid) tidsDeps

9
src/Vervis/ActivityPub.hs
View file

@ -947,10 +947,11 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
, localRecipTicketFollowers t , localRecipTicketFollowers t
] ]
ltids <- catMaybes <$> traverse decodeKeyHashid ltkhids ltids <- catMaybes <$> traverse decodeKeyHashid ltkhids
E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` tpl `E.LeftOuterJoin` tup `E.LeftOuterJoin` tar) -> do 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 (tpl E.^. TicketProjectLocalId) E.==. tar E.?. TicketAuthorRemoteTicket E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tar E.?. TicketAuthorRemoteTicket
E.on $ E.just (tpl E.^. TicketProjectLocalId) E.==. tup E.?. TicketUnderProjectProject E.on $ E.just (tcl E.^. TicketContextLocalId) E.==. tup E.?. TicketUnderProjectProject
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.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId
E.where_ $ E.where_ $
tpl E.^. TicketProjectLocalProject E.==. E.val jid E.&&. tpl E.^. TicketProjectLocalProject E.==. E.val jid E.&&.

11
src/Vervis/Client.hs
View file

@ -413,11 +413,14 @@ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee =
ltid <- decodeKeyHashidE numFollowee "Invalid hashid for context" ltid <- decodeKeyHashidE numFollowee "Invalid hashid for context"
mlt <- lift $ get ltid mlt <- lift $ get ltid
lt <- fromMaybeE mlt "Unfollow target no such local ticket" 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 tpl <- do
mtpl <- mtpl <- lift $ getValBy $ UniqueTicketProjectLocal tclid
lift $ getValBy $ fromMaybeE mtpl "Unfollow target ticket local ctx isn't a project"
UniqueTicketProjectLocal $ localTicketTicket lt
fromMaybeE mtpl "Unfollow target ticket isn't of local project"
unless (ticketProjectLocalProject tpl == jid) $ unless (ticketProjectLocalProject tpl == jid) $
throwE "Hashid doesn't match sharer/project" throwE "Hashid doesn't match sharer/project"
return $ localTicketFollowers lt return $ localTicketFollowers lt

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

@ -305,7 +305,7 @@ sharerCreateNoteF now shrRecip author body 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
@ -368,7 +368,7 @@ projectCreateNoteF now shrRecip prjRecip author body note = 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
Left (Entity _ tpl) Left (_, Entity _ tpl)
| ticketProjectLocalProject tpl == jid -> do | ticketProjectLocalProject tpl == jid -> do
mractid <- lift $ insertToInbox now author body ibid luCreate False mractid <- lift $ insertToInbox now author body ibid luCreate False
case mractid of case mractid of
@ -399,7 +399,7 @@ projectCreateNoteF now shrRecip prjRecip author body 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

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

@ -430,8 +430,10 @@ projectFollowF shr prj =
mt <- for mltkhid $ \ ltkhid -> do mt <- for mltkhid $ \ ltkhid -> do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid lt <- get404 ltid
tclid <-
getKeyBy404 $ UniqueTicketContextLocal $ localTicketTicket lt
tpl <- tpl <-
getValBy404 $ UniqueTicketProjectLocal $ localTicketTicket lt getValBy404 $ UniqueTicketProjectLocal tclid
unless (ticketProjectLocalProject tpl == jid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
return lt return lt
return (j, mt) return (j, mt)
@ -590,7 +592,9 @@ projectUndoF shr prj =
case mlt of case mlt of
Nothing -> return $ Just "Undo object is a RemoteFollow, but isn't under this project" Nothing -> return $ Just "Undo object is a RemoteFollow, but isn't under this project"
Just lt -> do Just lt -> do
mtpl <- getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt mtpl <- runMaybeT $ do
tclid <- MaybeT $ getKeyBy $ UniqueTicketContextLocal $ localTicketTicket lt
MaybeT $ getValBy $ UniqueTicketProjectLocal tclid
return $ return $
case mtpl of case mtpl of
Just tpl Just tpl

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

@ -310,13 +310,16 @@ projectOfferTicketF
, localTicketDiscuss = did , localTicketDiscuss = did
, localTicketFollowers = fsid , localTicketFollowers = fsid
} }
tplid <- insert TicketProjectLocal tclid <- insert TicketContextLocal
{ ticketProjectLocalTicket = tid { ticketContextLocalTicket = tid
, ticketContextLocalAccept = obiidAccept
}
insert_ TicketProjectLocal
{ ticketProjectLocalContext = tclid
, ticketProjectLocalProject = jid , ticketProjectLocalProject = jid
, ticketProjectLocalAccept = obiidAccept
} }
insert_ TicketAuthorRemote insert_ TicketAuthorRemote
{ ticketAuthorRemoteTicket = tplid { ticketAuthorRemoteTicket = tclid
, ticketAuthorRemoteAuthor = raidAuthor , ticketAuthorRemoteAuthor = raidAuthor
, ticketAuthorRemoteOpen = ractid , ticketAuthorRemoteOpen = ractid
} }
@ -689,19 +692,23 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0 , ticketClosed = UTCTime (ModifiedJulianDay 0) 0
, ticketCloser = Nothing , ticketCloser = Nothing
} }
tclid <- insert TicketContextLocal
{ ticketContextLocalTicket = tid
, ticketContextLocalAccept = obiidAccept
}
tplid <- insert TicketProjectLocal tplid <- insert TicketProjectLocal
{ ticketProjectLocalTicket = tid { ticketProjectLocalContext = tclid
, ticketProjectLocalProject = jid , ticketProjectLocalProject = jid
, ticketProjectLocalAccept = obiidAccept
} }
mtarid <- insertUnique TicketAuthorRemote mtarid <- insertUnique TicketAuthorRemote
{ ticketAuthorRemoteTicket = tplid { ticketAuthorRemoteTicket = tclid
, ticketAuthorRemoteAuthor = remoteAuthorId author , ticketAuthorRemoteAuthor = remoteAuthorId author
, ticketAuthorRemoteOpen = ractidCreate , ticketAuthorRemoteOpen = ractidCreate
} }
case mtarid of case mtarid of
Nothing -> do Nothing -> do
delete tplid delete tplid
delete tclid
delete tid delete tid
return $ Left False return $ Left False
Just tarid -> do Just tarid -> do
@ -724,6 +731,7 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do
Nothing -> do Nothing -> do
delete tarid delete tarid
delete tplid delete tplid
delete tclid
delete tid delete tid
return $ Left True return $ Left True
Just _rtid -> return $ Right () Just _rtid -> return $ Right ()

5
src/Vervis/Field/Ticket.hs
View file

@ -71,8 +71,9 @@ selectTicketDep jid tid =
checkDep tid $ checkDep tid $
checkNotSelf tid $ checkNotSelf tid $
selectField $ do selectField $ do
ts <- runDB $ select $ from $ \ (t `InnerJoin` tpl) -> do ts <- runDB $ select $ from $ \ (t `InnerJoin` tcl `InnerJoin` tpl) -> do
on $ t ^. TicketId ==. tpl ^. TicketProjectLocalTicket on $ tcl ^. TicketContextLocalId ==. tpl ^. TicketProjectLocalContext
on $ t ^. TicketId ==. tcl ^. TicketContextLocalTicket
where_ $ where_ $
tpl ^. TicketProjectLocalProject ==. val jid &&. tpl ^. TicketProjectLocalProject ==. val jid &&.
t ^. TicketId !=. val tid t ^. TicketId !=. val tid

5
src/Vervis/Handler/Discussion.hs
View file

@ -26,6 +26,7 @@ where
import Control.Monad import Control.Monad
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Maybe import Data.Maybe
import Data.Time.Clock (getCurrentTime) import Data.Time.Clock (getCurrentTime)
import Database.Persist import Database.Persist
@ -136,7 +137,9 @@ getDiscussionMessage shr lmid = do
(Just _, Just _) -> fail $ "DiscussionId #" ++ show did ++ " has both ticket and remote contexts" (Just _, Just _) -> fail $ "DiscussionId #" ++ show did ++ " has both ticket and remote contexts"
(Just (Entity ltid lt), Nothing) -> do (Just (Entity ltid lt), Nothing) -> do
tpl <- do tpl <- do
mtpl <- getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt mtpl <- runMaybeT $ do
tclid <- MaybeT $ getKeyBy $ UniqueTicketContextLocal $ localTicketTicket lt
MaybeT $ getValBy $ UniqueTicketProjectLocal tclid
case mtpl of case mtpl of
Nothing -> error "No TPL" Nothing -> error "No TPL"
Just v -> return v Just v -> return v

4
src/Vervis/Handler/Sharer.hs
View file

@ -150,12 +150,14 @@ getSharerFollowingR shr = do
E.select $ E.from $ E.select $ E.from $
\ (lt `E.InnerJoin` \ (lt `E.InnerJoin`
t `E.InnerJoin` t `E.InnerJoin`
tcl `E.InnerJoin`
tpl `E.InnerJoin` tpl `E.InnerJoin`
j `E.InnerJoin` j `E.InnerJoin`
s) -> do s) -> do
E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId
E.on $ tpl E.^. TicketProjectLocalProject E.==. j E.^. ProjectId 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.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId
E.where_ $ lt E.^. LocalTicketId `E.in_` E.valList ltids E.where_ $ lt E.^. LocalTicketId `E.in_` E.valList ltids
return return

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

@ -175,20 +175,20 @@ getProjectTicketsR shr prj = selectRep $ do
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
let countAllTickets = count [TicketProjectLocalProject ==. jid] let countAllTickets = count [TicketProjectLocalProject ==. jid]
selectTickets off lim = do selectTickets off lim = do
tids <- tids <- E.select $ E.from $ \ (tcl `E.InnerJoin` tpl) -> do
map (ticketProjectLocalTicket . entityVal) <$> E.on $ tcl E.^. TicketContextLocalId E.==. tpl E.^. TicketProjectLocalContext
selectList E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid
[TicketProjectLocalProject ==. jid] E.orderBy [E.desc $ tcl E.^. TicketContextLocalTicket]
[ Desc TicketProjectLocalTicket E.offset $ fromIntegral off
, OffsetBy off E.limit $ fromIntegral lim
, LimitTo 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 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 $ tal E.?. TicketAuthorLocalId E.==. tup E.?. TicketUnderProjectAuthor
E.on $ p E.?. PersonIdent E.==. s E.?. SharerId E.on $ p E.?. PersonIdent E.==. s E.?. SharerId
E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId
E.on $ E.just (lt E.^. LocalTicketId) E.==. tal E.?. TicketAuthorLocalTicket 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] E.orderBy [E.desc $ lt E.^. LocalTicketTicket]
return return
( lt E.^. LocalTicketTicket ( lt E.^. LocalTicketTicket
@ -198,15 +198,15 @@ getProjectTicketsR shr prj = selectRep $ do
, tup E.?. TicketUnderProjectId , 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 $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
E.on $ rt E.^. RemoteTicketIdent E.==. ro E.^. RemoteObjectId E.on $ rt E.^. RemoteTicketIdent E.==. ro E.^. RemoteObjectId
E.on $ tar E.^. TicketAuthorRemoteId E.==. rt E.^. RemoteTicketTicket E.on $ tar E.^. TicketAuthorRemoteId E.==. rt E.^. RemoteTicketTicket
E.on $ tpl E.^. TicketProjectLocalId E.==. tar E.^. TicketAuthorRemoteTicket E.on $ tcl E.^. TicketContextLocalId E.==. tar E.^. TicketAuthorRemoteTicket
E.where_ $ tpl E.^. TicketProjectLocalTicket `E.in_` E.valList tids E.where_ $ tcl E.^. TicketContextLocalTicket `E.in_` E.valList tids'
E.orderBy [E.desc $ tpl E.^. TicketProjectLocalTicket] E.orderBy [E.desc $ tcl E.^. TicketContextLocalTicket]
return return
( tpl E.^. TicketProjectLocalTicket ( tcl E.^. TicketContextLocalTicket
, ( i E.^. InstanceHost , ( i E.^. InstanceHost
, ro E.^. RemoteObjectIdent , ro E.^. RemoteObjectIdent
) )
@ -298,7 +298,7 @@ getProjectTicketR shar proj ltkhid = do
author, massignee, mcloser, ticket, lticket, tparams, eparams, cparams, author, massignee, mcloser, ticket, lticket, tparams, eparams, cparams,
deps, rdeps) <- deps, rdeps) <-
runDB $ do 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 (wshr, wid, wfl) <- do
w <- get404 $ projectWorkflow project w <- get404 $ projectWorkflow project
wsharer <- wsharer <-
@ -428,7 +428,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, _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
@ -502,7 +502,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, _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
@ -512,7 +512,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, _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]
@ -530,7 +530,7 @@ postProjectTicketCloseR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
succ <- runDB $ 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 case ticketStatus ticket of
TSClosed -> return False TSClosed -> return False
_ -> do _ -> do
@ -553,7 +553,7 @@ postProjectTicketOpenR shr prj ltkhid = do
pid <- requireAuthId pid <- requireAuthId
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
succ <- runDB $ 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 case ticketStatus ticket of
TSClosed -> do TSClosed -> do
update tid update tid
@ -573,7 +573,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, _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 $
@ -595,7 +595,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, _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."
@ -619,7 +619,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, _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
@ -636,7 +636,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, _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
@ -668,7 +668,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, _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."
@ -694,10 +694,11 @@ getClaimRequestsPersonR :: Handler Html
getClaimRequestsPersonR = do getClaimRequestsPersonR = do
pid <- requireAuthId pid <- requireAuthId
rqs <- runDB $ E.select $ E.from $ 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 $ project E.^. ProjectSharer E.==. sharer E.^. SharerId
E.on $ tpl E.^. TicketProjectLocalProject E.==. project E.^. ProjectId 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 $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket
E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
E.where_ $ tcr E.^. TicketClaimRequestPerson E.==. E.val pid E.where_ $ tcr E.^. TicketClaimRequestPerson E.==. E.val pid
@ -722,13 +723,15 @@ getClaimRequestsProjectR shr prj = do
\ ( tcr `E.InnerJoin` \ ( tcr `E.InnerJoin`
ticket `E.InnerJoin` ticket `E.InnerJoin`
lticket `E.InnerJoin` lticket `E.InnerJoin`
tcl `E.InnerJoin`
tpl `E.InnerJoin` tpl `E.InnerJoin`
person `E.InnerJoin` person `E.InnerJoin`
sharer sharer
) -> do ) -> 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
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 $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket
E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid
@ -747,7 +750,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, _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
@ -771,7 +774,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, _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
@ -791,7 +794,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, _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
@ -878,11 +881,12 @@ getTicketDeps forward shr prj ltkhid = do
if forward then TicketDependencyParent else TicketDependencyChild if forward then TicketDependencyParent else TicketDependencyChild
to' = to' =
if forward then TicketDependencyChild else TicketDependencyParent 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 $ fmap (map toRow) $ E.select $ E.from $
\ ( td \ ( td
`E.InnerJoin` t `E.InnerJoin` t
`E.InnerJoin` lt `E.InnerJoin` lt
`E.InnerJoin` tcl
`E.InnerJoin` tpl `E.InnerJoin` tpl
`E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s) `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s)
`E.LeftOuterJoin` (tar `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) `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 $ ro E.?. RemoteObjectInstance E.==. i E.?. InstanceId
E.on $ ra E.?. RemoteActorIdent E.==. ro E.?. RemoteObjectId E.on $ ra E.?. RemoteActorIdent E.==. ro E.?. RemoteObjectId
E.on $ tar E.?. TicketAuthorRemoteAuthor E.==. ra E.?. RemoteActorId 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 $ p E.?. PersonIdent E.==. s E.?. SharerId
E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId
E.on $ E.just (lt E.^. LocalTicketId) E.==. tal E.?. TicketAuthorLocalTicket 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 $ t E.^. TicketId E.==. lt E.^. LocalTicketTicket
E.on $ td E.^. to' E.==. t E.^. TicketId E.on $ td E.^. to' E.==. t E.^. TicketId
E.where_ $ td E.^. from' E.==. E.val tid E.where_ $ td E.^. from' E.==. E.val tid
@ -951,7 +956,7 @@ getProjectTicketDepsR = getTicketDeps True
postProjectTicketDepsR postProjectTicketDepsR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postProjectTicketDepsR shr prj ltkhid = do 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 ((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
case result of case result of
FormSuccess ctid -> do FormSuccess ctid -> do
@ -979,7 +984,7 @@ postProjectTicketDepsR shr prj ltkhid = do
getProjectTicketDepNewR getProjectTicketDepNewR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getProjectTicketDepNewR shr prj ltkhid = do 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 ((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
defaultLayout $(widgetFile "ticket/dep/new") defaultLayout $(widgetFile "ticket/dep/new")
@ -995,12 +1000,13 @@ deleteTicketDepOldR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid LocalTicket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid LocalTicket -> Handler Html
deleteTicketDepOldR shr prj pnum cnum = do deleteTicketDepOldR shr prj pnum cnum = do
runDB $ 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 cltid <- decodeKeyHashid404 cnum
clt <- get404 cltid clt <- get404 cltid
let ctid = localTicketTicket clt let ctid = localTicketTicket clt
ctpl <- getValBy404 $ UniqueTicketProjectLocal ctid ctclid <- getKeyBy404 $ UniqueTicketContextLocal ctid
ctpl <- getValBy404 $ UniqueTicketProjectLocal ctclid
unless (ticketProjectLocalProject ctpl == jid) notFound unless (ticketProjectLocalProject ctpl == jid) notFound
Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid
@ -1053,8 +1059,13 @@ getTicketDepR tdkhid = do
case mltid of case mltid of
Nothing -> error "No LocalTicket" Nothing -> error "No LocalTicket"
Just v -> return v Just v -> return v
tclid <- do
mtclid <- getKeyBy $ UniqueTicketContextLocal tid
case mtclid of
Nothing -> error "No TicketContextLocal"
Just v -> return v
tpl <- do tpl <- do
mtpl <- getValBy $ UniqueTicketProjectLocal tid mtpl <- getValBy $ UniqueTicketProjectLocal tclid
case mtpl of case mtpl of
Nothing -> error "No TicketProjectLocal" Nothing -> error "No TicketProjectLocal"
Just v -> return v Just v -> return v
@ -1072,14 +1083,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, _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, _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)
@ -1195,7 +1206,7 @@ getSharerTicketR shr talkhid = do
(_, _, Entity _ t, tp) <- getSharerTicket404 shr talkhid (_, _, Entity _ t, tp) <- getSharerTicket404 shr talkhid
(,,) t (,,) t
<$> bitraverse <$> bitraverse
(\ (Entity _ tpl) -> do (\ (_, Entity _ tpl) -> do
j <- getJust $ ticketProjectLocalProject tpl j <- getJust $ ticketProjectLocalProject tpl
s <- getJust $ projectSharer j s <- getJust $ projectSharer j
return (s, j) return (s, j)

16
src/Vervis/Migration.hs
View file

@ -1562,6 +1562,22 @@ changes hLocal ctx =
insertMany_ $ map makeSender fwds insertMany_ $ map makeSender fwds
-- 242 -- 242
, removeField "Forwarding" "sender" , 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 migrateDB

10
src/Vervis/Migration/Model.hs
View file

@ -193,6 +193,10 @@ module Vervis.Migration.Model
, Forwarding241 , Forwarding241
, Forwarding241Generic (..) , Forwarding241Generic (..)
, ForwarderProject241Generic (..) , ForwarderProject241Generic (..)
, model_2020_05_16
, TicketContextLocal247
, TicketContextLocal247Generic (..)
, TicketProjectLocal247Generic (..)
) )
where where
@ -381,3 +385,9 @@ model_2020_05_12 = $(schema "2020_05_12_fwd_sender")
makeEntitiesMigration "241" makeEntitiesMigration "241"
$(modelFile "migrations/2020_05_12_fwd_sender_mig.model") $(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")

48
src/Vervis/Ticket.hs
View file

@ -68,6 +68,7 @@ getTicketSummaries mfilt morder offlim jid = do
tickets <- select $ from $ tickets <- select $ from $
\ ( t \ ( t
`InnerJoin` lt `InnerJoin` lt
`InnerJoin` tcl
`InnerJoin` tpl `InnerJoin` tpl
`LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s `LeftOuterJoin` tup) `LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s `LeftOuterJoin` tup)
`LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i) `LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i)
@ -79,12 +80,13 @@ getTicketSummaries mfilt morder offlim jid = do
on $ ro ?. RemoteObjectInstance ==. i ?. InstanceId on $ ro ?. RemoteObjectInstance ==. i ?. InstanceId
on $ ra ?. RemoteActorIdent ==. ro ?. RemoteObjectId on $ ra ?. RemoteActorIdent ==. ro ?. RemoteObjectId
on $ tar ?. TicketAuthorRemoteAuthor ==. ra ?. RemoteActorId on $ tar ?. TicketAuthorRemoteAuthor ==. ra ?. RemoteActorId
on $ just (tpl ^. TicketProjectLocalId) ==. tar ?. TicketAuthorRemoteTicket on $ just (tcl ^. TicketContextLocalId) ==. tar ?. TicketAuthorRemoteTicket
on $ tal ?. TicketAuthorLocalId ==. tup ?. TicketUnderProjectAuthor on $ tal ?. TicketAuthorLocalId ==. tup ?. TicketUnderProjectAuthor
on $ p ?. PersonIdent ==. s ?. SharerId on $ p ?. PersonIdent ==. s ?. SharerId
on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId
on $ just (lt ^. LocalTicketId) ==. tal ?. TicketAuthorLocalTicket 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 on $ t ^. TicketId ==. lt ^. LocalTicketTicket
where_ $ tpl ^. TicketProjectLocalProject ==. val jid where_ $ tpl ^. TicketProjectLocalProject ==. val jid
groupBy groupBy
@ -142,11 +144,17 @@ getTicketSummaries mfilt morder offlim jid = do
getTicketDepEdges :: ProjectId -> AppDB [(Int64, Int64)] getTicketDepEdges :: ProjectId -> AppDB [(Int64, Int64)]
getTicketDepEdges jid = getTicketDepEdges jid =
fmap (map $ fromSqlKey . unValue *** fromSqlKey . unValue) $ fmap (map $ fromSqlKey . unValue *** fromSqlKey . unValue) $
select $ from $ \ (t1 `InnerJoin` tpl1 `InnerJoin` td `InnerJoin` t2 `InnerJoin` tpl2) -> do select $ from $
on $ t2 ^. TicketId ==. tpl2 ^. TicketProjectLocalTicket \ (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 $ t2 ^. TicketId ==. td ^. TicketDependencyParent
on $ t1 ^. TicketId ==. td ^. TicketDependencyChild on $ t1 ^. TicketId ==. td ^. TicketDependencyChild
on $ t1 ^. TicketId ==. tpl1 ^. TicketProjectLocalTicket on $ tcl1 ^. TicketContextLocalId ==. tpl1 ^. TicketProjectLocalContext
on $ t1 ^. TicketId ==. tcl1 ^. TicketContextLocalTicket
where_ $ where_ $
tpl1 ^. TicketProjectLocalProject ==. val jid &&. tpl1 ^. TicketProjectLocalProject ==. val jid &&.
tpl2 ^. TicketProjectLocalProject ==. val jid tpl2 ^. TicketProjectLocalProject ==. val jid
@ -431,7 +439,9 @@ getSharerTicket
, Entity LocalTicket , Entity LocalTicket
, Entity Ticket , Entity Ticket
, Either , Either
(Entity TicketProjectLocal) ( Entity TicketContextLocal
, Entity TicketProjectLocal
)
( Entity TicketProjectRemote ( Entity TicketProjectRemote
, Maybe (Entity TicketProjectRemoteAccept) , Maybe (Entity TicketProjectRemoteAccept)
) )
@ -449,14 +459,15 @@ getSharerTicket shr talid = runMaybeT $ do
t <- lift $ getJust tid t <- lift $ getJust tid
project <- project <-
requireEitherAlt requireEitherAlt
(do mtpl <- lift $ getBy $ UniqueTicketProjectLocal tid (do mtcl <- lift $ getBy $ UniqueTicketContextLocal tid
for mtpl $ \ etpl@(Entity tplid tpl) -> do for mtcl $ \ etcl@(Entity tclid tcl) -> do
mtup1 <- lift $ getBy $ UniqueTicketUnderProjectProject tplid etpl <- MaybeT $ getBy $ UniqueTicketProjectLocal tclid
mtup1 <- lift $ getBy $ UniqueTicketUnderProjectProject tclid
mtup2 <- lift $ getBy $ UniqueTicketUnderProjectAuthor talid mtup2 <- lift $ getBy $ UniqueTicketUnderProjectAuthor talid
unless (isJust mtup1 == isJust mtup2) $ 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 guard $ not $ isJust mtup1
return etpl return (etcl, etpl)
) )
(do mtpr <- lift $ getBy $ UniqueTicketProjectRemote talid (do mtpr <- lift $ getBy $ UniqueTicketProjectRemote talid
lift $ for mtpr $ \ etpr@(Entity tprid _) -> lift $ for mtpr $ \ etpr@(Entity tprid _) ->
@ -474,7 +485,9 @@ getSharerTicket404
, Entity LocalTicket , Entity LocalTicket
, Entity Ticket , Entity Ticket
, Either , Either
(Entity TicketProjectLocal) ( Entity TicketContextLocal
, Entity TicketProjectLocal
)
( Entity TicketProjectRemote ( Entity TicketProjectRemote
, Maybe (Entity TicketProjectRemoteAccept) , Maybe (Entity TicketProjectRemoteAccept)
) )
@ -496,6 +509,7 @@ getProjectTicket
, Entity Project , Entity Project
, Entity Ticket , Entity Ticket
, Entity LocalTicket , Entity LocalTicket
, Entity TicketContextLocal
, Entity TicketProjectLocal , Entity TicketProjectLocal
, Either , Either
(Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorLocal, Entity TicketUnderProject)
@ -508,22 +522,23 @@ getProjectTicket shr prj ltid = runMaybeT $ do
lt <- MaybeT $ get ltid lt <- MaybeT $ get ltid
let tid = localTicketTicket lt let tid = localTicketTicket lt
t <- MaybeT $ get tid 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 guard $ ticketProjectLocalProject tpl == jid
author <- author <-
requireEitherAlt requireEitherAlt
(do mtal <- lift $ getBy $ UniqueTicketAuthorLocal ltid (do mtal <- lift $ getBy $ UniqueTicketAuthorLocal ltid
for mtal $ \ tal@(Entity talid _) -> do for mtal $ \ tal@(Entity talid _) -> do
tupid1 <- MaybeT $ getKeyBy $ UniqueTicketUnderProjectProject tplid tupid1 <- MaybeT $ getKeyBy $ UniqueTicketUnderProjectProject tclid
tup@(Entity tupid2 _) <- MaybeT $ getBy $ UniqueTicketUnderProjectAuthor talid tup@(Entity tupid2 _) <- MaybeT $ getBy $ UniqueTicketUnderProjectAuthor talid
unless (tupid1 == tupid2) $ unless (tupid1 == tupid2) $
error "TAL and TPL used by different TUPs!" error "TAL and TPL used by different TUPs!"
return (tal, tup) return (tal, tup)
) )
(lift $ getBy $ UniqueTicketAuthorRemote tplid) (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, etpl, author) return (es, ej, Entity tid t, Entity ltid lt, etcl, etpl, author)
getProjectTicket404 getProjectTicket404
:: ShrIdent :: ShrIdent
@ -534,6 +549,7 @@ getProjectTicket404
, Entity Project , Entity Project
, Entity Ticket , Entity Ticket
, Entity LocalTicket , Entity LocalTicket
, Entity TicketContextLocal
, Entity TicketProjectLocal , Entity TicketProjectLocal
, Either , Either
(Entity TicketAuthorLocal, Entity TicketUnderProject) (Entity TicketAuthorLocal, Entity TicketUnderProject)