From 1b304994d0b34569bb2ae069ba91be7af8e02049 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Thu, 10 Sep 2020 10:57:02 +0000 Subject: [PATCH] S2S: Add 'Add' activity, adds a new version of the patch bundle to a Ticket --- src/Vervis/Federation.hs | 12 + src/Vervis/Federation/Ticket.hs | 402 ++++++++++++++++++++++++++++---- src/Web/ActivityPub.hs | 47 ++++ 3 files changed, 413 insertions(+), 48 deletions(-) diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 208c698..42f3766 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -82,6 +82,8 @@ import Yesod.FedURI import Yesod.Hashids import Yesod.MonadSite +import qualified Web.ActivityPub as AP + import Control.Monad.Trans.Except.Local import Data.Aeson.Local import Data.Either.Local @@ -274,6 +276,11 @@ handleSharerInbox shrRecip now (ActivityAuthRemote author) body = do case activitySpecific $ actbActivity body of AcceptActivity accept -> (,Nothing) <$> sharerAcceptF shrRecip now author body mfwd luActivity accept + AddActivity (AP.Add obj target) -> + case obj of + Right (AddBundle patches) -> + sharerAddBundleF now shrRecip author body mfwd luActivity patches target + _ -> return ("Unsupported add object type for sharers", Nothing) CreateActivity (Create obj mtarget) -> case obj of CreateNote note -> @@ -372,6 +379,11 @@ handleRepoInbox shrRecip rpRecip now auth body = do msig <- checkForward $ LocalActorRepo shrRecip rpRecip let mfwd = (localRecips,) <$> msig case activitySpecific $ actbActivity body of + AddActivity (AP.Add obj target) -> + case obj of + Right (AddBundle patches) -> + repoAddBundleF now shrRecip rpRecip remoteAuthor body mfwd luActivity patches target + _ -> return ("Unsupported add object type for repos", Nothing) CreateActivity (Create obj mtarget) -> case obj of CreateNote note -> diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index 03bd11d..09c9272 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -22,6 +22,9 @@ module Vervis.Federation.Ticket , projectCreateTicketF , repoCreateTicketF + , sharerAddBundleF + , repoAddBundleF + , sharerOfferDepF , projectOfferDepF , repoOfferDepF @@ -1071,6 +1074,354 @@ repoCreateTicketF now shrRecip rpRecip author body mfwd luCreate ticket muTarget | shr == shrRecip && rp == rpRecip = Just (mb, vcs, diffs) targetRelevance _ = Nothing +getSharerWorkItemDetail shrRecip talid patch = do + manager <- asksSite appHttpManager + (parentLtid, parentCtx) <- runSiteDBExcept $ do + let getTcr tcr = do + let getRoid roid = do + ro <- getJust roid + i <- getJust $ remoteObjectInstance ro + return $ mkuri (i, ro) + roidT <- remoteActorIdent <$> getJust (ticketProjectRemoteTracker tcr) + let mroidJ = ticketProjectRemoteProject tcr + (,) <$> getRoid roidT <*> traverse getRoid mroidJ + if patch + then do + (_, Entity ltid _, _, context, _, _) <- do + mticket <- lift $ getSharerProposal shrRecip talid + fromMaybeE mticket $ "Parent" <> ": No such sharer-patch" + context' <- + lift $ + bitraverse + (\ (_, Entity _ trl) -> do + r <- getJust $ ticketRepoLocalRepo trl + s <- getJust $ repoSharer r + return $ Right (sharerIdent s, repoIdent r) + ) + (\ (Entity _ tcr, _) -> getTcr tcr) + context + return (ltid, context') + else do + (_, Entity ltid _, _, context, _) <- do + mticket <- lift $ getSharerTicket shrRecip talid + fromMaybeE mticket $ "Parent" <> ": No such sharer-ticket" + context' <- + lift $ + bitraverse + (\ (_, Entity _ tpl) -> do + j <- getJust $ ticketProjectLocalProject tpl + s <- getJust $ projectSharer j + return $ Left (sharerIdent s, projectIdent j) + ) + (\ (Entity _ tcr, _) -> getTcr tcr) + context + return (ltid, context') + parentCtx' <- bifor parentCtx pure $ \ (uTracker, muProject) -> do + let uProject = fromMaybe uTracker muProject + obj <- withExceptT T.pack $ AP.fetchAP manager $ Left uProject + unless (objId obj == uProject) $ + throwE "Project 'id' differs from the URI we fetched" + return + (uTracker, objUriAuthority uProject, objFollowers obj, objTeam obj) + return (parentLtid, parentCtx') + +sharerAddBundleF + :: UTCTime + -> ShrIdent + -> RemoteAuthor + -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI + -> NonEmpty (AP.Patch URIMode) + -> FedURI + -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) +sharerAddBundleF now shrRecip author body mfwd luAdd patches uTarget = do + ticket <- parseWorkItem "Target" uTarget + (typ, diffs) <- do + ((typ, diff) :| rest) <- + for patches $ \ (AP.Patch mlocal attrib mpub typ content) -> do + verifyNothingE mlocal "Patch with 'id'" + unless (attrib == objUriLocal (remoteAuthorURI author)) $ + throwE "Add and Patch attrib mismatch" + verifyNothingE mpub "Patch has 'published'" + return (typ, content) + let (typs, diffs) = unzip rest + unless (all (== typ) typs) $ throwE "Patches of different media types" + return (typ, diff :| diffs) + personRecip <- lift $ runDB $ do + sid <- getKeyBy404 $ UniqueSharer shrRecip + getValBy404 $ UniquePersonIdent sid + return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do + relevantTicket <- + for (ticketRelevance shrRecip ticket) $ \ talid -> do + (ltid, ctx) <- getSharerWorkItemDetail shrRecip talid True + return (talid, ltid, ctx) + mhttp <- runSiteDBExcept $ do + mractid <- lift $ insertToInbox now author body (personInbox personRecip) luAdd True + for mractid $ \ ractid -> do + mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do + relevantFollowers <- askRelevantFollowers + let sieve = + makeRecipientSet [] $ catMaybes + [ relevantFollowers shrRecip ticket + ] + remoteRecips <- + insertRemoteActivityToLocalInboxes + False ractid $ + localRecipSieve' + sieve False False localRecips + (sig,) <$> deliverRemoteDB_S (actbBL body) ractid (personIdent personRecip) sig remoteRecips + mremotesHttpAccept <- for relevantTicket $ \ ticketData@(_, ltid, ctx) -> do + case ctx of + Left (Left _) -> error "Context of sharer-MR is a local project" + Left (Right (shr, rp)) -> do + mr <- lift $ runMaybeT $ do + sid <- MaybeT $ getKeyBy $ UniqueSharer shr + MaybeT $ getValBy $ UniqueRepo rp sid + let r = fromMaybe (error "Ticket context no such local repo in DB") mr + unless (repoVcs r == patchMediaTypeVCS typ) $ + throwE "Patch type and repo VCS mismatch" + Right _ -> pure () + obiidAccept <- lift $ insertEmptyOutboxItem (personOutbox personRecip) now + tid <- lift $ localTicketTicket <$> getJust ltid + bnid <- lift $ insert $ Bundle tid + lift $ insertMany_ $ NE.toList $ NE.map (Patch bnid now typ) diffs + (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- + lift $ insertAccept luAdd obiidAccept bnid ticketData + knownRemoteRecipsAccept <- + lift $ + deliverLocal' + False + (LocalActorSharer shrRecip) + (personInbox personRecip) + obiidAccept + localRecipsAccept + lift $ (obiidAccept,docAccept,fwdHostsAccept,) <$> + deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept + return (mremotesHttpFwd, mremotesHttpAccept) + case mhttp of + Nothing -> return "I already have this activity in my inbox, doing nothing" + Just (mremotesHttpFwd, mremotesHttpAccept) -> do + for_ mremotesHttpFwd $ \ (sig, remotes) -> + forkWorker "sharerAddBundleF inbox-forwarding" $ + deliverRemoteHTTP_S now shrRecip (actbBL body) sig remotes + for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) -> + forkWorker "sharerAddBundleF Accept HTTP delivery" $ + deliverRemoteHttp' fwdHosts obiid doc remotes + return $ + case (mremotesHttpAccept, mremotesHttpFwd) of + (Nothing, Nothing) -> "Ticket not mine, just stored in inbox and no inbox-forwarding to do" + (Nothing, Just _) -> "Ticket not mine, just stored in inbox and ran inbox-forwarding" + (Just _, Nothing) -> "Accepted new bundle, no inbox-forwarding to do" + (Just _, Just _) -> "Accepted new bundle and ran inbox-forwarding of the Add" + where + ticketRelevance shr (Left (WorkItemSharerTicket shr' talid True)) + | shr == shr' = Just talid + ticketRelevance _ _ = Nothing + askRelevantFollowers = do + hashTALID <- getEncodeKeyHashid + return $ \ shr wi -> followers hashTALID <$> ticketRelevance shr wi + where + followers hashTALID talid = + LocalPersonCollectionSharerProposalFollowers shrRecip $ + hashTALID talid + insertAccept luAdd obiidAccept bnid (talid, _, ctx) = do + encodeRouteLocal <- getEncodeRouteLocal + encodeRouteHome <- getEncodeRouteHome + followers <- askFollowers + workItemFollowers <- askWorkItemFollowers + hLocal <- asksSite siteInstanceHost + obikhidAccept <- encodeKeyHashid obiidAccept + talkhid <- encodeKeyHashid talid + bnkhid <- encodeKeyHashid bnid + ra <- getJust $ remoteAuthorId author + let ObjURI hAuthor luAuthor = remoteAuthorURI author + + audAuthor = + AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra) + audContext = contextAudience ctx + audTicket = AudLocal [LocalActorSharer shrRecip] [followers talid] + + (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = + collectAudience $ audAuthor : audTicket : audContext + + recips = map encodeRouteHome audLocal ++ audRemote + doc = Doc hLocal Activity + { activityId = + Just $ encodeRouteLocal $ + SharerOutboxItemR shrRecip obikhidAccept + , activityActor = encodeRouteLocal $ SharerR shrRecip + , activitySummary = Nothing + , activityAudience = Audience recips [] [] [] [] [] + , activitySpecific = AcceptActivity Accept + { acceptObject = ObjURI hAuthor luAdd + , acceptResult = + Just $ encodeRouteLocal $ + SharerProposalBundleR shrRecip talkhid bnkhid + } + } + update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc] + return (doc, recipientSet, remoteActors, fwdHosts) + where + askFollowers = do + hashTALID <- getEncodeKeyHashid + return $ LocalPersonCollectionSharerProposalFollowers shrRecip . hashTALID + +repoAddBundleF + :: UTCTime + -> ShrIdent + -> RpIdent + -> RemoteAuthor + -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI + -> NonEmpty (AP.Patch URIMode) + -> FedURI + -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) +repoAddBundleF now shrRecip rpRecip author body mfwd luAdd patches uTarget = do + ticket <- parseWorkItem "Target" uTarget + (typ, diffs) <- do + ((typ, diff) :| rest) <- + for patches $ \ (AP.Patch mlocal attrib mpub typ content) -> do + verifyNothingE mlocal "Patch with 'id'" + unless (attrib == objUriLocal (remoteAuthorURI author)) $ + throwE "Add and Patch attrib mismatch" + verifyNothingE mpub "Patch has 'published'" + return (typ, content) + let (typs, diffs) = unzip rest + unless (all (== typ) typs) $ throwE "Patches of different media types" + return (typ, diff :| diffs) + Entity ridRecip repoRecip <- lift $ runDB $ do + sid <- getKeyBy404 $ UniqueSharer shrRecip + getBy404 $ UniqueRepo rpRecip sid + unless (repoVcs repoRecip == patchMediaTypeVCS typ) $ + throwE "Patch type and repo VCS mismatch" + return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do + relevantTicket <- + for (ticketRelevance shrRecip rpRecip ticket) $ \ ltid -> do + author <- runSiteDBExcept $ do + (_, _, _, _, _, _, author, _, _) <- do + mticket <- lift $ getRepoProposal shrRecip rpRecip ltid + fromMaybeE mticket $ "Target" <> ": No such repo-patch" + lift $ getWorkItemAuthorDetail author + return (ltid, author) + mhttp <- runSiteDBExcept $ do + mractid <- lift $ insertToInbox now author body (repoInbox repoRecip) luAdd False + for mractid $ \ ractid -> do + mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do + relevantFollowers <- askRelevantFollowers + let rf = relevantFollowers shrRecip rpRecip + sieve = + makeRecipientSet [] $ catMaybes + [ rf ticket + ] + remoteRecips <- + insertRemoteActivityToLocalInboxes False ractid $ + localRecipSieve' + sieve False False localRecips + (sig,) <$> deliverRemoteDB_R (actbBL body) ractid ridRecip sig remoteRecips + mremotesHttpAccept <- lift $ for relevantTicket $ \ ticketData@(ltid, _author) -> do + obiidAccept <- insertEmptyOutboxItem (repoOutbox repoRecip) now + tid <- localTicketTicket <$> getJust ltid + bnid <- insert $ Bundle tid + insertMany_ $ NE.toList $ NE.map (Patch bnid now typ) diffs + (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- + insertAccept luAdd obiidAccept bnid ticketData + knownRemoteRecipsAccept <- + deliverLocal' + False + (LocalActorRepo shrRecip rpRecip) + (repoInbox repoRecip) + obiidAccept + localRecipsAccept + (obiidAccept,docAccept,fwdHostsAccept,) <$> + deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept + return (mremotesHttpFwd, mremotesHttpAccept) + case mhttp of + Nothing -> return "I already have this activity in my inbox, doing nothing" + Just (mremotesHttpFwd, mremotesHttpAccept) -> do + for_ mremotesHttpFwd $ \ (sig, remotes) -> + forkWorker "repoAddBundleF inbox-forwarding" $ + deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotes + for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) -> + forkWorker "repoAddBundleF Accept HTTP delivery" $ + deliverRemoteHttp' fwdHosts obiid doc remotes + return $ + case (mremotesHttpAccept, mremotesHttpFwd) of + (Nothing, Nothing) -> "Ticket not mine, just stored in inbox and no inbox-forwarding to do" + (Nothing, Just _) -> "Ticket not mine, just stored in inbox and ran inbox-forwarding" + (Just _, Nothing) -> "Accepted new bundle, no inbox-forwarding to do" + (Just _, Just _) -> "Accepted new bundle and ran inbox-forwarding of the Add" + where + ticketRelevance shr rp (Left (WorkItemRepoProposal shr' rp' ltid)) + | shr == shr' && rp == rp' = Just ltid + ticketRelevance _ _ _ = Nothing + askRelevantFollowers = do + hashLTID <- getEncodeKeyHashid + return $ + \ shr rp wi -> followers hashLTID <$> ticketRelevance shr rp wi + where + followers hashLTID ltid = + LocalPersonCollectionRepoProposalFollowers + shrRecip rpRecip (hashLTID ltid) + insertAccept luAdd obiidAccept bnid (ltid, ticketAuthor) = do + encodeRouteLocal <- getEncodeRouteLocal + encodeRouteHome <- getEncodeRouteHome + followers <- askFollowers + hLocal <- asksSite siteInstanceHost + obikhidAccept <- encodeKeyHashid obiidAccept + ltkhid <- encodeKeyHashid ltid + bnkhid <- encodeKeyHashid bnid + ra <- getJust $ remoteAuthorId author + let ObjURI hAuthor luAuthor = remoteAuthorURI author + + audAuthor = + AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra) + audTicketContext = + AudLocal + [] + [ LocalPersonCollectionRepoTeam shrRecip rpRecip + , LocalPersonCollectionRepoFollowers shrRecip rpRecip + ] + audTicketFollowers = AudLocal [] [followers ltid] + audTicketAuthor = + case ticketAuthor of + Left shr -> AudLocal [LocalActorSharer shr] [] + Right (i, ro) -> + AudRemote (instanceHost i) [remoteObjectIdent ro] [] + + (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = + collectAudience + [ audAuthor + , audTicketAuthor + , audTicketFollowers + , audTicketContext + ] + + recips = map encodeRouteHome audLocal ++ audRemote + doc = Doc hLocal Activity + { activityId = + Just $ encodeRouteLocal $ + RepoOutboxItemR shrRecip rpRecip obikhidAccept + , activityActor = encodeRouteLocal $ RepoR shrRecip rpRecip + , activitySummary = Nothing + , activityAudience = Audience recips [] [] [] [] [] + , activitySpecific = AcceptActivity Accept + { acceptObject = ObjURI hAuthor luAdd + , acceptResult = + Just $ encodeRouteLocal $ RepoProposalBundleR shrRecip rpRecip ltkhid bnkhid + } + } + update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc] + return (doc, recipientSet, remoteActors, fwdHosts) + where + askFollowers = do + hashLTID <- getEncodeKeyHashid + return $ + \ ltid -> + LocalPersonCollectionRepoProposalFollowers + shrRecip rpRecip (hashLTID ltid) + sharerOfferDepF :: UTCTime -> ShrIdent @@ -1090,55 +1441,10 @@ sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do manager <- asksSite appHttpManager relevantParent <- for (ticketRelevance shrRecip parent) $ \ (talid, patch) -> do - (parentLtid, parentCtx) <- runSiteDBExcept $ do - let getTcr tcr = do - let getRoid roid = do - ro <- getJust roid - i <- getJust $ remoteObjectInstance ro - return $ mkuri (i, ro) - roidT <- remoteActorIdent <$> getJust (ticketProjectRemoteTracker tcr) - let mroidJ = ticketProjectRemoteProject tcr - (,) <$> getRoid roidT <*> traverse getRoid mroidJ - if patch - then do - (_, Entity ltid _, _, context, _, _) <- do - mticket <- lift $ getSharerProposal shrRecip talid - fromMaybeE mticket $ "Parent" <> ": No such sharer-patch" - context' <- - lift $ - bitraverse - (\ (_, Entity _ trl) -> do - r <- getJust $ ticketRepoLocalRepo trl - s <- getJust $ repoSharer r - return $ Right (sharerIdent s, repoIdent r) - ) - (\ (Entity _ tcr, _) -> getTcr tcr) - context - return (ltid, context') - else do - (_, Entity ltid _, _, context, _) <- do - mticket <- lift $ getSharerTicket shrRecip talid - fromMaybeE mticket $ "Parent" <> ": No such sharer-ticket" - context' <- - lift $ - bitraverse - (\ (_, Entity _ tpl) -> do - j <- getJust $ ticketProjectLocalProject tpl - s <- getJust $ projectSharer j - return $ Left (sharerIdent s, projectIdent j) - ) - (\ (Entity _ tcr, _) -> getTcr tcr) - context - return (ltid, context') - parentCtx' <- bifor parentCtx pure $ \ (uTracker, muProject) -> do - let uProject = fromMaybe uTracker muProject - obj <- withExceptT T.pack $ AP.fetchAP manager $ Left uProject - unless (objId obj == uProject) $ - throwE "Project 'id' differs from the URI we fetched" - return - (uTracker, objUriAuthority uProject, objFollowers obj, objTeam obj) + (parentLtid, parentCtx) <- + getSharerWorkItemDetail shrRecip talid patch childDetail <- getWorkItemDetail "Child" child - return (talid, patch, parentLtid, parentCtx', childDetail) + return (talid, patch, parentLtid, parentCtx, childDetail) mhttp <- runSiteDBExcept $ do mractid <- lift $ insertToInbox' now author body (personInbox personRecip) luOffer True for mractid $ \ (ractid, ibiid) -> do diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index a47afe2..ba03370 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -60,6 +60,8 @@ module Web.ActivityPub -- * Activity , Accept (..) + , AddObject (..) + , Add (..) , CreateObject (..) , Create (..) , Follow (..) @@ -112,6 +114,7 @@ import Data.Aeson import Data.Aeson.Encoding (pair) import Data.Aeson.Types (Parser, typeMismatch, listEncoding) import Data.Bifunctor +import Data.Bitraversable import Data.ByteString (ByteString) import Data.Char import Data.Foldable (for_) @@ -651,6 +654,12 @@ withAuthorityP a m = do then return v else fail "URI authority mismatch" +withAuthorityD a m = do + Doc a' v <- m + if a == a' + then return v + else fail "URI authority mismatch" + withAuthorityMaybeT a m = do mu <- m for mu $ \ (a', v) -> @@ -1291,6 +1300,40 @@ encodeAccept authority (Accept obj mresult) = "object" .= obj <> "result" .=? (ObjURI authority <$> mresult) +data AddObject u = AddBundle (NonEmpty (Patch u)) + +instance ActivityPub AddObject where + jsonldContext = error "jsonldContext AddObject" + parseObject o = do + (h, b) <- parseObject o + patches <- + case b of + BundleHosted _ _ -> fail "Patches specified as URIs" + BundleOffer mlocal pts -> do + for_ mlocal $ \ _ -> fail "Bundle 'id' specified" + return pts + return (h, AddBundle patches) + toSeries h (AddBundle ps) = toSeries h $ BundleOffer Nothing ps + +data Add u = Add + { addObject :: Either (ObjURI u) (AddObject u) + , addTarget :: ObjURI u + } + +parseAdd :: UriMode u => Object -> Authority u -> Parser (Add u) +parseAdd o h = Add + <$> (bitraverse pure (withAuthorityD h . pure) =<< + toEither <$> o .: "object" + ) + <*> o .: "target" + +encodeAdd :: UriMode u => Authority u -> Add u -> Series +encodeAdd h (Add obj target) + = case obj of + Left u -> "object" .= u + Right o -> "object" `pair` pairs (toSeries h o) + <> "target" .= target + data CreateObject u = CreateNote (Note u) | CreateTicket (Ticket u) instance ActivityPub CreateObject where @@ -1446,6 +1489,7 @@ encodeUndo a (Undo obj) = "object" .= obj data SpecificActivity u = AcceptActivity (Accept u) + | AddActivity (Add u) | CreateActivity (Create u) | FollowActivity (Follow u) | OfferActivity (Offer u) @@ -1476,6 +1520,7 @@ instance ActivityPub Activity where typ <- o .: "type" case typ of "Accept" -> AcceptActivity <$> parseAccept a o + "Add" -> AddActivity <$> parseAdd o a "Create" -> CreateActivity <$> parseCreate o a actor "Follow" -> FollowActivity <$> parseFollow o "Offer" -> OfferActivity <$> parseOffer o a actor @@ -1496,6 +1541,7 @@ instance ActivityPub Activity where where activityType :: SpecificActivity u -> Text activityType (AcceptActivity _) = "Accept" + activityType (AddActivity _) = "Add" activityType (CreateActivity _) = "Create" activityType (FollowActivity _) = "Follow" activityType (OfferActivity _) = "Offer" @@ -1504,6 +1550,7 @@ instance ActivityPub Activity where activityType (ResolveActivity _) = "Resolve" activityType (UndoActivity _) = "Undo" encodeSpecific h _ (AcceptActivity a) = encodeAccept h a + encodeSpecific h _ (AddActivity a) = encodeAdd h a encodeSpecific h u (CreateActivity a) = encodeCreate h u a encodeSpecific _ _ (FollowActivity a) = encodeFollow a encodeSpecific h u (OfferActivity a) = encodeOffer h u a