forge/Vervis
1
0
Fork 0
Code Pull requests Activity

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

4
config/models
View file

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

26
src/Vervis/API.hs
View file

@ -169,9 +169,14 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
tid <- decodeKeyHashidM tkhid
t <- MaybeT $ get tid
guard $ ticketProject t == jid
return (sid, projectInbox j, projectFollowers j, t)
(sid, ibidProject, fsidProject, t) <- fromMaybeE mt "Context: No such local ticket"
let did = ticketDiscuss t
lt <- lift $ do
mlt <- getValBy $ UniqueLocalTicket tid
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 ->
case parent of
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"
return mid
-- 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
(rd, rdnew) <- lift $ do
let ObjURI hContext luContext = uContext
@ -546,9 +551,14 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = run
tid <- decodeKeyHashidM tkhid
ticket <- MaybeT $ get tid
guard $ ticketProject ticket == jid
return (ticket, project)
(ticket, project) <- fromMaybeE mproject "Follow object: No such ticket in DB"
return (ticketFollowers ticket, projectInbox project, False, projectOutbox project)
lticket <- lift $ do
mlt <- getValBy $ UniqueLocalTicket tid
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
mrepo <- lift $ runMaybeT $ do
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
@ -858,8 +868,6 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
, ticketStatus = TSNew
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
, ticketCloser = Nothing
, ticketDiscuss = did
, ticketFollowers = fsid
, ticketAccept = obiidAccept
}
insert_ LocalTicket

5
src/Vervis/Client.hs
View file

@ -352,7 +352,10 @@ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee =
t <- fromMaybeE mt "Unfollow target no such local ticket"
unless (ticketProject t == jid) $
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
:: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)

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

@ -110,7 +110,12 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
tid <- decodeKeyHashidM tkhid
t <- MaybeT $ get tid
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"
for_ mparent $ \ parent ->
case parent of
@ -242,9 +247,11 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
for mt $ \ t -> do
unless (ticketProject t == jid) $
throwE "Context: Local ticket khid belongs to different project"
return (jid, projectInbox j, projectFollowers j, sid ,t)
(jid, ibid, fsidProject, sid, t) <- fromMaybeE mt "Context: No such local ticket"
let did = ticketDiscuss t
mlt <- lift $ getValBy $ UniqueLocalTicket tid
lt <- fromMaybeE mlt "No LocalTicket"
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 ->
case parent of
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"
return mid
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
let iidAuthor = remoteAuthorInstance author
raidAuthor = remoteAuthorId author

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

@ -390,11 +390,14 @@ projectFollowF shr prj =
tid <- decodeKeyHashid404 tkhid
t <- get404 tid
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)
followers (j, Nothing) = projectFollowers j
followers (_, Just t) = ticketFollowers t
followers (_, Just lt) = localTicketFollowers lt
repoFollowF
:: ShrIdent
@ -528,11 +531,12 @@ projectUndoF shr prj =
sid <- getKeyBy404 $ UniqueSharer shr
getBy404 $ UniqueProject prj sid
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 $
case mt of
Nothing -> Just "Undo object is a RemoteFollow, but isn't under this project"
Just t ->
if ticketProject t /= jid
then Just "Undo object is a RemoteFollow of a ticket of another project"
else Nothing

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

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

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

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

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

@ -128,12 +128,14 @@ getDiscussionMessage shr lmid = do
route2fed <- getEncodeRouteHome
uContext <- do
let did = messageRoot m
mt <- getBy $ UniqueTicketDiscussion did
mlt <- getValBy $ UniqueLocalTicketDiscussion did
mrd <- getValBy $ UniqueRemoteDiscussion did
case (mt, mrd) of
case (mlt, mrd) of
(Nothing, Nothing) -> fail $ "DiscussionId #" ++ show did ++ " has no context"
(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
s <- getJust $ projectSharer j
let shr = sharerIdent s

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

@ -145,7 +145,8 @@ getSharerFollowingR shr = do
return (s E.^. SharerIdent, j E.^. ProjectIdent)
return $ map (\ (E.Value shr, E.Value prj) -> ProjectR shr prj) pairs
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
E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId
E.on $ t E.^. TicketProject E.==. j E.^. ProjectId

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

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

8
src/Vervis/Migration.hs
View file

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

4
src/Vervis/Ticket.hs
View file

@ -53,13 +53,14 @@ getTicketSummaries
getTicketSummaries mfilt morder offlim jid = do
tickets <- select $ from $
\ ( t
`InnerJoin` lt
`LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s)
`LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i)
`InnerJoin` d
`LeftOuterJoin` m
) -> do
on $ just (d ^. DiscussionId) ==. m ?. MessageRoot
on $ t ^. TicketDiscuss ==. d ^. DiscussionId
on $ lt ^. LocalTicketDiscuss ==. d ^. DiscussionId
on $ ro ?. RemoteObjectInstance ==. i ?. InstanceId
on $ ra ?. RemoteActorIdent ==. ro ?. RemoteObjectId
on $ tar ?. TicketAuthorRemoteAuthor ==. ra ?. RemoteActorId
@ -67,6 +68,7 @@ getTicketSummaries mfilt morder offlim jid = do
on $ p ?. PersonIdent ==. s ?. SharerId
on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId
on $ just (t ^. TicketId) ==. tal ?. TicketAuthorLocalTicket
on $ t ^. TicketId ==. lt ^. LocalTicketTicket
where_ $ t ^. TicketProject ==. val jid
groupBy
( t ^. TicketId, s ?. SharerId