diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 759144f..c96a29c 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -160,7 +160,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge let shrUser = sharerIdent sharerUser noteData@(muParent, mparent, uContext, context, source, content) <- checkNote shrUser note verifyNothingE muTarget "Create Note has 'target'" - (localRecips, remoteRecips) <- do + ParsedAudience localRecips remoteRecips blinded fwdHosts <- do mrecips <- parseAudience audience fromMaybeE mrecips "Create Note with no recipients" checkFederation remoteRecips @@ -170,7 +170,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge obiidCreate <- lift $ insertEmptyOutboxItem (personOutbox personUser) now (mproject, did, meparent) <- getTopicAndParent context mparent lmid <- lift $ insertMessage now content source obiidCreate did meparent - docCreate <- lift $ insertCreateToOutbox now shrUser noteData obiidCreate lmid + docCreate <- lift $ insertCreateToOutbox now shrUser blinded noteData obiidCreate lmid remoteRecipsHttpCreate <- do hashLT <- getEncodeKeyHashid hashTAL <- getEncodeKeyHashid @@ -224,9 +224,9 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge lift $ deliverLocal' True (LocalActorSharer shrUser) (personInbox personUser) obiidCreate $ localRecipSieve' sieve True False localRecips checkFederation moreRemoteRecips - lift $ deliverRemoteDB' (objUriAuthority uContext) obiidCreate remoteRecips moreRemoteRecips + lift $ deliverRemoteDB'' fwdHosts obiidCreate remoteRecips moreRemoteRecips return (lmid, obiidCreate, docCreate, remoteRecipsHttpCreate) - lift $ forkWorker "createNoteC: async HTTP delivery" $ deliverRemoteHttp (objUriAuthority uContext) obiid doc remotesHttp + lift $ forkWorker "createNoteC: async HTTP delivery" $ deliverRemoteHttp' fwdHosts obiid doc remotesHttp return obiid where checkNote shrUser (Note mluNote luAttrib _aud muParent muContext mpublished source content) = do @@ -453,7 +453,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge Just (Right uParent) -> Just uParent _ -> Nothing } - insertCreateToOutbox now shrUser (muParent, _mparent, uContext, _context, source, content) obiidCreate lmid = do + insertCreateToOutbox now shrUser blinded (muParent, _mparent, uContext, _context, source, content) obiidCreate lmid = do encodeRouteLocal <- getEncodeRouteLocal hLocal <- asksSite siteInstanceHost obikhid <- encodeKeyHashid obiidCreate @@ -463,7 +463,7 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge { activityId = Just $ encodeRouteLocal $ SharerOutboxItemR shrUser obikhid , activityActor = luAttrib , activitySummary = summary - , activityAudience = audience + , activityAudience = blinded , activitySpecific = CreateActivity Create { createObject = CreateNote Note { noteId = Just $ encodeRouteLocal $ MessageR shrUser lmkhid @@ -510,7 +510,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT let shrUser = sharerIdent sharerUser ticketData@(uContext, title, desc, source, uTarget) <- checkTicket shrUser ticket muTarget context <- parseTicketContext uContext - (localRecips, remoteRecips) <- do + ParsedAudience localRecips remoteRecips blinded fwdHosts <- do mrecips <- parseAudience audience fromMaybeE mrecips "Create Ticket with no recipients" checkFederation remoteRecips @@ -521,7 +521,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT obiidCreate <- lift $ insertEmptyOutboxItem (personOutbox personUser) now project <- prepareProject now tracker talid <- lift $ insertTicket now pidUser title desc source obiidCreate project - docCreate <- lift $ insertCreateToOutbox shrUser ticketData now obiidCreate talid + docCreate <- lift $ insertCreateToOutbox shrUser blinded ticketData now obiidCreate talid remoteRecipsHttpCreate <- do let sieve = case tracker of @@ -539,7 +539,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT [LocalPersonCollectionSharerFollowers shrUser] moreRemoteRecips <- lift $ deliverLocal' True (LocalActorSharer shrUser) (personInbox personUser) obiidCreate $ localRecipSieve sieve False localRecips checkFederation moreRemoteRecips - lift $ deliverRemoteDB' (objUriAuthority uTarget) obiidCreate remoteRecips moreRemoteRecips + lift $ deliverRemoteDB'' fwdHosts obiidCreate remoteRecips moreRemoteRecips maccept <- case project of Left proj@(shr, Entity _ j, obiidAccept) -> Just <$> do @@ -555,13 +555,13 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT doc <- lift $ insertAcceptToOutbox proj shrUser obiidCreate talid recipsA recipsC recips <- lift $ deliverLocal' True (LocalActorProject shr prj) (projectInbox j) obiidAccept $ makeRecipientSet recipsA recipsC checkFederation recips - lift $ (obiidAccept,doc,) <$> deliverRemoteDB' dont obiidAccept [] recips + lift $ (obiidAccept,doc,) <$> deliverRemoteDB'' [] obiidAccept [] recips Right _ -> return Nothing return (talid, obiidCreate, docCreate, remoteRecipsHttpCreate, maccept) lift $ do - forkWorker "createTicketC: async HTTP Create delivery" $ deliverRemoteHttp (objUriAuthority uTarget) obiidCreate docCreate remotesHttpCreate + forkWorker "createTicketC: async HTTP Create delivery" $ deliverRemoteHttp' fwdHosts obiidCreate docCreate remotesHttpCreate for_ maybeAccept $ \ (obiidAccept, docAccept, remotesHttpAccept) -> - forkWorker "createTicketC: async HTTP Accept delivery" $ deliverRemoteHttp dont obiidAccept docAccept remotesHttpAccept + forkWorker "createTicketC: async HTTP Accept delivery" $ deliverRemoteHttp' [] obiidAccept docAccept remotesHttpAccept return obiidCreate where checkTicket shr (AP.Ticket mlocal luAttrib mpublished mupdated mcontext summary content source massigned resolved mmr) mtarget = do @@ -665,7 +665,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT } return talid - insertCreateToOutbox shrUser (uContext, title, desc, source, uTarget) now obiidCreate talid = do + insertCreateToOutbox shrUser blinded (uContext, title, desc, source, uTarget) now obiidCreate talid = do encodeRouteLocal <- getEncodeRouteLocal hLocal <- asksSite siteInstanceHost talkhid <- encodeKeyHashid talid @@ -684,7 +684,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT { activityId = Just $ encodeRouteLocal $ SharerOutboxItemR shrUser obikhid , activityActor = luAttrib , activitySummary = summary - , activityAudience = audience + , activityAudience = blinded , activitySpecific = CreateActivity Create { createObject = CreateTicket AP.Ticket { AP.ticketLocal = Just (hLocal, tlocal) @@ -742,8 +742,6 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc accept] return accept - dont = Authority "dont-do.any-forwarding" Nothing - data Followee = FolloweeSharer ShrIdent | FolloweeSharerTicket ShrIdent (KeyHashid TicketAuthorLocal) @@ -760,7 +758,7 @@ followC -> AP.Follow URIMode -> ExceptT Text Handler OutboxItemId followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do - (localRecips, remoteRecips) <- do + ParsedAudience localRecips remoteRecips blinded fwdHosts <- do mrecips <- parseAudience audience fromMaybeE mrecips "Follow with no recipients" federation <- asksSite $ appFederation . appSettings @@ -791,12 +789,11 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do unless (null localRecips) $ throwE "Follow object is remote but local recips listed" return Nothing - let dont = Authority "dont-do.any-forwarding" Nothing (obiidFollow, doc, remotesHttp) <- runDBExcept $ do Entity pidAuthor personAuthor <- lift $ getAuthor shrUser let ibidAuthor = personInbox personAuthor obidAuthor = personOutbox personAuthor - (obiidFollow, doc, luFollow) <- lift $ insertFollowToOutbox obidAuthor + (obiidFollow, doc, luFollow) <- lift $ insertFollowToOutbox obidAuthor blinded case mfollowee of Nothing -> lift $ insert_ $ FollowRemoteRequest pidAuthor uObject muContext (not hide) obiidFollow Just (followee, actorRecip) -> do @@ -804,9 +801,9 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do obiidAccept <- lift $ insertAcceptToOutbox luFollow actorRecip obidRecip deliverFollowLocal pidAuthor fsid unread obiidFollow obiidAccept ibidRecip lift $ deliverAcceptLocal obiidAccept ibidAuthor - remotesHttp <- lift $ deliverRemoteDB' dont obiidFollow remoteRecips [] + remotesHttp <- lift $ deliverRemoteDB'' fwdHosts obiidFollow remoteRecips [] return (obiidFollow, doc, remotesHttp) - lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp dont obiidFollow doc remotesHttp + lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp' fwdHosts obiidFollow doc remotesHttp return obiidFollow where parseFollowee (SharerR shr) = Just $ FolloweeSharer shr @@ -885,14 +882,14 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do fromMaybeE mticket "Follow object: No such repo-patch in DB" return (localTicketFollowers lt, repoInbox r, False, repoOutbox r) - insertFollowToOutbox obid = do + insertFollowToOutbox obid blinded = do hLocal <- asksSite siteInstanceHost encodeRouteLocal <- getEncodeRouteLocal let activity mluAct = Doc hLocal Activity { activityId = mluAct , activityActor = encodeRouteLocal $ SharerR shrUser , activitySummary = summary - , activityAudience = audience + , activityAudience = blinded , activitySpecific = FollowActivity follow } now <- liftIO getCurrentTime @@ -972,7 +969,7 @@ offerTicketC offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTarget = do let shrUser = sharerIdent sharerUser (title, desc, source, target) <- checkTicket shrUser ticket uTarget - (localRecips, remoteRecips) <- do + ParsedAudience localRecips remoteRecips blinded fwdHosts <- do mrecips <- parseAudience audience fromMaybeE mrecips "Offer Ticket with no recipients" federation <- asksSite $ appFederation . appSettings @@ -990,7 +987,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar return (s, ej) fromMaybeE mproj "Offer target no such local project in DB" Right _ -> return Nothing - (obiid, doc, luOffer) <- lift $ insertOfferToOutbox shrUser now (personOutbox personUser) + (obiid, doc, luOffer) <- lift $ insertOfferToOutbox shrUser now (personOutbox personUser) blinded remotesHttpOffer <- do let sieve = case target of @@ -1016,7 +1013,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar (localRecipSieve sieve False localRecips) unless (federation || null moreRemoteRecips) $ throwE "Federation disabled, but recipient collection remote members found" - lift $ deliverRemoteDB' (objUriAuthority uTarget) obiid remoteRecips moreRemoteRecips + lift $ deliverRemoteDB'' fwdHosts obiid remoteRecips moreRemoteRecips maccept <- lift $ for mproject $ \ (s, Entity jid j) -> do let shrJ = sharerIdent s prj = projectIdent j @@ -1033,7 +1030,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar (obiidAccept,docAccept,) <$> deliverRemoteDB'' [] obiidAccept [] knownRemoteRecipsAccept return (obiid, doc, remotesHttpOffer, maccept) lift $ do - forkWorker "offerTicketC: async HTTP Offer delivery" $ deliverRemoteHttp (objUriAuthority uTarget) obiidOffer docOffer remotesHttpOffer + forkWorker "offerTicketC: async HTTP Offer delivery" $ deliverRemoteHttp' fwdHosts obiidOffer docOffer remotesHttpOffer for_ maybeAccept $ \ (obiidAccept, docAccept, remotesHttpAccept) -> forkWorker "offerTicketC: async HTTP Accept delivery" $ deliverRemoteHttp' [] obiidAccept docAccept remotesHttpAccept return obiidOffer @@ -1071,7 +1068,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar RepoR _ _ -> throwE "Offering patch to repo not implemented yet" _ -> throwE "Offer target is local but isn't a project/repo route" else return $ Right u - insertOfferToOutbox shrUser now obid = do + insertOfferToOutbox shrUser now obid blinded = do hLocal <- asksSite siteInstanceHost obiid <- insertEmptyOutboxItem obid now encodeRouteLocal <- getEncodeRouteLocal @@ -1081,7 +1078,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar { activityId = Just luAct , activityActor = encodeRouteLocal $ SharerR shrUser , activitySummary = summary - , activityAudience = audience + , activityAudience = blinded , activitySpecific = OfferActivity $ Offer (OfferTicket ticket) uTarget } @@ -1162,7 +1159,7 @@ undoC -> Undo URIMode -> ExceptT Text Handler OutboxItemId undoC shrUser summary audience undo@(Undo luObject) = do - (localRecips, remoteRecips) <- do + ParsedAudience localRecips remoteRecips blinded fwdHosts <- do mrecips <- parseAudience audience fromMaybeE mrecips "Follow with no recipients" federation <- asksSite $ appFederation . appSettings @@ -1177,7 +1174,6 @@ undoC shrUser summary audience undo@(Undo luObject) = do | shr == shrUser -> decodeKeyHashidE obikhid "Undo object invalid obikhid" _ -> throwE "Undo object isn't actor's outbox item route" - let dont = Authority "dont-do.any-forwarding" Nothing (obiidUndo, doc, remotesHttp) <- runDBExcept $ do Entity _pidAuthor personAuthor <- lift $ getAuthor shrUser obi <- do @@ -1190,13 +1186,13 @@ undoC shrUser summary audience undo@(Undo luObject) = do deleteFollowRemote obiidOriginal deleteFollowRemoteRequest obiidOriginal let obidAuthor = personOutbox personAuthor - (obiidUndo, doc, luUndo) <- insertUndoToOutbox obidAuthor + (obiidUndo, doc, luUndo) <- insertUndoToOutbox obidAuthor blinded let ibidAuthor = personInbox personAuthor fsidAuthor = personFollowers personAuthor knownRemotes <- deliverLocal shrUser ibidAuthor fsidAuthor obiidUndo localRecips - remotesHttp <- deliverRemoteDB' dont obiidUndo remoteRecips knownRemotes + remotesHttp <- deliverRemoteDB'' fwdHosts obiidUndo remoteRecips knownRemotes return (obiidUndo, doc, remotesHttp) - lift $ forkWorker "undoC: Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp dont obiidUndo doc remotesHttp + lift $ forkWorker "undoC: Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp' fwdHosts obiidUndo doc remotesHttp return obiidUndo where getAuthor shr = do @@ -1211,14 +1207,14 @@ undoC shrUser summary audience undo@(Undo luObject) = do deleteFollowRemoteRequest obiid = do mfrrid <- getKeyBy $ UniqueFollowRemoteRequestActivity obiid traverse_ delete mfrrid - insertUndoToOutbox obid = do + insertUndoToOutbox obid blinded = do hLocal <- asksSite siteInstanceHost encodeRouteLocal <- getEncodeRouteLocal let activity mluAct = Doc hLocal Activity { activityId = mluAct , activityActor = encodeRouteLocal $ SharerR shrUser , activitySummary = summary - , activityAudience = audience + , activityAudience = blinded , activitySpecific = UndoActivity undo } now <- liftIO getCurrentTime diff --git a/src/Vervis/ActivityPub/Recipient.hs b/src/Vervis/ActivityPub/Recipient.hs index 846a6b3..389e74b 100644 --- a/src/Vervis/ActivityPub/Recipient.hs +++ b/src/Vervis/ActivityPub/Recipient.hs @@ -30,6 +30,7 @@ module Vervis.ActivityPub.Recipient , renderLocalActor , renderLocalPersonCollection , makeRecipientSet + , ParsedAudience (..) , parseAudience , actorRecips , localRecipSieve @@ -478,16 +479,35 @@ parseRecipients recips = do Nothing -> Left route Just recip -> Right recip +data ParsedAudience u = ParsedAudience + { paudLocalRecips :: LocalRecipientSet + , paudRemoteActors :: [(Authority u, NonEmpty LocalURI)] + , paudBlinded :: Audience u + , paudFwdHosts :: [Authority u] + } + parseAudience :: (MonadSite m, SiteEnv m ~ App) => Audience URIMode - -> ExceptT Text m (Maybe (LocalRecipientSet, [(Host, NonEmpty LocalURI)])) + -> ExceptT Text m (Maybe (ParsedAudience URIMode)) parseAudience audience = do let recips = concatRecipients audience for (nonEmpty recips) $ \ recipsNE -> do (localsSet, remotes) <- parseRecipients recipsNE - return - (localsSet, groupByHost $ remotes \\ audienceNonActors audience) + let remotesGrouped = + groupByHost $ remotes \\ audienceNonActors audience + hosts = map fst remotesGrouped + return ParsedAudience + { paudLocalRecips = localsSet + , paudRemoteActors = remotesGrouped + , paudBlinded = + audience { audienceBto = [], audienceBcc = [] } + , paudFwdHosts = + let nonActorHosts = + LO.nubSort $ + map objUriAuthority $ audienceNonActors audience + in LO.isect hosts nonActorHosts + } where groupByHost :: [FedURI] -> [(Host, NonEmpty LocalURI)] groupByHost = groupAllExtract objUriAuthority objUriLocal diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 02aa545..41dc9d7 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -93,6 +93,7 @@ import Database.Persist.Local import Yesod.Persist.Local import Vervis.ActivityPub +import Vervis.ActivityPub.Recipient import Vervis.ActorKey import Vervis.Federation.Auth import Vervis.Federation.Discussion @@ -262,32 +263,39 @@ handleSharerInbox shrRecip _now (ActivityAuthLocal (ActivityAuthLocalRepo ridAut "Activity already exists in inbox of /s/" <> recip Just _ -> return $ "Activity inserted to inbox of /s/" <> recip -handleSharerInbox shrRecip now (ActivityAuthRemote author) body = +handleSharerInbox shrRecip now (ActivityAuthRemote author) body = do + luActivity <- + fromMaybeE (activityId $ actbActivity body) "Activity without 'id'" + localRecips <- do + mrecips <- parseAudience $ activityAudience $ actbActivity body + paudLocalRecips <$> fromMaybeE mrecips "Activity with no recipients" + msig <- checkForward $ LocalActorSharer shrRecip + let mfwd = (localRecips,) <$> msig case activitySpecific $ actbActivity body of AcceptActivity accept -> - (,Nothing) <$> sharerAcceptF shrRecip now author body accept + (,Nothing) <$> sharerAcceptF shrRecip now author body mfwd luActivity accept CreateActivity (Create obj mtarget) -> case obj of CreateNote note -> - (,Nothing) <$> sharerCreateNoteF now shrRecip author body note + (,Nothing) <$> sharerCreateNoteF now shrRecip author body mfwd luActivity note CreateTicket ticket -> - (,Nothing) <$> sharerCreateTicketF now shrRecip author body ticket mtarget + (,Nothing) <$> sharerCreateTicketF now shrRecip author body mfwd luActivity ticket mtarget _ -> return ("Unsupported create object type for sharers", Nothing) FollowActivity follow -> - (,Nothing) <$> sharerFollowF shrRecip now author body follow + (,Nothing) <$> sharerFollowF shrRecip now author body mfwd luActivity follow OfferActivity (Offer obj target) -> case obj of OfferTicket ticket -> - (,Nothing) <$> sharerOfferTicketF now shrRecip author body ticket target + (,Nothing) <$> sharerOfferTicketF now shrRecip author body mfwd luActivity ticket target OfferDep dep -> - sharerOfferDepF now shrRecip author body dep target + sharerOfferDepF now shrRecip author body mfwd luActivity dep target _ -> return ("Unsupported offer object type for sharers", Nothing) PushActivity push -> - (,Nothing) <$> sharerPushF shrRecip now author body push + (,Nothing) <$> sharerPushF shrRecip now author body mfwd luActivity push RejectActivity reject -> - (,Nothing) <$> sharerRejectF shrRecip now author body reject + (,Nothing) <$> sharerRejectF shrRecip now author body mfwd luActivity reject UndoActivity undo -> - (,Nothing) <$> sharerUndoF shrRecip now author body undo + (,Nothing) <$> sharerUndoF shrRecip now author body mfwd luActivity undo _ -> return ("Unsupported activity type for sharers", Nothing) handleProjectInbox @@ -302,25 +310,32 @@ handleProjectInbox shrRecip prjRecip now auth body = do case auth of ActivityAuthLocal local -> throwE $ errorLocalForwarded local ActivityAuthRemote ra -> return ra + luActivity <- + fromMaybeE (activityId $ actbActivity body) "Activity without 'id'" + localRecips <- do + mrecips <- parseAudience $ activityAudience $ actbActivity body + paudLocalRecips <$> fromMaybeE mrecips "Activity with no recipients" + msig <- checkForward $ LocalActorProject shrRecip prjRecip + let mfwd = (localRecips,) <$> msig case activitySpecific $ actbActivity body of CreateActivity (Create obj mtarget) -> case obj of CreateNote note -> - (,Nothing) <$> projectCreateNoteF now shrRecip prjRecip remoteAuthor body note + (,Nothing) <$> projectCreateNoteF now shrRecip prjRecip remoteAuthor body mfwd luActivity note CreateTicket ticket -> - (,Nothing) <$> projectCreateTicketF now shrRecip prjRecip remoteAuthor body ticket mtarget + (,Nothing) <$> projectCreateTicketF now shrRecip prjRecip remoteAuthor body mfwd luActivity ticket mtarget _ -> error "Unsupported create object type for projects" FollowActivity follow -> - (,Nothing) <$> projectFollowF shrRecip prjRecip now remoteAuthor body follow + (,Nothing) <$> projectFollowF shrRecip prjRecip now remoteAuthor body mfwd luActivity follow OfferActivity (Offer obj target) -> case obj of OfferTicket ticket -> - (,Nothing) <$> projectOfferTicketF now shrRecip prjRecip remoteAuthor body ticket target + (,Nothing) <$> projectOfferTicketF now shrRecip prjRecip remoteAuthor body mfwd luActivity ticket target OfferDep dep -> - projectOfferDepF now shrRecip prjRecip remoteAuthor body dep target + projectOfferDepF now shrRecip prjRecip remoteAuthor body mfwd luActivity dep target _ -> return ("Unsupported offer object type for projects", Nothing) UndoActivity undo -> - (,Nothing) <$> projectUndoF shrRecip prjRecip now remoteAuthor body undo + (,Nothing) <$> projectUndoF shrRecip prjRecip now remoteAuthor body mfwd luActivity undo _ -> return ("Unsupported activity type for projects", Nothing) where errorLocalForwarded (ActivityAuthLocalPerson pid) = @@ -345,21 +360,28 @@ handleRepoInbox shrRecip rpRecip now auth body = do case auth of ActivityAuthLocal local -> throwE $ errorLocalForwarded local ActivityAuthRemote ra -> return ra + luActivity <- + fromMaybeE (activityId $ actbActivity body) "Activity without 'id'" + localRecips <- do + mrecips <- parseAudience $ activityAudience $ actbActivity body + paudLocalRecips <$> fromMaybeE mrecips "Activity with no recipients" + msig <- checkForward $ LocalActorRepo shrRecip rpRecip + let mfwd = (localRecips,) <$> msig case activitySpecific $ actbActivity body of CreateActivity (Create obj mtarget) -> case obj of CreateNote note -> - (,Nothing) <$> repoCreateNoteF now shrRecip rpRecip remoteAuthor body note + (,Nothing) <$> repoCreateNoteF now shrRecip rpRecip remoteAuthor body mfwd luActivity note _ -> error "Unsupported create object type for repos" FollowActivity follow -> - (,Nothing) <$> repoFollowF shrRecip rpRecip now remoteAuthor body follow + (,Nothing) <$> repoFollowF shrRecip rpRecip now remoteAuthor body mfwd luActivity follow OfferActivity (Offer obj target) -> case obj of OfferDep dep -> - repoOfferDepF now shrRecip rpRecip remoteAuthor body dep target + repoOfferDepF now shrRecip rpRecip remoteAuthor body mfwd luActivity dep target _ -> return ("Unsupported offer object type for repos", Nothing) UndoActivity undo-> - (,Nothing) <$> repoUndoF shrRecip rpRecip now remoteAuthor body undo + (,Nothing) <$> repoUndoF shrRecip rpRecip now remoteAuthor body mfwd luActivity undo _ -> return ("Unsupported activity type for repos", Nothing) where errorLocalForwarded (ActivityAuthLocalPerson pid) = diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index ea15177..75214ea 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -212,16 +212,12 @@ sharerCreateNoteF -> ShrIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Note URIMode -> ExceptT Text Handler Text -sharerCreateNoteF now shrRecip author body note = do - luCreate <- - fromMaybeE (activityId $ actbActivity body) "Create without 'id'" +sharerCreateNoteF now shrRecip author body mfwd luCreate note = do (luNote, published, context, mparent, source, content) <- checkNote note - (localRecips, _remoteRecips) <- do - mrecips <- parseAudience $ activityAudience $ actbActivity body - fromMaybeE mrecips "Create Note with no recipients" - msig <- checkForward $ LocalActorSharer shrRecip case context of Right uContext -> runDBExcept $ do personRecip <- lift $ do @@ -261,10 +257,10 @@ sharerCreateNoteF now shrRecip author body note = do Nothing -> return $ Left "I already have this comment, just storing in inbox" Just mid -> lift $ do updateOrphans author luNote did mid - case msig of + case mfwd of Nothing -> return $ Left "Storing in inbox, caching comment, no inbox forwarding header" - Just sig -> Right <$> do + Just (localRecips, sig) -> Right <$> do talkhid <- encodeKeyHashid talid let sieve = makeRecipientSet @@ -349,16 +345,12 @@ projectCreateNoteF -> PrjIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Note URIMode -> ExceptT Text Handler Text -projectCreateNoteF now shrRecip prjRecip author body note = do - luCreate <- - fromMaybeE (activityId $ actbActivity body) "Create without 'id'" +projectCreateNoteF now shrRecip prjRecip author body mfwd luCreate note = do (luNote, published, context, mparent, source, content) <- checkNote note - (localRecips, _remoteRecips) <- do - mrecips <- parseAudience $ activityAudience $ actbActivity body - fromMaybeE mrecips "Create Note with no recipients" - msig <- checkForward $ LocalActorProject shrRecip prjRecip case context of Right _ -> return "Not using; context isn't local" Left (NoteContextSharerTicket shr talid False) -> do @@ -374,14 +366,14 @@ projectCreateNoteF now shrRecip prjRecip author body note = do case mractid of Nothing -> return $ Left "Activity already in my inbox" Just ractid -> - case msig of + case mfwd of Nothing -> return $ Left "Context is a sharer-ticket, \ \but no inbox forwarding \ \header for me, so doing \ \nothing, just storing in inbox" - Just sig -> lift $ Right <$> do + Just (localRecips, sig) -> lift $ Right <$> do let sieve = makeRecipientSet [] @@ -416,10 +408,10 @@ projectCreateNoteF now shrRecip prjRecip author body note = do Nothing -> return $ Left "I already have this comment, just storing in inbox" Just mid -> lift $ do updateOrphans author luNote did mid - case msig of + case mfwd of Nothing -> return $ Left "Storing in inbox, caching comment, no inbox forwarding header" - Just sig -> Right <$> do + Just (localRecips, sig) -> Right <$> do ltkhid <- encodeKeyHashid ltid let sieve = makeRecipientSet @@ -450,16 +442,12 @@ repoCreateNoteF -> RpIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Note URIMode -> ExceptT Text Handler Text -repoCreateNoteF now shrRecip rpRecip author body note = do - luCreate <- - fromMaybeE (activityId $ actbActivity body) "Create without 'id'" +repoCreateNoteF now shrRecip rpRecip author body mfwd luCreate note = do (luNote, published, context, mparent, source, content) <- checkNote note - (localRecips, _remoteRecips) <- do - mrecips <- parseAudience $ activityAudience $ actbActivity body - fromMaybeE mrecips "Create Note with no recipients" - msig <- checkForward $ LocalActorRepo shrRecip rpRecip case context of Right _ -> return "Not using; context isn't local" Left (NoteContextSharerTicket _ _ False) -> @@ -477,14 +465,14 @@ repoCreateNoteF now shrRecip rpRecip author body note = do case mractid of Nothing -> return $ Left "Activity already in my inbox" Just ractid -> - case msig of + case mfwd of Nothing -> return $ Left "Context is a sharer-patch, \ \but no inbox forwarding \ \header for me, so doing \ \nothing, just storing in inbox" - Just sig -> lift $ Right <$> do + Just (localRecips, sig) -> lift $ Right <$> do let sieve = makeRecipientSet [] @@ -520,10 +508,10 @@ repoCreateNoteF now shrRecip rpRecip author body note = do Nothing -> return $ Left "I already have this comment, just storing in inbox" Just mid -> lift $ do updateOrphans author luNote did mid - case msig of + case mfwd of Nothing -> return $ Left "Storing in inbox, caching comment, no inbox forwarding header" - Just sig -> Right <$> do + Just (localRecips, sig) -> Right <$> do ltkhid <- encodeKeyHashid ltid let sieve = makeRecipientSet diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index 3d3fa51..544bc91 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -38,6 +38,7 @@ import Control.Monad.Trans.Maybe import Data.Aeson import Data.Bifunctor import Data.Bitraversable +import Data.ByteString (ByteString) import Data.Foldable import Data.Function import Data.List (nub, union) @@ -91,15 +92,11 @@ sharerAcceptF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Accept URIMode -> ExceptT Text Handler Text -sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) mresult) = do - luAccept <- - fromMaybeE (activityId $ actbActivity body) "Accept without 'id'" - (localRecips, _) <- do - mrecips <- parseAudience $ activityAudience $ actbActivity body - fromMaybeE mrecips "Accept with no recipients" - msig <- checkForward $ LocalActorSharer shr +sharerAcceptF shr now author body mfwd luAccept (Accept (ObjURI hOffer luOffer) mresult) = do mres <- lift $ runDB $ do Entity pidRecip recip <- do sid <- getKeyBy404 $ UniqueSharer shr @@ -109,9 +106,9 @@ sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) mresult) = do mv <- runMaybeT $ asum [ insertFollow pidRecip (personOutbox recip) ractid , updateTicket pidRecip (personOutbox recip) ractid - , insertDep msig (personInbox recip) ractid + , insertDep mfwd (personInbox recip) ractid ] - for mv $ bitraverse pure $ traverse $ \ (sig, collections) -> do + for mv $ bitraverse pure $ traverse $ \ ((localRecips, sig), collections) -> do let sieve = makeRecipientSet [] collections remoteRecips <- insertRemoteActivityToLocalInboxes @@ -239,11 +236,11 @@ sharerRejectF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Reject URIMode -> ExceptT Text Handler Text -sharerRejectF shr now author body (Reject (ObjURI hOffer luOffer)) = do - luReject <- - fromMaybeE (activityId $ actbActivity body) "Reject without 'id'" +sharerRejectF shr now author body mfwd luReject (Reject (ObjURI hOffer luOffer)) = do lift $ runDB $ do Entity pidRecip recip <- do sid <- getKeyBy404 $ UniqueSharer shr @@ -291,11 +288,13 @@ followF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.Follow URIMode -> ExceptT Text Handler Text followF objRoute recipRoute getRecip recipInbox recipOutbox recipFollowers outboxItemRoute - now author body (AP.Follow (ObjURI hObj luObj) _mcontext hide) = do + now author body mfwd luFollow (AP.Follow (ObjURI hObj luObj) _mcontext hide) = do mobj <- do local <- hostIsLocal hObj return $ @@ -305,10 +304,6 @@ followF case mobj of Nothing -> return "Follow object unrelated to me, ignoring activity" Just obj -> do - luFollow <- - fromMaybeE - (activityId $ actbActivity body) - "Follow without 'id'" emsg <- lift $ runDB $ do mrecip <- getRecip obj case mrecip of @@ -333,7 +328,7 @@ followF iidAuthor = remoteAuthorInstance author hAuthor = objUriAuthority $ remoteAuthorURI author hostSection = ((iidAuthor, hAuthor), raInfo :| []) - (obiid, doc,) <$> deliverRemoteDB' dont obiid [] [hostSection] + (obiid, doc,) <$> deliverRemoteDB'' [] obiid [] [hostSection] else do delete obiid return $ Left "You're already a follower of me" @@ -341,11 +336,9 @@ followF Left msg -> return msg Right (obiid, doc, remotesHttp) -> do forkWorker "followF: Accept delivery" $ - deliverRemoteHttp dont obiid doc remotesHttp + deliverRemoteHttp' [] obiid doc remotesHttp return "Follow request accepted" where - dont = Authority "dont-do.any-forwarding" Nothing - insertToInbox luFollow ibidRecip = do let iidAuthor = remoteAuthorInstance author roid <- @@ -413,6 +406,8 @@ sharerFollowF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.Follow URIMode -> ExceptT Text Handler Text sharerFollowF shr = @@ -460,6 +455,8 @@ projectFollowF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.Follow URIMode -> ExceptT Text Handler Text projectFollowF shr prj = @@ -500,6 +497,8 @@ repoFollowF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.Follow URIMode -> ExceptT Text Handler Text repoFollowF shr rp = @@ -543,13 +542,13 @@ undoF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Undo URIMode -> ExceptT Text Handler Text undoF recipRoute getRecip recipInbox recipFollowers trySubObjects - now author body (Undo luObj) = do - luUndo <- - fromMaybeE (activityId $ actbActivity body) "Undo without 'id'" + now author body mfwd luUndo (Undo luObj) = do lift $ runDB $ do Entity idRecip recip <- getRecip ractid <- insertActivity luUndo @@ -607,6 +606,8 @@ sharerUndoF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Undo URIMode -> ExceptT Text Handler Text sharerUndoF shr = @@ -642,6 +643,8 @@ projectUndoF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Undo URIMode -> ExceptT Text Handler Text projectUndoF shr prj = @@ -680,6 +683,8 @@ repoUndoF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Undo URIMode -> ExceptT Text Handler Text repoUndoF shr rp = diff --git a/src/Vervis/Federation/Push.hs b/src/Vervis/Federation/Push.hs index f6b819a..58f50ca 100644 --- a/src/Vervis/Federation/Push.hs +++ b/src/Vervis/Federation/Push.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2019 by fr33domlover . + - Written in 2019, 2020 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -26,6 +26,7 @@ import Control.Monad.Trans.Except --import Control.Monad.Trans.Maybe --import Data.Aeson --import Data.Bifunctor +import Data.ByteString (ByteString) --import Data.Foldable --import Data.Function --import Data.List (nub, union) @@ -60,7 +61,7 @@ import Control.Monad.Trans.Except.Local import Database.Persist.Local import Yesod.Persist.Local ---import Vervis.ActivityPub +import Vervis.ActivityPub.Recipient import Vervis.FedURI import Vervis.Federation.Auth import Vervis.Foundation @@ -72,10 +73,11 @@ sharerPushF -> UTCTime -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> Push URIMode -> ExceptT Text Handler Text -sharerPushF shr now author body push = do - luPush <- fromMaybeE (activityId $ actbActivity body) "Push without 'id'" +sharerPushF shr now author body mfwd luPush push = do lift $ runDB $ do Entity pidRecip recip <- do sid <- getKeyBy404 $ UniqueSharer shr diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index 2355a5c..49b1fdd 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -36,6 +36,7 @@ import Control.Monad.Trans.Reader import Data.Aeson import Data.Bifunctor import Data.Bitraversable +import Data.ByteString (ByteString) import Data.Foldable import Data.Function import Data.List (nub, union) @@ -105,12 +106,13 @@ sharerOfferTicketF -> ShrIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.Ticket URIMode -> FedURI -> ExceptT Text Handler Text -sharerOfferTicketF now shrRecip author body ticket uTarget = do +sharerOfferTicketF now shrRecip author body mfwd luOffer ticket uTarget = do (hProject, shrProject, prjProject) <- parseTarget uTarget - luOffer <- fromMaybeE (activityId $ actbActivity body) "Offer without 'id'" {-deps <- -} checkOffer ticket hProject shrProject prjProject local <- hostIsLocal hProject @@ -203,11 +205,13 @@ projectOfferTicketF -> PrjIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.Ticket URIMode -> FedURI -> ExceptT Text Handler Text projectOfferTicketF - now shrRecip prjRecip author body ticket uTarget = do + now shrRecip prjRecip author body mfwd luOffer ticket uTarget = do targetIsUs <- lift $ runExceptT checkTarget case targetIsUs of Left t -> do @@ -217,14 +221,9 @@ projectOfferTicketF ] return t Right () -> do - luOffer <- - fromMaybeE - (activityId $ actbActivity body) - "Offer without 'id'" hLocal <- getsYesod siteInstanceHost {-deps <- -} checkOffer ticket hLocal shrRecip prjRecip - msig <- checkForward $ LocalActorProject shrRecip prjRecip let colls = findRelevantCollections shrRecip prjRecip hLocal $ activityAudience $ actbActivity body @@ -236,7 +235,7 @@ projectOfferTicketF ra <- getJust $ remoteAuthorId author insertTicket ra luOffer jid ibid {-tids-} for mticket $ \ (ractid, obiidAccept, docAccept) -> do - msr <- for msig $ \ sig -> do + msr <- for mfwd $ \ (_, sig) -> do remoteRecips <- deliverFwdLocal ractid colls sid fsid (sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips return (msr, obiidAccept, docAccept) @@ -504,12 +503,12 @@ sharerCreateTicketF -> ShrIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.Ticket URIMode -> Maybe FedURI -> ExceptT Text Handler Text -sharerCreateTicketF now shrRecip author body ticket muTarget = do - luCreate <- - fromMaybeE (activityId $ actbActivity body) "Create without 'id'" +sharerCreateTicketF now shrRecip author body mfwd luCreate ticket muTarget = do (targetAndContext, _, _) <- checkCreateTicket author ticket muTarget runDBExcept $ do ibidRecip <- lift $ do @@ -548,17 +547,16 @@ projectCreateTicketF -> PrjIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.Ticket URIMode -> Maybe FedURI -> ExceptT Text Handler Text -projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do - luCreate <- - fromMaybeE (activityId $ actbActivity body) "Create without 'id'" +projectCreateTicketF now shrRecip prjRecip author body mfwd luCreate ticket muTarget = do (targetAndContext, tlocal, published) <- checkCreateTicket author ticket muTarget case targetAndContext of Left (_, shrContext, prjContext) | shrRecip == shrContext && prjRecip == prjContext -> do - msig <- checkForward $ LocalActorProject shrRecip prjRecip msgOrRecips <- lift $ runDB $ do (sidProject, jid, obidProject, ibidProject, fsidProject) <- getProject mractidCreate <- insertCreate luCreate ibidProject @@ -577,7 +575,7 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do Right () -> do hLocal <- getsYesod siteInstanceHost let colls = findRelevantCollections shrRecip prjRecip hLocal $ activityAudience $ actbActivity body - mremoteRecipsHttpCreateFwd <- for msig $ \ sig -> do + mremoteRecipsHttpCreateFwd <- for mfwd $ \ (_, sig) -> do remoteRecips <- deliverFwdLocal ractidCreate colls sidProject fsidProject (sig,) <$> deliverRemoteDB_J (actbBL body) ractidCreate jid sig remoteRecips remoteRecipsHttpAccept <- do @@ -755,16 +753,13 @@ sharerOfferDepF -> 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 dep uTarget = do - luOffer <- fromMaybeE (activityId $ actbActivity body) "Offer without 'id'" +sharerOfferDepF now shrRecip author body mfwd luOffer dep uTarget = do (parent, child) <- checkDepAndTarget dep uTarget - (localRecips, _remoteRecips) <- do - mrecips <- parseAudience $ activityAudience $ actbActivity body - fromMaybeE mrecips "Offer Dep with no recipients" - msig <- checkForward $ LocalActorSharer shrRecip personRecip <- lift $ runDB $ do sid <- getKeyBy404 $ UniqueSharer shrRecip getValBy404 $ UniquePersonIdent sid @@ -825,7 +820,7 @@ sharerOfferDepF now shrRecip author body dep uTarget = do mractid <- lift $ insertToInbox' now author body (personInbox personRecip) luOffer True for mractid $ \ (ractid, ibiid) -> do insertDepOffer ibiid parent child - mremotesHttpFwd <- lift $ for msig $ \ sig -> do + mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do relevantFollowers <- askRelevantFollowers let sieve = makeRecipientSet [] $ catMaybes @@ -1178,16 +1173,13 @@ projectOfferDepF -> PrjIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.TicketDependency URIMode -> FedURI -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) -projectOfferDepF now shrRecip prjRecip author body dep uTarget = do - luOffer <- fromMaybeE (activityId $ actbActivity body) "Offer without 'id'" +projectOfferDepF now shrRecip prjRecip author body mfwd luOffer dep uTarget = do (parent, child) <- checkDepAndTarget dep uTarget - (localRecips, _) <- do - mrecips <- parseAudience $ activityAudience $ actbActivity body - fromMaybeE mrecips "Offer Dep with no recipients" - msig <- checkForward $ LocalActorProject shrRecip prjRecip Entity jidRecip projectRecip <- lift $ runDB $ do sid <- getKeyBy404 $ UniqueSharer shrRecip getBy404 $ UniqueProject prjRecip sid @@ -1205,7 +1197,7 @@ projectOfferDepF now shrRecip prjRecip author body dep uTarget = do mractid <- lift $ insertToInbox' now author body (projectInbox projectRecip) luOffer False for mractid $ \ (ractid, ibiid) -> do insertDepOffer ibiid parent child - mremotesHttpFwd <- lift $ for msig $ \ sig -> do + mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do relevantFollowers <- askRelevantFollowers let rf = relevantFollowers shrRecip prjRecip sieve = @@ -1342,16 +1334,13 @@ repoOfferDepF -> RpIdent -> RemoteAuthor -> ActivityBody + -> Maybe (LocalRecipientSet, ByteString) + -> LocalURI -> AP.TicketDependency URIMode -> FedURI -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) -repoOfferDepF now shrRecip rpRecip author body dep uTarget = do - luOffer <- fromMaybeE (activityId $ actbActivity body) "Offer without 'id'" +repoOfferDepF now shrRecip rpRecip author body mfwd luOffer dep uTarget = do (parent, child) <- checkDepAndTarget dep uTarget - (localRecips, _) <- do - mrecips <- parseAudience $ activityAudience $ actbActivity body - fromMaybeE mrecips "Offer Dep with no recipients" - msig <- checkForward $ LocalActorRepo shrRecip rpRecip Entity ridRecip repoRecip <- lift $ runDB $ do sid <- getKeyBy404 $ UniqueSharer shrRecip getBy404 $ UniqueRepo rpRecip sid @@ -1369,7 +1358,7 @@ repoOfferDepF now shrRecip rpRecip author body dep uTarget = do mractid <- lift $ insertToInbox' now author body (repoInbox repoRecip) luOffer False for mractid $ \ (ractid, ibiid) -> do insertDepOffer ibiid parent child - mremotesHttpFwd <- lift $ for msig $ \ sig -> do + mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do relevantFollowers <- askRelevantFollowers let rf = relevantFollowers shrRecip rpRecip sieve =