forge/Vervis
1
0
Fork 0
Code Pull requests Activity

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

Browse source
This commit is contained in:
fr33domlover 2020-09-10 10:57:02 +00:00
parent e2ac053d2b
commit 1b304994d0
3 changed files with 413 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/Vervis/Federation.hs
View file

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

402
src/Vervis/Federation/Ticket.hs
View file

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

47
src/Web/ActivityPub.hs
View file

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