forge/Vervis
1
0
Fork 0
Code Pull requests Activity

DB: Remove 'project' and 'accept' from Ticket, use TicketProjectLocal instead

Browse source
This commit is contained in:
fr33domlover 2020-02-06 17:25:09 +00:00
parent 7809512117
commit ea7d806233
14 changed files with 165 additions and 94 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
config/models
View file

@ -343,7 +343,6 @@ TicketParamClass
UniqueTicketParamClass ticket field
Ticket
project ProjectId
number Int Maybe
created UTCTime
title Text -- HTML
@ -353,10 +352,8 @@ Ticket
status TicketStatus
closed UTCTime
closer PersonId Maybe
accept OutboxItemId
-- UniqueTicket project number
UniqueTicketAccept accept
LocalTicket
ticket TicketId

25
src/Vervis/API.hs
View file

@ -168,10 +168,12 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
Entity jid j <- MaybeT $ getBy $ UniqueProject prj sid
ltid <- decodeKeyHashidM ltkhid
lt <- MaybeT $ get ltid
t <- lift $ getJust $ localTicketTicket lt
guard $ ticketProject t == jid
return (sid, projectInbox j, projectFollowers j, t, lt)
(sid, ibidProject, fsidProject, _t, lt) <- fromMaybeE mt "Context: No such local ticket"
tpl <-
MaybeT $ getValBy $
UniqueTicketProjectLocal $ localTicketTicket lt
guard $ ticketProjectLocalProject tpl == jid
return (sid, projectInbox j, projectFollowers j, lt)
(sid, ibidProject, fsidProject, lt) <- fromMaybeE mt "Context: No such local ticket"
let did = localTicketDiscuss lt
mmidParent <- for mparent $ \ parent ->
case parent of
@ -546,8 +548,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
ticket <- lift $ getJust $ localTicketTicket lticket
guard $ ticketProject ticket == jid
tpl <-
MaybeT $ getValBy $
UniqueTicketProjectLocal $ localTicketTicket lticket
guard $ ticketProjectLocalProject tpl == jid
return (lticket, project)
(lticket, project) <- fromMaybeE mproject "Follow object: No such ticket in DB"
return (localTicketFollowers lticket, projectInbox project, False, projectOutbox project)
@ -849,8 +853,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
did <- insert Discussion
fsid <- insert FollowerSet
tid <- insert Ticket
{ ticketProject = jid
, ticketNumber = Nothing
{ ticketNumber = Nothing
, ticketCreated = now
, ticketTitle = unTextHtml $ AP.ticketSummary ticket
, ticketSource =
@ -860,13 +863,17 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
, ticketStatus = TSNew
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
, ticketCloser = Nothing
, ticketAccept = obiidAccept
}
ltid <- insert LocalTicket
{ localTicketTicket = tid
, localTicketDiscuss = did
, localTicketFollowers = fsid
}
insert_ TicketProjectLocal
{ ticketProjectLocalTicket = tid
, ticketProjectLocalProject = jid
, ticketProjectLocalAccept = obiidAccept
}
insert_ TicketAuthorLocal
{ ticketAuthorLocalTicket = ltid
, ticketAuthorLocalAuthor = pidAuthor

8
src/Vervis/Client.hs
View file

@ -350,8 +350,12 @@ 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"
t <- lift $ getJust $ localTicketTicket lt
unless (ticketProject t == jid) $
tpl <- do
mtpl <-
lift $ getValBy $
UniqueTicketProjectLocal $ localTicketTicket lt
fromMaybeE mtpl "Unfollow target ticket isn't of local project"
unless (ticketProjectLocalProject tpl == jid) $
throwE "Hashid doesn't match sharer/project"
return $ localTicketFollowers lt

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

@ -109,8 +109,10 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
jid <- MaybeT $ getKeyBy $ UniqueProject prj sid
ltid <- decodeKeyHashidM ltkhid
lt <- MaybeT $ get ltid
t <- lift $ getJust $ localTicketTicket lt
guard $ ticketProject t == jid
tpl <-
MaybeT $ getValBy $
UniqueTicketProjectLocal $ localTicketTicket lt
guard $ ticketProjectLocalProject tpl == jid
return $ localTicketDiscuss lt
did <- fromMaybeE mdid "Context: No such local ticket"
for_ mparent $ \ parent ->
@ -241,11 +243,12 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
ltid <- decodeKeyHashidE ltkhid "Context: Not a valid ticket khid"
mlt <- lift $ get ltid
for mlt $ \ lt -> do
t <- lift $ getJust $ localTicketTicket lt
unless (ticketProject t == jid) $
mtpl <- lift $ getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt
tpl <- fromMaybeE mtpl "No TPL"
unless (ticketProjectLocalProject tpl == jid) $
throwE "Context: Local ticket khid belongs to different project"
return (jid, projectInbox j, projectFollowers j, sid ,t, lt)
(jid, ibid, fsidProject, sid, _t, lt) <- fromMaybeE mt "Context: No such local ticket"
return (jid, projectInbox j, projectFollowers j, sid, lt)
(jid, ibid, fsidProject, sid, lt) <- fromMaybeE mt "Context: No such local ticket"
let did = localTicketDiscuss lt
meparent <- for mparent $ \ parent ->
case parent of

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

@ -389,8 +389,9 @@ projectFollowF shr prj =
mt <- for mltkhid $ \ ltkhid -> do
ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid
t <- getJust $ localTicketTicket lt
unless (ticketProject t == jid) notFound
tpl <-
getValBy404 $ UniqueTicketProjectLocal $ localTicketTicket lt
unless (ticketProjectLocalProject tpl == jid) notFound
return lt
return (j, mt)
@ -533,11 +534,12 @@ projectUndoF shr prj =
case mlt of
Nothing -> return $ Just "Undo object is a RemoteFollow, but isn't under this project"
Just lt -> do
t <- getJust $ localTicketTicket lt
mtpl <- getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt
return $
if ticketProject t /= jid
then Just "Undo object is a RemoteFollow of a ticket of another project"
else Nothing
case mtpl of
Just tpl
| ticketProjectLocalProject tpl == jid -> Nothing
_ -> Just "Undo object is a RemoteFollow of a ticket of another project"
repoUndoF
:: ShrIdent

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

@ -262,8 +262,7 @@ projectOfferTicketF
}
tid <- insert Ticket
{ ticketProject = jid
, ticketNumber = Nothing
{ ticketNumber = Nothing
, ticketCreated = now
, ticketTitle = unTextHtml $ AP.ticketSummary ticket
, ticketSource =
@ -273,13 +272,17 @@ projectOfferTicketF
, ticketStatus = TSNew
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
, ticketCloser = Nothing
, ticketAccept = obiidAccept
}
ltid <- insert LocalTicket
{ localTicketTicket = tid
, localTicketDiscuss = did
, localTicketFollowers = fsid
}
insert_ TicketProjectLocal
{ ticketProjectLocalTicket = tid
, ticketProjectLocalProject = jid
, ticketProjectLocalAccept = obiidAccept
}
insert_ TicketAuthorRemote
{ ticketAuthorRemoteTicket = tid
, ticketAuthorRemoteAuthor = raidAuthor

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

@ -20,6 +20,7 @@ module Vervis.Field.Ticket
where
import Control.Arrow ((***))
import Data.Bifunctor
import Data.Text (Text)
import Database.Esqueleto hiding ((%))
import Formatting
@ -69,6 +70,12 @@ selectTicketDep :: ProjectId -> TicketId -> Field Handler TicketId
selectTicketDep jid tid =
checkDep tid $
checkNotSelf tid $
selectField $
optionsPersistKey [TicketProject P.==. jid, TicketId P.!=. tid] [P.Asc TicketId] $
\ t -> sformat ("### :: " % stext) (ticketTitle t)
selectField $ do
ts <- runDB $ select $ from $ \ (t `InnerJoin` tpl) -> do
on $ t ^. TicketId ==. tpl ^. TicketProjectLocalTicket
where_ $
tpl ^. TicketProjectLocalProject ==. val jid &&.
t ^. TicketId !=. val tid
orderBy [asc $ t ^. TicketId]
return (t ^. TicketTitle, t ^. TicketId)
optionsPairs $ map (bimap unValue unValue) ts

4
src/Vervis/Form/Ticket.hs
View file

@ -138,8 +138,7 @@ newTicketForm wid html = do
editTicketContentAForm :: Ticket -> AForm Handler Ticket
editTicketContentAForm ticket = Ticket
<$> pure (ticketProject ticket)
<*> pure (ticketNumber ticket)
<$> pure (ticketNumber ticket)
<*> pure (ticketCreated ticket)
<*> ( sanitizeBalance <$>
areq textField "Title*" (Just $ ticketTitle ticket)
@ -157,7 +156,6 @@ editTicketContentAForm ticket = Ticket
<*> pure (ticketStatus ticket)
<*> pure (ticketClosed ticket)
<*> pure (ticketCloser ticket)
<*> pure (ticketAccept ticket)
tEditField
:: TicketTextParam

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

@ -134,9 +134,12 @@ getDiscussionMessage shr lmid = do
(Nothing, Nothing) -> fail $ "DiscussionId #" ++ show did ++ " has no context"
(Just _, Just _) -> fail $ "DiscussionId #" ++ show did ++ " has both ticket and remote contexts"
(Just (Entity ltid lt), Nothing) -> do
let tid = localTicketTicket lt
t <- getJust tid
j <- getJust $ ticketProject t
tpl <- do
mtpl <- getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt
case mtpl of
Nothing -> error "No TPL"
Just v -> return v
j <- getJust $ ticketProjectLocalProject tpl
s <- getJust $ projectSharer j
let shr = sharerIdent s
prj = projectIdent j

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

@ -146,13 +146,23 @@ getSharerFollowingR shr = do
return $ map (\ (E.Value shr, E.Value prj) -> ProjectR shr prj) pairs
getTickets fsids = do
ltids <- selectKeysList [LocalTicketFollowers <-. fsids] []
triples <- E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` j `E.InnerJoin` s) -> do
E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId
E.on $ t E.^. TicketProject E.==. j E.^. ProjectId
E.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId
E.where_ $ lt E.^. LocalTicketId `E.in_` E.valList ltids
return
(s E.^. SharerIdent, j E.^. ProjectIdent, lt E.^. LocalTicketId)
triples <-
E.select $ E.from $
\ (lt `E.InnerJoin`
t `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 $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId
E.where_ $ lt E.^. LocalTicketId `E.in_` E.valList ltids
return
( s E.^. SharerIdent
, j E.^. ProjectIdent
, lt E.^. LocalTicketId
)
encodeHid <- getEncodeKeyHashid
return $
map (\ (E.Value shr, E.Value prj, E.Value tid) -> TicketR shr prj $ encodeHid tid)

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

@ -143,7 +143,7 @@ getTicketsR shr prj = selectRep $ do
(total, pages, mpage) <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
let countAllTickets = count [TicketProject ==. jid]
let countAllTickets = count [TicketProjectLocalProject ==. jid]
selectTickets off lim =
getTicketSummaries
(filterTickets tf)
@ -160,9 +160,16 @@ getTicketsR shr prj = selectRep $ do
(total, pages, mpage) <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
let countAllTickets = count [TicketProject ==. jid]
let countAllTickets = count [TicketProjectLocalProject ==. jid]
selectTickets off lim = do
tids <- selectKeysList [TicketProject ==. jid] [Desc TicketId, OffsetBy off, LimitTo lim]
tids <-
map (ticketProjectLocalTicket . entityVal) <$>
selectList
[TicketProjectLocalProject ==. jid]
[ Desc TicketProjectLocalTicket
, OffsetBy off
, LimitTo lim
]
selectKeysList [LocalTicketTicket <-. tids] [Desc LocalTicketTicket]
getPageAndNavCount countAllTickets selectTickets
@ -253,8 +260,8 @@ getTicketR shar proj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == jid) notFound
author <-
requireEitherAlt
(do mtal <- getValBy $ UniqueTicketAuthorLocal ltid
@ -271,6 +278,7 @@ getTicketR shar proj ltkhid = do
)
"Ticket doesn't have author"
"Ticket has both local and remote author"
ticket <- get404 tid
massignee <- for (ticketAssignee ticket) $ \ apid -> do
person <- get404 apid
sharer <- get404 $ personIdent person
@ -385,7 +393,8 @@ putTicketR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == pid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == pid) notFound
return (tid, ticket, projectWorkflow project)
((result, widget), enctype) <-
runFormPost $ editTicketContentForm tid ticket wid
@ -465,7 +474,8 @@ getTicketEditR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == pid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == pid) notFound
return (tid, ticket, projectWorkflow project)
((_result, widget), enctype) <-
runFormPost $ editTicketContentForm tid ticket wid
@ -482,7 +492,8 @@ postTicketAcceptR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket
case ticketStatus ticket of
TSNew -> do
@ -508,7 +519,8 @@ postTicketCloseR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket
case ticketStatus ticket of
TSClosed -> return False
@ -539,7 +551,8 @@ postTicketOpenR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket
case ticketStatus ticket of
TSClosed -> do
@ -567,7 +580,8 @@ postTicketClaimR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket
case (ticketStatus ticket, ticketAssignee ticket) of
(TSNew, _) ->
@ -597,7 +611,8 @@ postTicketUnclaimR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket
case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
(Nothing, _) ->
@ -629,7 +644,8 @@ getTicketAssignR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == j) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == j) notFound
return (j, Entity tid ticket)
let msg t = do
setMessage t
@ -654,7 +670,8 @@ postTicketAssignR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == j) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == j) notFound
return (j, Entity tid ticket)
let msg t = do
setMessage t
@ -694,7 +711,8 @@ postTicketUnassignR shr prj ltkhid = do
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket
case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
(Nothing, _) ->
@ -721,9 +739,10 @@ getClaimRequestsPersonR :: Handler Html
getClaimRequestsPersonR = do
pid <- requireAuthId
rqs <- runDB $ E.select $ E.from $
\ (tcr `E.InnerJoin` ticket `E.InnerJoin` lticket `E.InnerJoin` project `E.InnerJoin` sharer) -> do
\ (tcr `E.InnerJoin` ticket `E.InnerJoin` lticket `E.InnerJoin` tpl `E.InnerJoin` project `E.InnerJoin` sharer) -> do
E.on $ project E.^. ProjectSharer E.==. sharer E.^. SharerId
E.on $ ticket E.^. TicketProject E.==. project E.^. ProjectId
E.on $ tpl E.^. TicketProjectLocalProject E.==. project E.^. ProjectId
E.on $ ticket E.^. TicketId E.==. tpl E.^. TicketProjectLocalTicket
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
@ -745,17 +764,19 @@ getClaimRequestsProjectR shr prj = do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
E.select $ E.from $
\ ( tcr `E.InnerJoin`
ticket `E.InnerJoin`
\ ( tcr `E.InnerJoin`
ticket `E.InnerJoin`
lticket `E.InnerJoin`
person `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 $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket
E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
E.where_ $ ticket E.^. TicketProject E.==. E.val jid
E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid
E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
return
( sharer
@ -776,8 +797,8 @@ getClaimRequestsTicketR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == jid) notFound
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
@ -807,8 +828,8 @@ postClaimRequestsTicketR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == j) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == j) notFound
return tid
let cr = TicketClaimRequest
{ ticketClaimRequestPerson = pid
@ -830,12 +851,12 @@ selectDiscussionId
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> AppDB DiscussionId
selectDiscussionId shr prj ltkhid = do
Entity sid _sharer <- getBy404 $ UniqueSharer shr
Entity pid _project <- getBy404 $ UniqueProject prj sid
Entity jid _project <- getBy404 $ UniqueProject prj sid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == pid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == jid) notFound
return $ localTicketDiscuss lticket
getTicketDiscussionR
@ -927,8 +948,8 @@ getTicketDeps forward shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == jid) notFound
fmap (map toRow) $ E.select $ E.from $
\ ( td
`E.InnerJoin` t
@ -1002,8 +1023,8 @@ postTicketDepsR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == jid) notFound
return (jid, tid)
((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
case result of
@ -1038,8 +1059,8 @@ getTicketDepNewR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == jid) notFound
return (jid, tid)
((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
defaultLayout $(widgetFile "ticket/dep/new")
@ -1062,14 +1083,14 @@ deleteTicketDepOldR shr prj pnum cnum = do
pltid <- decodeKeyHashid404 pnum
plt <- get404 pltid
let ptid = localTicketTicket plt
pt <- getJust ptid
unless (ticketProject pt == jid) notFound
ptpl <- getValBy404 $ UniqueTicketProjectLocal ptid
unless (ticketProjectLocalProject ptpl == jid) notFound
cltid <- decodeKeyHashid404 cnum
clt <- get404 cltid
let ctid = localTicketTicket clt
ct <- getJust ctid
unless (ticketProject ct == jid) notFound
ctpl <- getValBy404 $ UniqueTicketProjectLocal ctid
unless (ticketProjectLocalProject ctpl == jid) notFound
Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid
delete tdid
@ -1116,13 +1137,17 @@ getTicketDepR tdkhid = do
provideHtmlAndAP tdepAP $ redirectToPrettyJSON here
where
getTicket tid = do
t <- getJust tid
ltid <- do
mltid <- getKeyBy $ UniqueLocalTicket tid
case mltid of
Nothing -> error "No LocalTicket"
Just ltid -> return ltid
j <- getJust $ ticketProject t
Just v -> return v
tpl <- do
mtpl <- getValBy $ UniqueTicketProjectLocal tid
case mtpl of
Nothing -> error "No TicketProjectLocal"
Just v -> return v
j <- getJust $ ticketProjectLocalProject tpl
s <- getJust $ projectSharer j
return (s, j, ltid)
getAuthor pid = do
@ -1141,8 +1166,8 @@ getTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFsid
ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid
let tid = localTicketTicket lt
t <- getJust tid
unless (ticketProject t == jid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == jid) notFound
return $ localTicketFollowers lt
getTicketTeamR
@ -1154,8 +1179,8 @@ getTicketTeamR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid
let tid = localTicketTicket lt
t <- getJust tid
unless (ticketProject t == jid) notFound
tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == jid) notFound
id_ <-
requireEitherAlt
(getKeyBy $ UniquePersonIdent sid)

6
src/Vervis/Migration.hs
View file

@ -1336,6 +1336,12 @@ changes hLocal ctx =
, ticketProjectLocal201Accept = ticket201Accept t
}
insertMany_ $ map makeTPL ts
-- 202
, removeField "Ticket" "project"
-- 203
, removeUnique "Ticket" "UniqueTicketAccept"
-- 204
, removeField "Ticket" "accept"
]
migrateDB

2
src/Vervis/Model.hs
View file

@ -85,10 +85,12 @@ instance PersistEntityGraph Ticket TicketDependency where
destParam = ticketDependencyChild
destField = TicketDependencyChild
{-
instance PersistEntityGraphSelect Ticket TicketDependency where
type PersistEntityGraphSelector Ticket TicketDependency = ProjectId
selectorParam _ = ticketProject
selectorField _ = TicketProject
-}
{-
instance PersistEntityGraphNumbered Ticket TicketDependency where

12
src/Vervis/Ticket.hs
View file

@ -54,6 +54,7 @@ getTicketSummaries mfilt morder offlim jid = do
tickets <- select $ from $
\ ( t
`InnerJoin` lt
`InnerJoin` tpl
`LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s)
`LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i)
`InnerJoin` d
@ -68,8 +69,9 @@ getTicketSummaries mfilt morder offlim jid = do
on $ p ?. PersonIdent ==. s ?. SharerId
on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId
on $ just (lt ^. LocalTicketId) ==. tal ?. TicketAuthorLocalTicket
on $ t ^. TicketId ==. tpl ^. TicketProjectLocalTicket
on $ t ^. TicketId ==. lt ^. LocalTicketTicket
where_ $ t ^. TicketProject ==. val jid
where_ $ tpl ^. TicketProjectLocalProject ==. val jid
groupBy
( t ^. TicketId, s ?. SharerId
, ra ?. RemoteActorId, ro ?. RemoteObjectId, i ?. InstanceId
@ -119,12 +121,14 @@ getTicketSummaries mfilt morder offlim jid = do
getTicketDepEdges :: ProjectId -> AppDB [(Int64, Int64)]
getTicketDepEdges jid =
fmap (map $ fromSqlKey . unValue *** fromSqlKey . unValue) $
select $ from $ \ (t1 `InnerJoin` td `InnerJoin` t2) -> do
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_ $
t1 ^. TicketProject ==. val jid &&.
t2 ^. TicketProject ==. val jid
tpl1 ^. TicketProjectLocalProject ==. val jid &&.
tpl2 ^. TicketProjectLocalProject ==. val jid
orderBy [asc $ t1 ^. TicketId, asc $ t2 ^. TicketId]
return (t1 ^. TicketId, t2 ^. TicketId)