Web.ActivityPub: Move ticketContext from TicketLocal to Ticket

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.

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

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

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
+        (Ticket local attributedTo published updated context {-name-}
-                source assignedTo isResolved)
+                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
+    for_ (ticketContext ticket) $ \ (ObjURI hContext luContext) -> do
-        unless (hTarget == authority) $
+        unless (hTarget == hContext) $
-            fail "Offer target host != Ticket local host"
+            fail "Offer target host != Ticket context host"
-        unless (luTarget == ticketContext local) $
+        unless (luTarget == luContext) $
             fail "Offer target != Ticket context"
     return $ Offer ticket target