DB: Remove did and fsid from Ticket, get them from LocalTicket

Everywhere Ticket is found, a matching LocalTicket is now expected to be found
too. Ticket doesn't point at LocalTicket because there will be remote cached
tickets too. Also, ticket URLs are going to switch the khid from Ticket to
LocalTicket (much like it's already the case for MessageR).
This commit is contained in:
fr33domlover 2020-02-05 14:09:12 +00:00
parent deeac7e760
commit cd5180a1d5
12 changed files with 85 additions and 42 deletions

View file

@ -353,13 +353,9 @@ Ticket
status TicketStatus status TicketStatus
closed UTCTime closed UTCTime
closer PersonId Maybe closer PersonId Maybe
discuss DiscussionId
followers FollowerSetId
accept OutboxItemId accept OutboxItemId
-- UniqueTicket project number -- UniqueTicket project number
UniqueTicketDiscussion discuss
UniqueTicketFollowers followers
UniqueTicketAccept accept UniqueTicketAccept accept
LocalTicket LocalTicket

View file

@ -169,9 +169,14 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
tid <- decodeKeyHashidM tkhid tid <- decodeKeyHashidM tkhid
t <- MaybeT $ get tid t <- MaybeT $ get tid
guard $ ticketProject t == jid guard $ ticketProject t == jid
return (sid, projectInbox j, projectFollowers j, t) lt <- lift $ do
(sid, ibidProject, fsidProject, t) <- fromMaybeE mt "Context: No such local ticket" mlt <- getValBy $ UniqueLocalTicket tid
let did = ticketDiscuss t case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return (sid, projectInbox j, projectFollowers j, t, lt)
(sid, ibidProject, fsidProject, _t, lt) <- fromMaybeE mt "Context: No such local ticket"
let did = localTicketDiscuss lt
mmidParent <- for mparent $ \ parent -> mmidParent <- for mparent $ \ parent ->
case parent of case parent of
Left (shrParent, lmidParent) -> getLocalParentMessageId did shrParent lmidParent Left (shrParent, lmidParent) -> getLocalParentMessageId did shrParent lmidParent
@ -186,7 +191,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
throwE "Remote parent belongs to a different discussion" throwE "Remote parent belongs to a different discussion"
return mid return mid
-- lift $ insertUnique_ $ Follow pid (ticketFollowers t) False True -- lift $ insertUnique_ $ Follow pid (ticketFollowers t) False True
return (did, Left <$> mmidParent, Just (sid, ticketFollowers t, ibidProject, fsidProject)) return (did, Left <$> mmidParent, Just (sid, localTicketFollowers lt, ibidProject, fsidProject))
Nothing -> do Nothing -> do
(rd, rdnew) <- lift $ do (rd, rdnew) <- lift $ do
let ObjURI hContext luContext = uContext let ObjURI hContext luContext = uContext
@ -546,9 +551,14 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = run
tid <- decodeKeyHashidM tkhid tid <- decodeKeyHashidM tkhid
ticket <- MaybeT $ get tid ticket <- MaybeT $ get tid
guard $ ticketProject ticket == jid guard $ ticketProject ticket == jid
return (ticket, project) lticket <- lift $ do
(ticket, project) <- fromMaybeE mproject "Follow object: No such ticket in DB" mlt <- getValBy $ UniqueLocalTicket tid
return (ticketFollowers ticket, projectInbox project, False, projectOutbox project) case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return (lticket, project)
(lticket, project) <- fromMaybeE mproject "Follow object: No such ticket in DB"
return (localTicketFollowers lticket, projectInbox project, False, projectOutbox project)
getFollowee (FolloweeRepo shr rp) = do getFollowee (FolloweeRepo shr rp) = do
mrepo <- lift $ runMaybeT $ do mrepo <- lift $ runMaybeT $ do
sid <- MaybeT $ getKeyBy $ UniqueSharer shr sid <- MaybeT $ getKeyBy $ UniqueSharer shr
@ -858,8 +868,6 @@ 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
, ticketDiscuss = did
, ticketFollowers = fsid
, ticketAccept = obiidAccept , ticketAccept = obiidAccept
} }
insert_ LocalTicket insert_ LocalTicket

View file

@ -352,7 +352,10 @@ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee =
t <- fromMaybeE mt "Unfollow target no such local ticket" t <- fromMaybeE mt "Unfollow target no such local ticket"
unless (ticketProject t == jid) $ unless (ticketProject t == jid) $
throwE "Hashid doesn't match sharer/project" throwE "Hashid doesn't match sharer/project"
return $ ticketFollowers t lt <- do
mlt <- lift $ getValBy $ UniqueLocalTicket tid
fromMaybeE mlt "Unexpected, ticket doesn't have a LocalTicket!"
return $ localTicketFollowers lt
undoFollowRepo undoFollowRepo
:: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App) :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)

View file

@ -110,7 +110,12 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
tid <- decodeKeyHashidM tkhid tid <- decodeKeyHashidM tkhid
t <- MaybeT $ get tid t <- MaybeT $ get tid
guard $ ticketProject t == jid guard $ ticketProject t == jid
return $ ticketDiscuss t lt <- lift $ do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return 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 ->
case parent of case parent of
@ -242,9 +247,11 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
for mt $ \ t -> do for mt $ \ t -> do
unless (ticketProject t == jid) $ unless (ticketProject t == 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) mlt <- lift $ getValBy $ UniqueLocalTicket tid
(jid, ibid, fsidProject, sid, t) <- fromMaybeE mt "Context: No such local ticket" lt <- fromMaybeE mlt "No LocalTicket"
let did = ticketDiscuss t return (jid, projectInbox j, projectFollowers j, sid ,t, lt)
(jid, ibid, fsidProject, sid, _t, lt) <- fromMaybeE mt "Context: No such local ticket"
let did = localTicketDiscuss lt
meparent <- for mparent $ \ parent -> meparent <- for mparent $ \ parent ->
case parent of case parent of
Left (shrParent, lmidParent) -> Left <$> getLocalParentMessageId did shrParent lmidParent Left (shrParent, lmidParent) -> Left <$> getLocalParentMessageId did shrParent lmidParent
@ -260,7 +267,7 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
throwE "Remote parent belongs to a different discussion" throwE "Remote parent belongs to a different discussion"
return mid return mid
Nothing -> return $ Right p Nothing -> return $ Right p
return (sid, fsidProject, ticketFollowers t, jid, ibid, did, meparent) return (sid, fsidProject, localTicketFollowers lt, jid, ibid, did, meparent)
insertToDiscussion luCreate luNote published ibid did meparent fsid = do insertToDiscussion luCreate luNote published ibid did meparent fsid = do
let iidAuthor = remoteAuthorInstance author let iidAuthor = remoteAuthorInstance author
raidAuthor = remoteAuthorId author raidAuthor = remoteAuthorId author

View file

@ -390,11 +390,14 @@ projectFollowF shr prj =
tid <- decodeKeyHashid404 tkhid tid <- decodeKeyHashid404 tkhid
t <- get404 tid t <- get404 tid
unless (ticketProject t == jid) notFound unless (ticketProject t == jid) notFound
return t mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return (j, mt) return (j, mt)
followers (j, Nothing) = projectFollowers j followers (j, Nothing) = projectFollowers j
followers (_, Just t) = ticketFollowers t followers (_, Just lt) = localTicketFollowers lt
repoFollowF repoFollowF
:: ShrIdent :: ShrIdent
@ -528,11 +531,12 @@ projectUndoF shr prj =
sid <- getKeyBy404 $ UniqueSharer shr sid <- getKeyBy404 $ UniqueSharer shr
getBy404 $ UniqueProject prj sid getBy404 $ UniqueProject prj sid
tryTicket jid fsid = do tryTicket jid fsid = do
mt <- getValBy $ UniqueTicketFollowers fsid mlt <- getValBy $ UniqueLocalTicketFollowers fsid
case mlt of
Nothing -> return $ Just "Undo object is a RemoteFollow, but isn't under this project"
Just lt -> do
t <- getJust $ localTicketTicket lt
return $ return $
case mt of
Nothing -> Just "Undo object is a RemoteFollow, but isn't under this project"
Just t ->
if ticketProject t /= jid if ticketProject t /= jid
then Just "Undo object is a RemoteFollow of a ticket of another project" then Just "Undo object is a RemoteFollow of a ticket of another project"
else Nothing else Nothing

View file

@ -273,8 +273,6 @@ projectOfferTicketF
, ticketStatus = TSNew , ticketStatus = TSNew
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0 , ticketClosed = UTCTime (ModifiedJulianDay 0) 0
, ticketCloser = Nothing , ticketCloser = Nothing
, ticketDiscuss = did
, ticketFollowers = fsid
, ticketAccept = obiidAccept , ticketAccept = obiidAccept
} }
insert_ LocalTicket insert_ LocalTicket

View file

@ -157,8 +157,6 @@ editTicketContentAForm ticket = Ticket
<*> pure (ticketStatus ticket) <*> pure (ticketStatus ticket)
<*> pure (ticketClosed ticket) <*> pure (ticketClosed ticket)
<*> pure (ticketCloser ticket) <*> pure (ticketCloser ticket)
<*> pure (ticketDiscuss ticket)
<*> pure (ticketFollowers ticket)
<*> pure (ticketAccept ticket) <*> pure (ticketAccept ticket)
tEditField tEditField

View file

@ -128,12 +128,14 @@ getDiscussionMessage shr lmid = do
route2fed <- getEncodeRouteHome route2fed <- getEncodeRouteHome
uContext <- do uContext <- do
let did = messageRoot m let did = messageRoot m
mt <- getBy $ UniqueTicketDiscussion did mlt <- getValBy $ UniqueLocalTicketDiscussion did
mrd <- getValBy $ UniqueRemoteDiscussion did mrd <- getValBy $ UniqueRemoteDiscussion did
case (mt, mrd) of case (mlt, mrd) of
(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 tid t), Nothing) -> do (Just lt, Nothing) -> do
let tid = localTicketTicket lt
t <- getJust tid
j <- getJust $ ticketProject t j <- getJust $ ticketProject t
s <- getJust $ projectSharer j s <- getJust $ projectSharer j
let shr = sharerIdent s let shr = sharerIdent s

View file

@ -145,7 +145,8 @@ getSharerFollowingR shr = do
return (s E.^. SharerIdent, j E.^. ProjectIdent) return (s E.^. SharerIdent, j E.^. ProjectIdent)
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
tids <- selectKeysList [TicketFollowers <-. fsids] [] lts <- selectList [LocalTicketFollowers <-. fsids] []
let tids = map (localTicketTicket . entityVal) lts
triples <- E.select $ E.from $ \ (t `E.InnerJoin` j `E.InnerJoin` s) -> do triples <- E.select $ E.from $ \ (t `E.InnerJoin` j `E.InnerJoin` s) -> do
E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId
E.on $ t E.^. TicketProject E.==. j E.^. ProjectId E.on $ t E.^. TicketProject E.==. j E.^. ProjectId

View file

@ -232,7 +232,7 @@ getTicketR :: ShrIdent -> PrjIdent -> TicketKeyHashid -> Handler TypedContent
getTicketR shar proj khid = do getTicketR shar proj khid = do
mpid <- maybeAuthId mpid <- maybeAuthId
( wshr, wfl, ( wshr, wfl,
author, massignee, mcloser, ticket, tparams, eparams, cparams, author, massignee, mcloser, ticket, lticket, tparams, eparams, cparams,
deps, rdeps) <- deps, rdeps) <-
runDB $ do runDB $ do
(jid, wshr, wid, wfl) <- do (jid, wshr, wid, wfl) <- do
@ -252,6 +252,11 @@ getTicketR shar proj khid = do
tid <- decodeKeyHashid404 khid tid <- decodeKeyHashid404 khid
ticket <- get404 tid ticket <- get404 tid
unless (ticketProject ticket == jid) notFound unless (ticketProject ticket == jid) notFound
lticket <- do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
author <- author <-
requireEitherAlt requireEitherAlt
(do mtal <- getValBy $ UniqueTicketAuthorLocal tid (do mtal <- getValBy $ UniqueTicketAuthorLocal tid
@ -297,7 +302,8 @@ getTicketR shar proj khid = do
return t return t
return return
( wshr, wfl ( wshr, wfl
, author, massignee, mcloser, ticket, tparams, eparams, cparams , author, massignee, mcloser, ticket, lticket
, tparams, eparams, cparams
, deps, rdeps , deps, rdeps
) )
encodeHid <- getEncodeKeyHashid encodeHid <- getEncodeKeyHashid
@ -305,7 +311,7 @@ getTicketR shar proj khid = do
desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket
discuss = discuss =
discussionW discussionW
(return $ ticketDiscuss ticket) (return $ localTicketDiscuss lticket)
(TicketTopReplyR shar proj khid) (TicketTopReplyR shar proj khid)
(TicketReplyR shar proj khid . encodeHid) (TicketReplyR shar proj khid . encodeHid)
cRelevant <- newIdent cRelevant <- newIdent
@ -367,7 +373,7 @@ getTicketR shar proj khid = do
followW followW
(TicketFollowR shar proj khid) (TicketFollowR shar proj khid)
(TicketUnfollowR shar proj khid) (TicketUnfollowR shar proj khid)
(return $ ticketFollowers ticket) (return $ localTicketFollowers lticket)
in $(widgetFile "ticket/one") in $(widgetFile "ticket/one")
putTicketR :: ShrIdent -> PrjIdent -> TicketKeyHashid -> Handler Html putTicketR :: ShrIdent -> PrjIdent -> TicketKeyHashid -> Handler Html
@ -792,7 +798,12 @@ selectDiscussionId shar proj tkhid = do
tid <- decodeKeyHashid404 tkhid tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid ticket <- get404 tid
unless (ticketProject ticket == pid) notFound unless (ticketProject ticket == pid) notFound
return $ ticketDiscuss ticket lticket <- do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return $ localTicketDiscuss lticket
getTicketDiscussionR getTicketDiscussionR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
@ -1073,7 +1084,12 @@ getTicketParticipantsR shr prj tkhid = getFollowersCollection here getFsid
tid <- decodeKeyHashid404 tkhid tid <- decodeKeyHashid404 tkhid
t <- get404 tid t <- get404 tid
unless (ticketProject t == jid) notFound unless (ticketProject t == jid) notFound
return $ ticketFollowers t lt <- do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return $ localTicketFollowers lt
getTicketTeamR getTicketTeamR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler TypedContent :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler TypedContent

View file

@ -1244,6 +1244,14 @@ changes hLocal ctx =
, localTicket189Followers = ticket189Followers t , localTicket189Followers = ticket189Followers t
} }
insertMany_ $ map makeLT ts insertMany_ $ map makeLT ts
-- 190
, removeUnique "Ticket" "UniqueTicketDiscussion"
-- 191
, removeUnique "Ticket" "UniqueTicketFollowers"
-- 192
, removeField "Ticket" "discuss"
-- 193
, removeField "Ticket" "followers"
] ]
migrateDB migrateDB

View file

@ -53,13 +53,14 @@ getTicketSummaries
getTicketSummaries mfilt morder offlim jid = do getTicketSummaries mfilt morder offlim jid = do
tickets <- select $ from $ tickets <- select $ from $
\ ( t \ ( t
`InnerJoin` lt
`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
`LeftOuterJoin` m `LeftOuterJoin` m
) -> do ) -> do
on $ just (d ^. DiscussionId) ==. m ?. MessageRoot on $ just (d ^. DiscussionId) ==. m ?. MessageRoot
on $ t ^. TicketDiscuss ==. d ^. DiscussionId on $ lt ^. LocalTicketDiscuss ==. d ^. DiscussionId
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
@ -67,6 +68,7 @@ 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 (t ^. TicketId) ==. tal ?. TicketAuthorLocalTicket on $ just (t ^. TicketId) ==. tal ?. TicketAuthorLocalTicket
on $ t ^. TicketId ==. lt ^. LocalTicketTicket
where_ $ t ^. TicketProject ==. val jid where_ $ t ^. TicketProject ==. val jid
groupBy groupBy
( t ^. TicketId, s ?. SharerId ( t ^. TicketId, s ?. SharerId