Prepare for ticket dependency federation

To be honest, this is a huge patch that changes tons of stuff and probably
should have been broken up into small changes. But I already had the codebase
not building, so... just did all of this at once :P

Basically this patch does the following:

- DB migrations for ticket dependency related tables, e.g. allowing a remote
  author and a remote child
- Allowing S2S handlers to provide an async continued processing function,
  which is executed and the result then added to the debug page
- Most UI and functionality related to ticket deps is disabled, new
  implementation being added gradually via ActivityPub
- Improvements to AP tools, e.g. allow to specify multiple hosts for approved
  forwarding when sending out an activity, and allow to specify audience of
  software-authored activities using a convenient human-friendly structure
- Implementation of S2S sharerOfferDepF which creates a dependency under a
  sharer-hosted ticket/patch and sends back an Accept

src/Web/ActivityPub.hs

@@ -61,6 +61,7 @@ module Web.ActivityPub
     , CreateObject (..)
     , Create (..)
     , Follow (..)
+    , OfferObject (..)
     , Offer (..)
     , Push (..)
     , Reject (..)
@@ -84,6 +85,7 @@ module Web.ActivityPub
     , httpPostAP
     , httpPostAPBytes
     , Fetched (..)
+    , fetchAP
     , fetchAPID
     , fetchAPID'
     , fetchRecipient
@@ -91,6 +93,8 @@ module Web.ActivityPub
     , fetchUnknownKey
     , fetchKnownPersonalKey
     , fetchKnownSharedKey
+
+    , Obj (..)
     )
 where
 
@@ -733,7 +737,6 @@ data Relationship u = Relationship
     , relationshipAttributedTo :: LocalURI
     , relationshipPublished    :: Maybe UTCTime
     , relationshipUpdated      :: Maybe UTCTime
-    , relationshipSummary      :: TextHtml
     }
 
 instance ActivityPub Relationship where
@@ -755,11 +758,10 @@ instance ActivityPub Relationship where
                 <*> pure attributedTo
                 <*> o .:? "published"
                 <*> o .:? "updated"
-                <*> (TextHtml . sanitizeBalance <$> o .: "summary")
 
     toSeries authority
         (Relationship id_ typs subject property object attributedTo published
-                      updated summary)
+                      updated)
             =  "id"           .=? id_
             <> "type"         .=  ("Relationship" : typs)
             <> "subject"      .=  subject
@@ -768,7 +770,6 @@ instance ActivityPub Relationship where
             <> "attributedTo" .=  ObjURI authority attributedTo
             <> "published"    .=? published
             <> "updated"      .=? updated
-            <> "summary"      .=  summary
 
 data TicketDependency u = TicketDependency
     { ticketDepId           :: Maybe (ObjURI u)
@@ -777,7 +778,6 @@ data TicketDependency u = TicketDependency
     , ticketDepAttributedTo :: LocalURI
     , ticketDepPublished    :: Maybe UTCTime
     , ticketDepUpdated      :: Maybe UTCTime
-    , ticketDepSummary      :: TextHtml
     }
 
 instance ActivityPub TicketDependency where
@@ -799,7 +799,6 @@ instance ActivityPub TicketDependency where
             , ticketDepAttributedTo = relationshipAttributedTo rel
             , ticketDepPublished    = relationshipPublished rel
             , ticketDepUpdated      = relationshipUpdated rel
-            , ticketDepSummary      = relationshipSummary rel
             }
 
     toSeries a = toSeries a . td2rel
@@ -813,7 +812,6 @@ instance ActivityPub TicketDependency where
             , relationshipAttributedTo = ticketDepAttributedTo td
             , relationshipPublished    = ticketDepPublished td
             , relationshipUpdated      = ticketDepUpdated td
-            , relationshipSummary      = ticketDepSummary td
             }
 
 newtype TextHtml = TextHtml
@@ -893,6 +891,7 @@ parseTicketLocal o = do
         Nothing -> do
             verifyNothing "replies"
             verifyNothing "participants"
+            verifyNothing "followers"
             verifyNothing "team"
             verifyNothing "history"
             verifyNothing "dependencies"
@@ -903,7 +902,7 @@ parseTicketLocal o = do
                 TicketLocal
                     <$> pure id_
                     <*> withAuthorityO a (o .: "replies")
-                    <*> withAuthorityO a (o .: "participants")
+                    <*> withAuthorityO a (o .: "participants" <|> o .: "followers")
                     <*> withAuthorityMaybeO a (o .:? "team")
                     <*> withAuthorityO a (o .: "history")
                     <*> withAuthorityO a (o .: "dependencies")
@@ -916,10 +915,10 @@ parseTicketLocal o = do
 
 encodeTicketLocal :: UriMode u => Authority u -> TicketLocal -> Series
 encodeTicketLocal
-    a (TicketLocal id_ replies participants team events deps rdeps)
+    a (TicketLocal id_ replies followers team events deps rdeps)
         =  "id"           .= ObjURI a id_
         <> "replies"      .= ObjURI a replies
-        <> "participants" .= ObjURI a participants
+        <> "followers"    .= ObjURI a followers
         <> "team"         .=? (ObjURI a <$> team)
         <> "history"      .= ObjURI a events
         <> "dependencies" .= ObjURI a deps
@@ -1220,23 +1219,38 @@ encodeFollow (Follow obj mcontext hide)
     <> "context" .=? mcontext
     <> "hide"    .=  hide
 
+data OfferObject u = OfferTicket (Ticket u) | OfferDep (TicketDependency u)
+
+instance ActivityPub OfferObject where
+    jsonldContext = error "jsonldContext OfferObject"
+    parseObject o
+        =   second OfferTicket <$> parseObject o
+        <|> second OfferDep    <$> parseObject o
+    toSeries h (OfferTicket t) = toSeries h t
+    toSeries h (OfferDep d)    = toSeries h d
+
 data Offer u = Offer
-    { offerObject :: Ticket u
+    { offerObject :: OfferObject u
     , offerTarget :: ObjURI u
     }
 
 parseOffer :: UriMode u => Object -> Authority u -> LocalURI -> Parser (Offer u)
 parseOffer o a luActor = do
-    ticket <- withAuthorityT a $ parseObject =<< o .: "object"
-    unless (luActor == ticketAttributedTo ticket) $
-        fail "Offer actor != Ticket attrib"
+    obj <- withAuthorityT a $ parseObject =<< o .: "object"
     target@(ObjURI hTarget luTarget) <- o .: "target"
-    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
+    case obj of
+        OfferTicket ticket -> do
+            unless (luActor == ticketAttributedTo ticket) $
+                fail "Offer actor != Ticket attrib"
+            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"
+        OfferDep dep -> do
+            unless (luActor == ticketDepAttributedTo dep) $
+                fail "Offer actor != TicketDependency attrib"
+    return $ Offer obj target
 
 encodeOffer :: UriMode u => Authority u -> LocalURI -> Offer u -> Series
 encodeOffer authority actor (Offer obj target)
@@ -1821,3 +1835,23 @@ fetchKnownSharedKey manager malgo host luActor luKey = do
         -> Either (PublicKey u) (Actor u)
         -> Either (PublicKey u) (Actor u)
     asKeyOrActor _ = id
+
+data Obj u = Obj
+    { objId        :: ObjURI u
+    , objType      :: Text
+
+    , objContext   :: Maybe (ObjURI u)
+    , objFollowers :: Maybe LocalURI
+    , objInbox     :: Maybe LocalURI
+    , objTeam      :: Maybe LocalURI
+    }
+
+instance UriMode u => FromJSON (Obj u) where
+    parseJSON = withObject "Obj" $ \ o -> do
+        id_@(ObjURI h _) <- o .: "id" <|> o .: "@id"
+        Obj id_
+            <$> (o .: "type" <|> o .: "@type")
+            <*> o .:? "context"
+            <*> withAuthorityMaybeO h (o .:? "followers")
+            <*> withAuthorityMaybeO h (o .:? "inbox")
+            <*> withAuthorityMaybeO h (o .:? "team")