diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 71eacc9..a1af941 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -347,6 +347,7 @@ postPublishR = do , ticketAttributedTo = encodeRouteLocal $ SharerR shrAuthor , ticketPublished = Nothing , ticketUpdated = Nothing + , ticketContext = Nothing -- , ticketName = Nothing , ticketSummary = TextHtml title , ticketContent = TextHtml descHtml diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index a066b21..ac5cfa1 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -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 diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 3c73a21..1354e3b 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -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