sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 01:14:51 +09:00
Code Issues Activity

Web.ActivityPub: Move ticketContext from TicketLocal to Ticket

Browse source 
This allows the context to be specified even when replies/followers/deps/etc.
aren't. This is needed for Create-ing a Ticket. Also, it allows a ticket's
context to be on a different host than where it's hosted, which is also needed
for the Create flow.
This commit is contained in:
fr33domlover 2020-02-11 14:14:52 +00:00
parent 6d25d7ec2c
commit 1a650a783f
3 changed files with 19 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
src/Vervis/Handler/Client.hs
View file

@ -347,6 +347,7 @@ postPublishR = do
, ticketAttributedTo = encodeRouteLocal $ SharerR shrAuthor
, ticketPublished = Nothing
, ticketUpdated = Nothing
, ticketContext = Nothing
-- , ticketName = Nothing
, ticketSummary = TextHtml title
, ticketContent = TextHtml descHtml

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

@ -355,8 +355,6 @@ getTicketR shar proj ltkhid = do
, AP.TicketLocal
{ AP.ticketId =
encodeRouteLocal $ TicketR shar proj ltkhid
, AP.ticketContext =
encodeRouteLocal $ ProjectR shar proj
, AP.ticketReplies =
encodeRouteLocal $ TicketDiscussionR shar proj ltkhid
, AP.ticketParticipants =
@ -380,6 +378,8 @@ getTicketR shar proj ltkhid = do
remoteObjectIdent object
, AP.ticketPublished = Just $ ticketCreated ticket
, AP.ticketUpdated = Nothing
, AP.ticketContext =
Just $ encodeRouteHome $ ProjectR shar proj
-- , AP.ticketName = Just $ "#" <> T.pack (show num)
, AP.ticketSummary = TextHtml $ ticketTitle ticket
, AP.ticketContent = TextHtml $ ticketDescription ticket
@ -1367,12 +1367,6 @@ getSharerTicketR shr talkhid = do
, AP.TicketLocal
{ AP.ticketId =
encodeRouteLocal $ SharerTicketR shr talkhid
, AP.ticketContext =
encodeRouteLocal $
case project of
Left (s, j) ->
ProjectR (sharerIdent s) (projectIdent j)
Right () -> error "No TPR yet!"
, AP.ticketReplies =
encodeRouteLocal $ SharerTicketDiscussionR shr talkhid
, AP.ticketParticipants =
@ -1390,6 +1384,12 @@ getSharerTicketR shr talkhid = do
, AP.ticketAttributedTo = encodeRouteLocal $ SharerR shr
, AP.ticketPublished = Just $ ticketCreated ticket
, AP.ticketUpdated = Nothing
, AP.ticketContext =
Just $ encodeRouteHome $
case project of
Left (s, j) ->
ProjectR (sharerIdent s) (projectIdent j)
Right () -> error "No TPR yet!"
, AP.ticketSummary = TextHtml $ ticketTitle ticket
, AP.ticketContent = TextHtml $ ticketDescription ticket
, AP.ticketSource = TextPandocMarkdown $ ticketSource ticket

21
src/Web/ActivityPub.hs
View file

@ -824,7 +824,6 @@ newtype TextPandocMarkdown = TextPandocMarkdown
data TicketLocal = TicketLocal
{ ticketId :: LocalURI
, ticketContext :: LocalURI
, ticketReplies :: LocalURI
, ticketParticipants :: LocalURI
, ticketTeam :: LocalURI
@ -838,7 +837,6 @@ parseTicketLocal o = do
mid <- o .:? "id"
case mid of
Nothing -> do
verifyNothing "context"
verifyNothing "replies"
verifyNothing "participants"
verifyNothing "team"
@ -850,7 +848,6 @@ parseTicketLocal o = do
fmap (Just . (a,)) $
TicketLocal
<$> pure id_
<*> withAuthorityO a (o .: "context")
<*> withAuthorityO a (o .: "replies")
<*> withAuthorityO a (o .: "participants")
<*> withAuthorityO a (o .: "team")
@ -865,9 +862,8 @@ parseTicketLocal o = do
encodeTicketLocal :: UriMode u => Authority u -> TicketLocal -> Series
encodeTicketLocal
a (TicketLocal id_ context replies participants team events deps rdeps)
a (TicketLocal id_ replies participants team events deps rdeps)
= "id" .= ObjURI a id_
<> "context" .= ObjURI a context
<> "replies" .= ObjURI a replies
<> "participants" .= ObjURI a participants
<> "team" .= ObjURI a team
@ -880,6 +876,7 @@ data Ticket u = Ticket
, ticketAttributedTo :: LocalURI
, ticketPublished :: Maybe UTCTime
, ticketUpdated :: Maybe UTCTime
, ticketContext :: Maybe (ObjURI u)
-- , ticketName :: Maybe Text
, ticketSummary :: TextHtml
, ticketContent :: TextHtml
@ -912,6 +909,7 @@ instance ActivityPub Ticket where
<*> pure attributedTo
<*> o .:? "published"
<*> o .:? "updated"
<*> o .:? "context"
-- <*> o .:? "name"
<*> (TextHtml . sanitizeBalance <$> o .: "summary")
<*> (TextHtml . sanitizeBalance <$> o .: "content")
@ -920,14 +918,15 @@ instance ActivityPub Ticket where
<*> o .: "isResolved"
toSeries authority
(Ticket local attributedTo published updated {-name-} summary content
source assignedTo isResolved)
(Ticket local attributedTo published updated context {-name-}
summary content source assignedTo isResolved)
= maybe mempty (uncurry encodeTicketLocal) local
<> "type" .= ("Ticket" :: Text)
<> "attributedTo" .= ObjURI authority attributedTo
<> "published" .=? published
<> "updated" .=? updated
<> "context" .=? context
-- <> "name" .=? name
<> "summary" .= summary
<> "content" .= content
@ -1132,10 +1131,10 @@ parseOffer o a luActor = do
unless (luActor == ticketAttributedTo ticket) $
fail "Offer actor != Ticket attrib"
target@(ObjURI hTarget luTarget) <- o .: "target"
for_ (ticketLocal ticket) $ \ (authority, local) -> do
unless (hTarget == authority) $
fail "Offer target host != Ticket local host"
unless (luTarget == ticketContext local) $
for_ (ticketContext ticket) $ \ (ObjURI hContext luContext) -> do
unless (hTarget == hContext) $
fail "Offer target host != Ticket context host"
unless (luTarget == luContext) $
fail "Offer target != Ticket context"
return $ Offer ticket target