sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 07:24:53 +09:00
Code Issues 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 UniqueTicketParamClass ticket field
Ticket Ticket
project ProjectId
number Int Maybe number Int Maybe
created UTCTime created UTCTime
title Text -- HTML title Text -- HTML
@ -353,10 +352,8 @@ Ticket
status TicketStatus status TicketStatus
closed UTCTime closed UTCTime
closer PersonId Maybe closer PersonId Maybe
accept OutboxItemId
-- UniqueTicket project number -- UniqueTicket project number
UniqueTicketAccept accept
LocalTicket LocalTicket
ticket TicketId 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 Entity jid j <- MaybeT $ getBy $ UniqueProject prj sid
ltid <- decodeKeyHashidM ltkhid ltid <- decodeKeyHashidM ltkhid
lt <- MaybeT $ get ltid lt <- MaybeT $ get ltid
t <- lift $ getJust $ localTicketTicket lt tpl <-
guard $ ticketProject t == jid MaybeT $ getValBy $
return (sid, projectInbox j, projectFollowers j, t, lt) UniqueTicketProjectLocal $ localTicketTicket lt
(sid, ibidProject, fsidProject, _t, lt) <- fromMaybeE mt "Context: No such local ticket" 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 let did = localTicketDiscuss lt
mmidParent <- for mparent $ \ parent -> mmidParent <- for mparent $ \ parent ->
case parent of 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 Entity jid project <- MaybeT $ getBy $ UniqueProject prj sid
ltid <- decodeKeyHashidM ltkhid ltid <- decodeKeyHashidM ltkhid
lticket <- MaybeT $ get ltid lticket <- MaybeT $ get ltid
ticket <- lift $ getJust $ localTicketTicket lticket tpl <-
guard $ ticketProject ticket == jid MaybeT $ getValBy $
UniqueTicketProjectLocal $ localTicketTicket lticket
guard $ ticketProjectLocalProject tpl == jid
return (lticket, project) return (lticket, project)
(lticket, project) <- fromMaybeE mproject "Follow object: No such ticket in DB" (lticket, project) <- fromMaybeE mproject "Follow object: No such ticket in DB"
return (localTicketFollowers lticket, projectInbox project, False, projectOutbox project) return (localTicketFollowers lticket, projectInbox project, False, projectOutbox project)
@ -849,8 +853,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
did <- insert Discussion did <- insert Discussion
fsid <- insert FollowerSet fsid <- insert FollowerSet
tid <- insert Ticket tid <- insert Ticket
{ ticketProject = jid { ticketNumber = Nothing
, ticketNumber = Nothing
, ticketCreated = now , ticketCreated = now
, ticketTitle = unTextHtml $ AP.ticketSummary ticket , ticketTitle = unTextHtml $ AP.ticketSummary ticket
, ticketSource = , ticketSource =
@ -860,13 +863,17 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
, ticketStatus = TSNew , ticketStatus = TSNew
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0 , ticketClosed = UTCTime (ModifiedJulianDay 0) 0
, ticketCloser = Nothing , ticketCloser = Nothing
, ticketAccept = obiidAccept
} }
ltid <- insert LocalTicket ltid <- insert LocalTicket
{ localTicketTicket = tid { localTicketTicket = tid
, localTicketDiscuss = did , localTicketDiscuss = did
, localTicketFollowers = fsid , localTicketFollowers = fsid
} }
insert_ TicketProjectLocal
{ ticketProjectLocalTicket = tid
, ticketProjectLocalProject = jid
, ticketProjectLocalAccept = obiidAccept
}
insert_ TicketAuthorLocal insert_ TicketAuthorLocal
{ ticketAuthorLocalTicket = ltid { ticketAuthorLocalTicket = ltid
, ticketAuthorLocalAuthor = pidAuthor , 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" 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"
t <- lift $ getJust $ localTicketTicket lt tpl <- do
unless (ticketProject t == jid) $ 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" throwE "Hashid doesn't match sharer/project"
return $ localTicketFollowers lt 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 jid <- MaybeT $ getKeyBy $ UniqueProject prj sid
ltid <- decodeKeyHashidM ltkhid ltid <- decodeKeyHashidM ltkhid
lt <- MaybeT $ get ltid lt <- MaybeT $ get ltid
t <- lift $ getJust $ localTicketTicket lt tpl <-
guard $ ticketProject t == jid MaybeT $ getValBy $
UniqueTicketProjectLocal $ localTicketTicket lt
guard $ ticketProjectLocalProject tpl == jid
return $ localTicketDiscuss lt return $ localTicketDiscuss lt
did <- fromMaybeE mdid "Context: No such local ticket" did <- fromMaybeE mdid "Context: No such local ticket"
for_ mparent $ \ parent -> 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" ltid <- decodeKeyHashidE ltkhid "Context: Not a valid ticket khid"
mlt <- lift $ get ltid mlt <- lift $ get ltid
for mlt $ \ lt -> do for mlt $ \ lt -> do
t <- lift $ getJust $ localTicketTicket lt mtpl <- lift $ getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt
unless (ticketProject t == jid) $ tpl <- fromMaybeE mtpl "No TPL"
unless (ticketProjectLocalProject tpl == jid) $
throwE "Context: Local ticket khid belongs to different project" throwE "Context: Local ticket khid belongs to different project"
return (jid, projectInbox j, projectFollowers j, sid ,t, lt) return (jid, projectInbox j, projectFollowers j, sid, lt)
(jid, ibid, fsidProject, sid, _t, lt) <- fromMaybeE mt "Context: No such local ticket" (jid, ibid, fsidProject, sid, lt) <- fromMaybeE mt "Context: No such local ticket"
let did = localTicketDiscuss lt let did = localTicketDiscuss lt
meparent <- for mparent $ \ parent -> meparent <- for mparent $ \ parent ->
case parent of case parent of

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

@ -389,8 +389,9 @@ 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
t <- getJust $ localTicketTicket lt tpl <-
unless (ticketProject t == jid) notFound getValBy404 $ UniqueTicketProjectLocal $ localTicketTicket lt
unless (ticketProjectLocalProject tpl == jid) notFound
return lt return lt
return (j, mt) return (j, mt)
@ -533,11 +534,12 @@ 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
t <- getJust $ localTicketTicket lt mtpl <- getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt
return $ return $
if ticketProject t /= jid case mtpl of
then Just "Undo object is a RemoteFollow of a ticket of another project" Just tpl
else Nothing | ticketProjectLocalProject tpl == jid -> Nothing
_ -> Just "Undo object is a RemoteFollow of a ticket of another project"
repoUndoF repoUndoF
:: ShrIdent :: ShrIdent

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

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

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

@ -20,6 +20,7 @@ module Vervis.Field.Ticket
where where
import Control.Arrow ((***)) import Control.Arrow ((***))
import Data.Bifunctor
import Data.Text (Text) import Data.Text (Text)
import Database.Esqueleto hiding ((%)) import Database.Esqueleto hiding ((%))
import Formatting import Formatting
@ -69,6 +70,12 @@ selectTicketDep :: ProjectId -> TicketId -> Field Handler TicketId
selectTicketDep jid tid = selectTicketDep jid tid =
checkDep tid $ checkDep tid $
checkNotSelf tid $ checkNotSelf tid $
selectField $ selectField $ do
optionsPersistKey [TicketProject P.==. jid, TicketId P.!=. tid] [P.Asc TicketId] $ ts <- runDB $ select $ from $ \ (t `InnerJoin` tpl) -> do
\ t -> sformat ("### :: " % stext) (ticketTitle t) 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 -> AForm Handler Ticket
editTicketContentAForm ticket = Ticket editTicketContentAForm ticket = Ticket
<$> pure (ticketProject ticket) <$> pure (ticketNumber ticket)
<*> pure (ticketNumber ticket)
<*> pure (ticketCreated ticket) <*> pure (ticketCreated ticket)
<*> ( sanitizeBalance <$> <*> ( sanitizeBalance <$>
areq textField "Title*" (Just $ ticketTitle ticket) areq textField "Title*" (Just $ ticketTitle ticket)
@ -157,7 +156,6 @@ editTicketContentAForm ticket = Ticket
<*> pure (ticketStatus ticket) <*> pure (ticketStatus ticket)
<*> pure (ticketClosed ticket) <*> pure (ticketClosed ticket)
<*> pure (ticketCloser ticket) <*> pure (ticketCloser ticket)
<*> pure (ticketAccept ticket)
tEditField tEditField
:: TicketTextParam :: 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" (Nothing, Nothing) -> fail $ "DiscussionId #" ++ show did ++ " has no context"
(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
let tid = localTicketTicket lt tpl <- do
t <- getJust tid mtpl <- getValBy $ UniqueTicketProjectLocal $ localTicketTicket lt
j <- getJust $ ticketProject t case mtpl of
Nothing -> error "No TPL"
Just v -> return v
j <- getJust $ ticketProjectLocalProject tpl
s <- getJust $ projectSharer j s <- getJust $ projectSharer j
let shr = sharerIdent s let shr = sharerIdent s
prj = projectIdent j 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 return $ map (\ (E.Value shr, E.Value prj) -> ProjectR shr prj) pairs
getTickets fsids = do getTickets fsids = do
ltids <- selectKeysList [LocalTicketFollowers <-. fsids] [] ltids <- selectKeysList [LocalTicketFollowers <-. fsids] []
triples <- E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` j `E.InnerJoin` s) -> do triples <-
E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId E.select $ E.from $
E.on $ t E.^. TicketProject E.==. j E.^. ProjectId \ (lt `E.InnerJoin`
E.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId t `E.InnerJoin`
E.where_ $ lt E.^. LocalTicketId `E.in_` E.valList ltids tpl `E.InnerJoin`
return j `E.InnerJoin`
(s E.^. SharerIdent, j E.^. ProjectIdent, lt E.^. LocalTicketId) 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 encodeHid <- getEncodeKeyHashid
return $ return $
map (\ (E.Value shr, E.Value prj, E.Value tid) -> TicketR shr prj $ encodeHid tid) 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 (total, pages, mpage) <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
let countAllTickets = count [TicketProject ==. jid] let countAllTickets = count [TicketProjectLocalProject ==. jid]
selectTickets off lim = selectTickets off lim =
getTicketSummaries getTicketSummaries
(filterTickets tf) (filterTickets tf)
@ -160,9 +160,16 @@ getTicketsR shr prj = selectRep $ do
(total, pages, mpage) <- runDB $ do (total, pages, mpage) <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
let countAllTickets = count [TicketProject ==. jid] let countAllTickets = count [TicketProjectLocalProject ==. jid]
selectTickets off lim = do 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] selectKeysList [LocalTicketTicket <-. tids] [Desc LocalTicketTicket]
getPageAndNavCount countAllTickets selectTickets getPageAndNavCount countAllTickets selectTickets
@ -253,8 +260,8 @@ getTicketR shar proj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject ticket == jid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
author <- author <-
requireEitherAlt requireEitherAlt
(do mtal <- getValBy $ UniqueTicketAuthorLocal ltid (do mtal <- getValBy $ UniqueTicketAuthorLocal ltid
@ -271,6 +278,7 @@ getTicketR shar proj ltkhid = do
) )
"Ticket doesn't have author" "Ticket doesn't have author"
"Ticket has both local and remote author" "Ticket has both local and remote author"
ticket <- get404 tid
massignee <- for (ticketAssignee ticket) $ \ apid -> do massignee <- for (ticketAssignee ticket) $ \ apid -> do
person <- get404 apid person <- get404 apid
sharer <- get404 $ personIdent person sharer <- get404 $ personIdent person
@ -385,7 +393,8 @@ putTicketR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == pid) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == pid) notFound
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
@ -465,7 +474,8 @@ getTicketEditR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == pid) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == pid) notFound
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
@ -482,7 +492,8 @@ postTicketAcceptR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == p) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket return $ Entity tid ticket
case ticketStatus ticket of case ticketStatus ticket of
TSNew -> do TSNew -> do
@ -508,7 +519,8 @@ postTicketCloseR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == p) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket return $ Entity tid ticket
case ticketStatus ticket of case ticketStatus ticket of
TSClosed -> return False TSClosed -> return False
@ -539,7 +551,8 @@ postTicketOpenR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == p) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket return $ Entity tid ticket
case ticketStatus ticket of case ticketStatus ticket of
TSClosed -> do TSClosed -> do
@ -567,7 +580,8 @@ postTicketClaimR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == p) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket return $ Entity tid ticket
case (ticketStatus ticket, ticketAssignee ticket) of case (ticketStatus ticket, ticketAssignee ticket) of
(TSNew, _) -> (TSNew, _) ->
@ -597,7 +611,8 @@ postTicketUnclaimR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == p) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket return $ Entity tid ticket
case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
(Nothing, _) -> (Nothing, _) ->
@ -629,7 +644,8 @@ getTicketAssignR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == j) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == j) notFound
return (j, Entity tid ticket) return (j, Entity tid ticket)
let msg t = do let msg t = do
setMessage t setMessage t
@ -654,7 +670,8 @@ postTicketAssignR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == j) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == j) notFound
return (j, Entity tid ticket) return (j, Entity tid ticket)
let msg t = do let msg t = do
setMessage t setMessage t
@ -694,7 +711,8 @@ postTicketUnassignR shr prj ltkhid = do
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid ticket <- getJust tid
unless (ticketProject ticket == p) notFound tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProjectLocalProject tpl == p) notFound
return $ Entity tid ticket return $ Entity tid ticket
case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
(Nothing, _) -> (Nothing, _) ->
@ -721,9 +739,10 @@ 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` 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 $ 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 $ 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
@ -745,17 +764,19 @@ getClaimRequestsProjectR shr prj = do
Entity sid _ <- getBy404 $ UniqueSharer shr Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
E.select $ E.from $ E.select $ E.from $
\ ( tcr `E.InnerJoin` \ ( tcr `E.InnerJoin`
ticket `E.InnerJoin` ticket `E.InnerJoin`
lticket `E.InnerJoin` lticket `E.InnerJoin`
person `E.InnerJoin` tpl `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 $ 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_ $ ticket E.^. TicketProject E.==. E.val jid E.where_ $ tpl E.^. TicketProjectLocalProject E.==. E.val jid
E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated] E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
return return
( sharer ( sharer
@ -776,8 +797,8 @@ getClaimRequestsTicketR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject ticket == jid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
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
@ -807,8 +828,8 @@ postClaimRequestsTicketR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject ticket == j) notFound unless (ticketProjectLocalProject tpl == j) notFound
return tid return tid
let cr = TicketClaimRequest let cr = TicketClaimRequest
{ ticketClaimRequestPerson = pid { ticketClaimRequestPerson = pid
@ -830,12 +851,12 @@ selectDiscussionId
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> AppDB DiscussionId :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> AppDB DiscussionId
selectDiscussionId shr prj ltkhid = do selectDiscussionId shr prj ltkhid = do
Entity sid _sharer <- getBy404 $ UniqueSharer shr Entity sid _sharer <- getBy404 $ UniqueSharer shr
Entity pid _project <- getBy404 $ UniqueProject prj sid Entity jid _project <- getBy404 $ UniqueProject prj sid
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject ticket == pid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
return $ localTicketDiscuss lticket return $ localTicketDiscuss lticket
getTicketDiscussionR getTicketDiscussionR
@ -927,8 +948,8 @@ getTicketDeps forward shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject ticket == jid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
fmap (map toRow) $ E.select $ E.from $ fmap (map toRow) $ E.select $ E.from $
\ ( td \ ( td
`E.InnerJoin` t `E.InnerJoin` t
@ -1002,8 +1023,8 @@ postTicketDepsR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject ticket == jid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
return (jid, tid) return (jid, tid)
((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid ((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
case result of case result of
@ -1038,8 +1059,8 @@ getTicketDepNewR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid lticket <- get404 ltid
let tid = localTicketTicket lticket let tid = localTicketTicket lticket
ticket <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject ticket == jid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
return (jid, tid) return (jid, tid)
((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid ((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
defaultLayout $(widgetFile "ticket/dep/new") defaultLayout $(widgetFile "ticket/dep/new")
@ -1062,14 +1083,14 @@ deleteTicketDepOldR shr prj pnum cnum = do
pltid <- decodeKeyHashid404 pnum pltid <- decodeKeyHashid404 pnum
plt <- get404 pltid plt <- get404 pltid
let ptid = localTicketTicket plt let ptid = localTicketTicket plt
pt <- getJust ptid ptpl <- getValBy404 $ UniqueTicketProjectLocal ptid
unless (ticketProject pt == jid) notFound unless (ticketProjectLocalProject ptpl == jid) notFound
cltid <- decodeKeyHashid404 cnum cltid <- decodeKeyHashid404 cnum
clt <- get404 cltid clt <- get404 cltid
let ctid = localTicketTicket clt let ctid = localTicketTicket clt
ct <- getJust ctid ctpl <- getValBy404 $ UniqueTicketProjectLocal ctid
unless (ticketProject ct == jid) notFound unless (ticketProjectLocalProject ctpl == jid) notFound
Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid
delete tdid delete tdid
@ -1116,13 +1137,17 @@ getTicketDepR tdkhid = do
provideHtmlAndAP tdepAP $ redirectToPrettyJSON here provideHtmlAndAP tdepAP $ redirectToPrettyJSON here
where where
getTicket tid = do getTicket tid = do
t <- getJust tid
ltid <- do ltid <- do
mltid <- getKeyBy $ UniqueLocalTicket tid mltid <- getKeyBy $ UniqueLocalTicket tid
case mltid of case mltid of
Nothing -> error "No LocalTicket" Nothing -> error "No LocalTicket"
Just ltid -> return ltid Just v -> return v
j <- getJust $ ticketProject t 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 s <- getJust $ projectSharer j
return (s, j, ltid) return (s, j, ltid)
getAuthor pid = do getAuthor pid = do
@ -1141,8 +1166,8 @@ getTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFsid
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid lt <- get404 ltid
let tid = localTicketTicket lt let tid = localTicketTicket lt
t <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject t == jid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
return $ localTicketFollowers lt return $ localTicketFollowers lt
getTicketTeamR getTicketTeamR
@ -1154,8 +1179,8 @@ getTicketTeamR shr prj ltkhid = do
ltid <- decodeKeyHashid404 ltkhid ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid lt <- get404 ltid
let tid = localTicketTicket lt let tid = localTicketTicket lt
t <- getJust tid tpl <- getValBy404 $ UniqueTicketProjectLocal tid
unless (ticketProject t == jid) notFound unless (ticketProjectLocalProject tpl == jid) notFound
id_ <- id_ <-
requireEitherAlt requireEitherAlt
(getKeyBy $ UniquePersonIdent sid) (getKeyBy $ UniquePersonIdent sid)

6
src/Vervis/Migration.hs
View file

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

2
src/Vervis/Model.hs
View file

@ -85,10 +85,12 @@ instance PersistEntityGraph Ticket TicketDependency where
destParam = ticketDependencyChild destParam = ticketDependencyChild
destField = TicketDependencyChild destField = TicketDependencyChild
{-
instance PersistEntityGraphSelect Ticket TicketDependency where instance PersistEntityGraphSelect Ticket TicketDependency where
type PersistEntityGraphSelector Ticket TicketDependency = ProjectId type PersistEntityGraphSelector Ticket TicketDependency = ProjectId
selectorParam _ = ticketProject selectorParam _ = ticketProject
selectorField _ = TicketProject selectorField _ = TicketProject
-}
{- {-
instance PersistEntityGraphNumbered Ticket TicketDependency where 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 $ tickets <- select $ from $
\ ( t \ ( t
`InnerJoin` lt `InnerJoin` lt
`InnerJoin` tpl
`LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s) `LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s)
`LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i) `LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i)
`InnerJoin` d `InnerJoin` d
@ -68,8 +69,9 @@ getTicketSummaries mfilt morder offlim jid = do
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 $ t ^. TicketId ==. lt ^. LocalTicketTicket on $ t ^. TicketId ==. lt ^. LocalTicketTicket
where_ $ t ^. TicketProject ==. val jid where_ $ tpl ^. TicketProjectLocalProject ==. val jid
groupBy groupBy
( t ^. TicketId, s ?. SharerId ( t ^. TicketId, s ?. SharerId
, ra ?. RemoteActorId, ro ?. RemoteObjectId, i ?. InstanceId , ra ?. RemoteActorId, ro ?. RemoteObjectId, i ?. InstanceId
@ -119,12 +121,14 @@ 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` 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 $ t2 ^. TicketId ==. td ^. TicketDependencyParent
on $ t1 ^. TicketId ==. td ^. TicketDependencyChild on $ t1 ^. TicketId ==. td ^. TicketDependencyChild
on $ t1 ^. TicketId ==. tpl1 ^. TicketProjectLocalTicket
where_ $ where_ $
t1 ^. TicketProject ==. val jid &&. tpl1 ^. TicketProjectLocalProject ==. val jid &&.
t2 ^. TicketProject ==. val jid tpl2 ^. TicketProjectLocalProject ==. val jid
orderBy [asc $ t1 ^. TicketId, asc $ t2 ^. TicketId] orderBy [asc $ t1 ^. TicketId, asc $ t2 ^. TicketId]
return (t1 ^. TicketId, t2 ^. TicketId) return (t1 ^. TicketId, t2 ^. TicketId)