S2S: Add 'Add' activity, adds a new version of the patch bundle to a Ticket

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 ->

src/Vervis/Federation/Ticket.hs

@@ -22,6 +22,9 @@ module Vervis.Federation.Ticket
     , projectCreateTicketF
     , repoCreateTicketF
 
+    , sharerAddBundleF
+    , repoAddBundleF
+
     , sharerOfferDepF
     , projectOfferDepF
     , repoOfferDepF
@@ -1071,25 +1074,8 @@ repoCreateTicketF now shrRecip rpRecip author body mfwd luCreate ticket muTarget
         | shr == shrRecip && rp == rpRecip = Just (mb, vcs, diffs)
     targetRelevance _ = Nothing
 
-sharerOfferDepF
+getSharerWorkItemDetail shrRecip talid patch = do
-    :: UTCTime
-    -> ShrIdent
-    -> RemoteAuthor
-    -> ActivityBody
-    -> Maybe (LocalRecipientSet, ByteString)
-    -> LocalURI
-    -> AP.TicketDependency URIMode
-    -> FedURI
-    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
-sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do
-    (parent, child) <- checkDepAndTarget dep uTarget
-    personRecip <- lift $ runDB $ do
-        sid <- getKeyBy404 $ UniqueSharer shrRecip
-        getValBy404 $ UniquePersonIdent sid
-    return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do
     manager <- asksSite appHttpManager
-        relevantParent <-
-            for (ticketRelevance shrRecip parent) $ \ (talid, patch) -> do
     (parentLtid, parentCtx) <- runSiteDBExcept $ do
         let getTcr tcr = do
                 let getRoid roid = do
@@ -1137,8 +1123,328 @@ sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do
             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
+    -> RemoteAuthor
+    -> ActivityBody
+    -> Maybe (LocalRecipientSet, ByteString)
+    -> LocalURI
+    -> AP.TicketDependency URIMode
+    -> FedURI
+    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
+sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do
+    (parent, child) <- checkDepAndTarget dep uTarget
+    personRecip <- lift $ runDB $ do
+        sid <- getKeyBy404 $ UniqueSharer shrRecip
+        getValBy404 $ UniquePersonIdent sid
+    return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do
+        manager <- asksSite appHttpManager
+        relevantParent <-
+            for (ticketRelevance shrRecip parent) $ \ (talid, patch) -> do
+                (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

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