Support delivery to Group followers collection
This commit is contained in:
fr33domlover
parent
b7eb7a17d2
commit
9e6eb9bec6
3 changed files with 41 additions and 44 deletions
|
|
@ -69,7 +69,6 @@ import GHC.Generics
|
|||
import Network.HTTP.Client
|
||||
import Network.HTTP.Types.Header
|
||||
import Network.HTTP.Types.URI
|
||||
import Network.TLS hiding (SHA256)
|
||||
import Text.Blaze.Html (preEscapedToHtml)
|
||||
import Text.Blaze.Html.Renderer.Text
|
||||
import UnliftIO.Exception (try)
|
||||
|
|
@ -266,7 +265,7 @@ acceptC (Entity pidUser personUser) senderActor summary audience accept = do
|
|||
Left (GrantResourceLoom l) -> Just $ LocalStageLoomFollowers l
|
||||
Right _ -> Nothing
|
||||
, case collabSender of
|
||||
Left actor -> localActorFollowers actor
|
||||
Left actor -> Just $ localActorFollowers actor
|
||||
Right _ -> Nothing
|
||||
]
|
||||
sieve = makeRecipientSet sieveActors sieveStages
|
||||
|
|
@ -420,13 +419,13 @@ acceptC (Entity pidUser personUser) senderActor summary audience accept = do
|
|||
|
||||
let audSender =
|
||||
case sender of
|
||||
Left actor -> AudLocal [actor] (maybeToList $ localActorFollowers actor)
|
||||
Left actor -> AudLocal [actor] [localActorFollowers actor]
|
||||
Right (ObjURI h lu, followers) ->
|
||||
AudRemote h [lu] (maybeToList followers)
|
||||
audRecip =
|
||||
AudLocal [LocalActorPerson recipHash] [LocalStagePersonFollowers recipHash]
|
||||
audTopic =
|
||||
AudLocal [] (maybeToList $ localActorFollowers topicHash)
|
||||
AudLocal [] [localActorFollowers topicHash]
|
||||
|
||||
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||
collectAudience [audSender, audRecip, audTopic]
|
||||
|
|
@ -1602,6 +1601,7 @@ createTicketTrackerC (Entity pidUser personUser) senderActor summary audience tr
|
|||
|
||||
data Followee
|
||||
= FolloweePerson (KeyHashid Person)
|
||||
| FolloweeGroup (KeyHashid Group)
|
||||
| FolloweeRepo (KeyHashid Repo)
|
||||
| FolloweeDeck (KeyHashid Deck)
|
||||
| FolloweeLoom (KeyHashid Loom)
|
||||
|
|
@ -1670,6 +1670,7 @@ followC (Entity pidSender personSender) summary audience follow@(AP.Follow uObje
|
|||
return obiidFollow
|
||||
where
|
||||
parseFollowee (PersonR p) = Just $ FolloweePerson p
|
||||
parseFollowee (GroupR g) = Just $ FolloweeGroup g
|
||||
parseFollowee (RepoR r) = Just $ FolloweeRepo r
|
||||
parseFollowee (DeckR d) = Just $ FolloweeDeck d
|
||||
parseFollowee (LoomR l) = Just $ FolloweeLoom l
|
||||
|
|
@ -1678,6 +1679,7 @@ followC (Entity pidSender personSender) summary audience follow@(AP.Follow uObje
|
|||
parseFollowee _ = Nothing
|
||||
|
||||
followeeActor (FolloweePerson p) = LocalActorPerson p
|
||||
followeeActor (FolloweeGroup g) = LocalActorGroup g
|
||||
followeeActor (FolloweeRepo r) = LocalActorRepo r
|
||||
followeeActor (FolloweeDeck d) = LocalActorDeck d
|
||||
followeeActor (FolloweeLoom l) = LocalActorLoom l
|
||||
|
|
@ -1687,6 +1689,9 @@ followC (Entity pidSender personSender) summary audience follow@(AP.Follow uObje
|
|||
getFollowee (FolloweePerson personHash) = do
|
||||
personID <- decodeKeyHashidE personHash "Follow object: No such person hash"
|
||||
(,Nothing,True) . personActor <$> getE personID "Follow object: No such person in DB"
|
||||
getFollowee (FolloweeGroup groupHash) = do
|
||||
groupID <- decodeKeyHashidE groupHash "Follow object: No such group hash"
|
||||
(,Nothing,False) . groupActor <$> getE groupID "Follow object: No such group in DB"
|
||||
getFollowee (FolloweeRepo repoHash) = do
|
||||
repoID <- decodeKeyHashidE repoHash "Follow object: No such repo hash"
|
||||
(,Nothing,False) . repoActor <$> getE repoID "Follow object: No such repo in DB"
|
||||
|
|
|
|||
|
|
@ -525,9 +525,6 @@ insertActivityToLocalInboxes
|
|||
-> ReaderT SqlBackend m [((InstanceId, Host), NonEmpty RemoteRecipient)]
|
||||
insertActivityToLocalInboxes makeInboxItem requireOwner mauthor maidAuthor recips = do
|
||||
|
||||
-- Predicate for filtering addressed stages
|
||||
--allowStage <- getAllowStage
|
||||
|
||||
-- Unhash actor and work item hashids
|
||||
people <- unhashKeys $ recipPeople recips
|
||||
groups <- unhashKeys $ recipGroups recips
|
||||
|
|
@ -577,6 +574,8 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor maidAuthor recip
|
|||
-- Grab actor actors whose followers are going to be delivered to
|
||||
let personIDsForFollowers =
|
||||
[ key | (key, routes) <- peopleForStages, routePersonFollowers routes ]
|
||||
groupIDsForFollowers =
|
||||
[ key | (key, routes) <- groupsForStages, routeGroupFollowers routes ]
|
||||
repoIDsForFollowers =
|
||||
[ key | (key, routes) <- reposForStages, routeRepoFollowers routes ]
|
||||
deckIDsForFollowers =
|
||||
|
|
@ -617,6 +616,7 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor maidAuthor recip
|
|||
followerSetIDs <- do
|
||||
actorIDs <- concat <$> sequenceA
|
||||
[ selectActorIDs personActor personIDsForFollowers
|
||||
, selectActorIDs groupActor groupIDsForFollowers
|
||||
, selectActorIDs repoActor repoIDsForFollowers
|
||||
, selectActorIDs deckActor deckIDsForFollowers
|
||||
, selectActorIDs loomActor loomIDsForFollowers
|
||||
|
|
|
|||
|
|
@ -195,6 +195,8 @@ renderLocalActor (LocalActorLoom lkhid) = LoomR lkhid
|
|||
data LocalStageBy f
|
||||
= LocalStagePersonFollowers (f Person)
|
||||
|
||||
| LocalStageGroupFollowers (f Group)
|
||||
|
||||
| LocalStageRepoFollowers (f Repo)
|
||||
|
||||
| LocalStageDeckFollowers (f Deck)
|
||||
|
|
@ -212,6 +214,8 @@ type LocalStage = LocalStageBy KeyHashid
|
|||
parseLocalStage :: Route App -> Maybe LocalStage
|
||||
parseLocalStage (PersonFollowersR pkhid) =
|
||||
Just $ LocalStagePersonFollowers pkhid
|
||||
parseLocalStage (GroupFollowersR gkhid) =
|
||||
Just $ LocalStageGroupFollowers gkhid
|
||||
parseLocalStage (RepoFollowersR rkhid) =
|
||||
Just $ LocalStageRepoFollowers rkhid
|
||||
parseLocalStage (DeckFollowersR dkhid) =
|
||||
|
|
@ -227,6 +231,8 @@ parseLocalStage _ = Nothing
|
|||
renderLocalStage :: LocalStage -> Route App
|
||||
renderLocalStage (LocalStagePersonFollowers pkhid) =
|
||||
PersonFollowersR pkhid
|
||||
renderLocalStage (LocalStageGroupFollowers gkhid) =
|
||||
GroupFollowersR gkhid
|
||||
renderLocalStage (LocalStageRepoFollowers rkhid) =
|
||||
RepoFollowersR rkhid
|
||||
renderLocalStage (LocalStageDeckFollowers dkhid) =
|
||||
|
|
@ -242,12 +248,12 @@ parseLocalRecipient :: Route App -> Maybe (Either LocalActor LocalStage)
|
|||
parseLocalRecipient r =
|
||||
Left <$> parseLocalActor r <|> Right <$> parseLocalStage r
|
||||
|
||||
localActorFollowers :: LocalActorBy f -> Maybe (LocalStageBy f)
|
||||
localActorFollowers (LocalActorPerson p) = Just $ LocalStagePersonFollowers p
|
||||
localActorFollowers (LocalActorGroup _) = Nothing
|
||||
localActorFollowers (LocalActorRepo r) = Just $ LocalStageRepoFollowers r
|
||||
localActorFollowers (LocalActorDeck d) = Just $ LocalStageDeckFollowers d
|
||||
localActorFollowers (LocalActorLoom l) = Just $ LocalStageLoomFollowers l
|
||||
localActorFollowers :: LocalActorBy f -> LocalStageBy f
|
||||
localActorFollowers (LocalActorPerson p) = LocalStagePersonFollowers p
|
||||
localActorFollowers (LocalActorGroup g) = LocalStageGroupFollowers g
|
||||
localActorFollowers (LocalActorRepo r) = LocalStageRepoFollowers r
|
||||
localActorFollowers (LocalActorDeck d) = LocalStageDeckFollowers d
|
||||
localActorFollowers (LocalActorLoom l) = LocalStageLoomFollowers l
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Converting between KeyHashid, Key, Identity and Entity
|
||||
|
|
@ -326,6 +332,8 @@ hashLocalStagePure ctx = f
|
|||
where
|
||||
f (LocalStagePersonFollowers p) =
|
||||
LocalStagePersonFollowers $ encodeKeyHashidPure ctx p
|
||||
f (LocalStageGroupFollowers g) =
|
||||
LocalStageGroupFollowers $ encodeKeyHashidPure ctx g
|
||||
f (LocalStageRepoFollowers r) =
|
||||
LocalStageRepoFollowers $ encodeKeyHashidPure ctx r
|
||||
f (LocalStageDeckFollowers d) =
|
||||
|
|
@ -361,6 +369,8 @@ unhashLocalStagePure ctx = f
|
|||
where
|
||||
f (LocalStagePersonFollowers p) =
|
||||
LocalStagePersonFollowers <$> decodeKeyHashidPure ctx p
|
||||
f (LocalStageGroupFollowers g) =
|
||||
LocalStageGroupFollowers <$> decodeKeyHashidPure ctx g
|
||||
f (LocalStageRepoFollowers r) =
|
||||
LocalStageRepoFollowers <$> decodeKeyHashidPure ctx r
|
||||
f (LocalStageDeckFollowers d) =
|
||||
|
|
@ -431,7 +441,7 @@ data LeafCloth = LeafClothFollowers deriving (Eq, Ord)
|
|||
|
||||
data LeafPerson = LeafPerson | LeafPersonFollowers deriving (Eq, Ord)
|
||||
|
||||
data LeafGroup = LeafGroup deriving (Eq, Ord)
|
||||
data LeafGroup = LeafGroup | LeafGroupFollowers deriving (Eq, Ord)
|
||||
|
||||
data LeafRepo = LeafRepo | LeafRepoFollowers deriving (Eq, Ord)
|
||||
|
||||
|
|
@ -472,6 +482,8 @@ recipientFromActor (LocalActorLoom lkhid) =
|
|||
recipientFromStage :: LocalStage -> LocalRecipient
|
||||
recipientFromStage (LocalStagePersonFollowers pkhid) =
|
||||
RecipPerson pkhid LeafPersonFollowers
|
||||
recipientFromStage (LocalStageGroupFollowers gkhid) =
|
||||
RecipGroup gkhid LeafGroupFollowers
|
||||
recipientFromStage (LocalStageRepoFollowers rkhid) =
|
||||
RecipRepo rkhid LeafRepoFollowers
|
||||
recipientFromStage (LocalStageDeckFollowers dkhid) =
|
||||
|
|
@ -509,7 +521,8 @@ data PersonRoutes = PersonRoutes
|
|||
deriving Eq
|
||||
|
||||
data GroupRoutes = GroupRoutes
|
||||
{ routeGroup :: Bool
|
||||
{ routeGroup :: Bool
|
||||
, routeGroupFollowers :: Bool
|
||||
}
|
||||
deriving Eq
|
||||
|
||||
|
|
@ -588,7 +601,7 @@ groupLocalRecipients = organize . partitionByActor
|
|||
{ recipPeople =
|
||||
map (second $ foldr orLP $ PersonRoutes False False) $ groupByKeySort p
|
||||
, recipGroups =
|
||||
map (second $ foldr orLG $ GroupRoutes False) $ groupByKeySort g
|
||||
map (second $ foldr orLG $ GroupRoutes False False) $ groupByKeySort g
|
||||
, recipRepos =
|
||||
map (second $ foldr orLR $ RepoRoutes False False) $ groupByKeySort r
|
||||
, recipDecks =
|
||||
|
|
@ -627,8 +640,9 @@ groupLocalRecipients = organize . partitionByActor
|
|||
orLP LeafPersonFollowers pr@(PersonRoutes _ _) = pr { routePersonFollowers = True }
|
||||
|
||||
orLG :: LeafGroup -> GroupRoutes -> GroupRoutes
|
||||
orLG _ gr@(GroupRoutes True) = gr
|
||||
orLG LeafGroup gr@(GroupRoutes _) = gr { routeGroup = True }
|
||||
orLG _ gr@(GroupRoutes True True) = gr
|
||||
orLG LeafGroup gr@(GroupRoutes _ _) = gr { routeGroup = True }
|
||||
orLG LeafGroupFollowers gr@(GroupRoutes _ _) = gr { routeGroupFollowers = True }
|
||||
|
||||
orLR :: LeafRepo -> RepoRoutes -> RepoRoutes
|
||||
orLR _ rr@(RepoRoutes True True) = rr
|
||||
|
|
@ -670,28 +684,6 @@ makeRecipientSet actors stages =
|
|||
groupLocalRecipients $
|
||||
map recipientFromActor actors ++ map recipientFromStage stages
|
||||
|
||||
actorIsMember :: LocalActor -> RecipientRoutes -> Bool
|
||||
actorIsMember (LocalActorPerson pkhid) routes =
|
||||
case lookup pkhid $ recipPeople routes of
|
||||
Just p -> routePerson p
|
||||
Nothing -> False
|
||||
actorIsMember (LocalActorGroup gkhid) routes =
|
||||
case lookup gkhid $ recipGroups routes of
|
||||
Just g -> routeGroup g
|
||||
Nothing -> False
|
||||
actorIsMember (LocalActorRepo rkhid) routes =
|
||||
case lookup rkhid $ recipRepos routes of
|
||||
Just r -> routeRepo r
|
||||
Nothing -> False
|
||||
actorIsMember (LocalActorDeck dkhid) routes =
|
||||
case lookup dkhid $ recipDecks routes of
|
||||
Just d -> routeDeck $ familyDeck d
|
||||
Nothing -> False
|
||||
actorIsMember (LocalActorLoom lkhid) routes =
|
||||
case lookup lkhid $ recipLooms routes of
|
||||
Just l -> routeLoom $ familyLoom l
|
||||
Nothing -> False
|
||||
|
||||
actorRecips :: LocalActor -> RecipientRoutes
|
||||
actorRecips = groupLocalRecipients . (: []) . recipientFromActor
|
||||
|
||||
|
|
@ -748,11 +740,11 @@ localRecipSieve' sieve allowPeople allowOthers routes = RecipientRoutes
|
|||
applyGroup _ (This _) = Nothing
|
||||
applyGroup gkhid (That g) =
|
||||
if allowOthers && routeGroup g
|
||||
then Just (gkhid, GroupRoutes True)
|
||||
then Just (gkhid, GroupRoutes True False)
|
||||
else Nothing
|
||||
applyGroup gkhid (These (GroupRoutes g') (GroupRoutes g)) =
|
||||
let merged = GroupRoutes (g && (g' || allowOthers))
|
||||
in if merged == GroupRoutes False
|
||||
applyGroup gkhid (These (GroupRoutes g' gf') (GroupRoutes g gf)) =
|
||||
let merged = GroupRoutes (g && (g' || allowOthers)) (gf && gf')
|
||||
in if merged == GroupRoutes False False
|
||||
then Nothing
|
||||
else Just (gkhid, merged)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue