Support delivery to Group followers collection

src/Vervis/API.hs

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

src/Vervis/Delivery.hs

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

src/Vervis/Recipient.hs

@@ -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 :: LocalActorBy f -> LocalStageBy f
-localActorFollowers (LocalActorPerson p) = Just $ LocalStagePersonFollowers p
+localActorFollowers (LocalActorPerson p) = LocalStagePersonFollowers p
-localActorFollowers (LocalActorGroup _) = Nothing
+localActorFollowers (LocalActorGroup g)  = LocalStageGroupFollowers g
-localActorFollowers (LocalActorRepo r) = Just $ LocalStageRepoFollowers r
+localActorFollowers (LocalActorRepo r)   = LocalStageRepoFollowers r
-localActorFollowers (LocalActorDeck d) = Just $ LocalStageDeckFollowers d
+localActorFollowers (LocalActorDeck d)   = LocalStageDeckFollowers d
-localActorFollowers (LocalActorLoom l) = Just $ LocalStageLoomFollowers l
+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) =
@@ -510,6 +522,7 @@ data PersonRoutes = PersonRoutes
 
 data GroupRoutes = GroupRoutes
     { 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 _                  gr@(GroupRoutes True True) = gr
-        orLG LeafGroup gr@(GroupRoutes _)    = gr { routeGroup = True }
+        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)) =
+    applyGroup gkhid (These (GroupRoutes g' gf') (GroupRoutes g gf)) =
-        let merged = GroupRoutes (g && (g' || allowOthers))
+        let merged = GroupRoutes (g && (g' || allowOthers)) (gf && gf')
-        in  if merged == GroupRoutes False
+        in  if merged == GroupRoutes False False
                 then Nothing
                 else Just (gkhid, merged)