WPB-19713: Implement channels and channelsCount in user-groups endpoints

Author: blackheaven

changelog.d/2-features/WPB-19713

@@ -0,0 +1 @@
+Implement `channels` and `channelsCount` in `user-groups` endpoints.

libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs

@@ -158,6 +158,16 @@ type InternalAPIBase =
                     '[JSON]
                     (Respond 200 "Clients" ClientList)
            )
+    :<|> Named
+           "get-user-groups-conversation-list"
+           ( Summary "Get user-group conversations list"
+               :> ZLocalUser
+               :> "user-groups"
+               :> Capture "gid" UserGroupId
+               :> "conversations"
+               :> ReqBody '[Servant.JSON] GetPaginatedConversationIds
+               :> Post '[Servant.JSON] ConvIdsPage
+           )
     :<|> Named
            "guard-legalhold-policy-conflicts"
            ( "guard-legalhold-policy-conflicts"

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -314,7 +314,7 @@ type UserGroupAPI =
     )
     :<|> Named
            "get-user-group"
-           ( Summary "[STUB] (channels in response not implemented)"
+           ( Summary "Fetch a group accessible from the logged-in user"
                :> From 'V10
                :> ZLocalUser
                :> CanThrow 'UserGroupNotFound
@@ -331,7 +331,7 @@ type UserGroupAPI =
            )
     :<|> Named
            "get-user-groups"
-           ( Summary "[STUB] (channelsCount not implemented)"
+           ( Summary "Fetch groups accessible from the logged-in user"
                :> From 'V10
                :> ZLocalUser
                :> "user-groups"
@@ -342,6 +342,7 @@ type UserGroupAPI =
                :> QueryParam' '[Optional, Strict, LastSeenNameDesc] "last_seen_name" UserGroupName
                :> QueryParam' '[Optional, Strict, LastSeenCreatedAtDesc] "last_seen_created_at" UTCTimeMillis
                :> QueryParam' '[Optional, Strict, LastSeenIdDesc] "last_seen_id" UserGroupId
+               :> QueryFlag "include_channels"
                :> QueryFlag "include_member_count"
                :> Get '[JSON] UserGroupPage
            )

libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs

@@ -27,6 +27,7 @@ import Imports
 import Network.Wai.Utilities.Error qualified as Wai
 import Polysemy
 import Wire.API.Conversation
+import Wire.API.Conversation qualified as Public
 import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo)
 import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team
 import Wire.API.Team
@@ -144,5 +145,10 @@ data GalleyAPIAccess m a where
     UserId ->
     GalleyAPIAccess m [EJPDConvInfo]
   GetTeamAdmins :: TeamId -> GalleyAPIAccess m Team.TeamMemberList
+  GetUserGroupConversations ::
+    Local UserId ->
+    UserGroupId ->
+    Public.GetPaginatedConversationIds ->
+    GalleyAPIAccess m Public.ConvIdsPage
 
 makeSem ''GalleyAPIAccess

libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs

@@ -41,6 +41,7 @@ import Servant.API (toHeader)
 import System.Logger.Message
 import Util.Options
 import Wire.API.Conversation hiding (Member)
+import Wire.API.Conversation qualified as Public
 import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo)
 import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team
 import Wire.API.Routes.Version
@@ -96,6 +97,7 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint =
           UnblockConversation lusr mconn qcnv -> unblockConversation v lusr mconn qcnv
           GetEJPDConvInfo uid -> getEJPDConvInfo uid
           GetTeamAdmins tid -> getTeamAdmins tid
+          GetUserGroupConversations lusr ugid page -> getUserGroupConversations lusr ugid page
 
 getUserLegalholdStatus ::
   ( Member TinyLog r,
@@ -680,3 +682,25 @@ getEJPDConvInfo uid = do
     getReq =
       method GET
         . paths ["i", "user", toByteString' uid, "all-conversations"]
+
+getUserGroupConversations ::
+  ( Member (Error ParseException) r,
+    Member Rpc r,
+    Member (Input Endpoint) r,
+    Member TinyLog r
+  ) =>
+  Local UserId ->
+  UserGroupId ->
+  Public.GetPaginatedConversationIds ->
+  Sem r Public.ConvIdsPage
+getUserGroupConversations lusr ugid page = do
+  debug $ remote "galley" . msg (val "Get user group conversation")
+  galleyRequest req >>= decodeBodyOrThrow "galley"
+  where
+    req =
+      method POST
+        . zUser (tUnqualified lusr)
+        . paths ["i", "user-groups", toByteString' ugid, "conversations"]
+        . header "Content-Type" "application/json"
+        . lbytes (encode page)
+        . expect2xx

services/brig/brig.cabal

@@ -314,6 +314,8 @@ library
     , uri-bytestring                        >=0.2
     , utf8-string
     , uuid                                  >=1.3.5
+    , vector                                >=0.13.2.0
+    , vector-builder                        >=0.3.8.6
     , wai                                   >=3.0
     , wai-extra                             >=3.0
     , wai-middleware-gunzip                 >=0.0.2

services/brig/src/Brig/API/Public.hs

@@ -85,6 +85,8 @@ import Data.Qualified
 import Data.Range
 import Data.Schema ()
 import Data.Text.Encoding qualified as Text
+import Data.Vector (Vector)
+import Data.Vector qualified as Vector
 import Data.ZAuth.CryptoSign (CryptoSign)
 import Data.ZAuth.Token qualified as ZAuth
 import FileEmbedLzma
@@ -103,6 +105,8 @@ import Servant.OpenApi.Internal.Orphans ()
 import Servant.Swagger.UI
 import System.Logger.Class qualified as Log
 import Util.Logging (logFunction, logHandle, logTeam, logUser)
+import VectorBuilder.Builder qualified as VB
+import VectorBuilder.Vector qualified as VB
 import Wire.API.App
 import Wire.API.Connection qualified as Public
 import Wire.API.EnterpriseLogin
@@ -123,6 +127,7 @@ import Wire.API.Routes.Internal.Cargohold qualified as CargoholdInternalAPI
 import Wire.API.Routes.Internal.Galley qualified as GalleyInternalAPI
 import Wire.API.Routes.Internal.Gundeck qualified as GundeckInternalAPI
 import Wire.API.Routes.Internal.Spar qualified as SparInternalAPI
+import Wire.API.Routes.MultiTablePaging (GetMultiTablePageRequest (GetMultiTablePageRequest))
 import Wire.API.Routes.MultiTablePaging qualified as Public
 import Wire.API.Routes.Named (Named (Named))
 import Wire.API.Routes.Public.Brig
@@ -173,7 +178,7 @@ import Wire.EnterpriseLoginSubsystem qualified as EnterpriseLogin
 import Wire.Error
 import Wire.Events (Events)
 import Wire.FederationConfigStore (FederationConfigStore)
-import Wire.GalleyAPIAccess (GalleyAPIAccess)
+import Wire.GalleyAPIAccess (GalleyAPIAccess, getUserGroupConversations)
 import Wire.GalleyAPIAccess qualified as GalleyAPIAccess
 import Wire.HashPassword (HashPassword)
 import Wire.IndexedUserStore (IndexedUserStore)
@@ -1676,7 +1681,18 @@ createUserGroup :: (_) => Local UserId -> NewUserGroup -> Handler r UserGroup
 createUserGroup lusr newUserGroup = lift . liftSem $ UserGroup.createGroup (tUnqualified lusr) newUserGroup
 
 getUserGroup :: (_) => Local UserId -> UserGroupId -> Bool -> Handler r (Maybe UserGroup)
-getUserGroup lusr ugid _ = lift . liftSem $ UserGroup.getGroup (tUnqualified lusr) ugid
+getUserGroup lusr ugid includeChannels =
+  lift . liftSem $ do
+    mUserGroup <- UserGroup.getGroup (tUnqualified lusr) ugid
+    if includeChannels
+      then forM mUserGroup $ \userGroup -> do
+        fetchedChannels <- fetchChannels lusr userGroup.id_
+        pure
+          userGroup
+            { channels = Identity $ Just fetchedChannels,
+              channelsCount = Just $ Vector.length fetchedChannels
+            }
+      else pure mUserGroup
 
 getUserGroups ::
   (_) =>
@@ -1689,9 +1705,29 @@ getUserGroups ::
   Maybe UTCTimeMillis ->
   Maybe UserGroupId ->
   Bool ->
+  Bool ->
   Handler r UserGroupPage
-getUserGroups lusr q sortByKeys sortOrder pSize mLastName mLastCreatedAt mLastId includeMemberCount =
-  lift . liftSem $ UserGroup.getGroups (tUnqualified lusr) q sortByKeys sortOrder pSize mLastName mLastCreatedAt mLastId includeMemberCount
+getUserGroups lusr q sortByKeys sortOrder pSize mLastName mLastCreatedAt mLastId includeChannels includeMemberCount =
+  lift . liftSem $ do
+    userGroups <- UserGroup.getGroups (tUnqualified lusr) q sortByKeys sortOrder pSize mLastName mLastCreatedAt mLastId includeMemberCount
+    if includeChannels
+      then fmap UserGroupPage $ forM userGroups.page $ \userGroup -> do
+        fetchedChannels <- fetchChannels lusr userGroup.id_
+        pure
+          userGroup
+            { channelsCount = Just $ Vector.length fetchedChannels
+            }
+      else pure userGroups
+
+fetchChannels :: (_) => Local UserId -> UserGroupId -> Sem r (Vector (Qualified ConvId))
+fetchChannels luser ugid = do
+  let mkRequest = getUserGroupConversations luser ugid . GetMultiTablePageRequest (toRange $ Proxy @1000)
+      go acc page = do
+        if page.mtpHasMore
+          then go (page.mtpResults : acc) =<< mkRequest (Just page.mtpPagingState)
+          else pure $ VB.build $ foldMap VB.foldable $ reverse (page.mtpResults : acc)
+  page <- mkRequest Nothing
+  go [] page
 
 updateUserGroup :: (_) => Local UserId -> UserGroupId -> UserGroupUpdate -> (Handler r) ()
 updateUserGroup lusr gid gupd = lift . liftSem $ UserGroup.updateGroup (tUnqualified lusr) gid gupd

services/galley/src/Galley/API/Internal.hs

@@ -75,6 +75,7 @@ import Servant
 import System.Logger.Class hiding (Path, name)
 import System.Logger.Class qualified as Log
 import Wire.API.Conversation hiding (Member)
+import Wire.API.Conversation qualified as Public
 import Wire.API.Conversation.Action
 import Wire.API.Error
 import Wire.API.Error.Galley
@@ -113,6 +114,7 @@ internalAPI =
       <@> mkNamedAPI @"delete-user" rmUser
       <@> mkNamedAPI @"connect" Create.createConnectConversation
       <@> mkNamedAPI @"get-conversation-clients" iGetMLSClientListForConv
+      <@> mkNamedAPI @"get-user-groups-conversation-list" getUserGroupsConversations
       <@> mkNamedAPI @"guard-legalhold-policy-conflicts" guardLegalholdPolicyConflictsH
       <@> legalholdWhitelistedTeamsAPI
       <@> iTeamsAPI
@@ -511,3 +513,24 @@ iGetMLSClientListForConv ::
 iGetMLSClientListForConv gid = do
   cm <- E.lookupMLSClients gid
   pure $ ClientList (concatMap (Map.keys . snd) (Map.assocs cm))
+
+-- | Get the conversations list for a given user-group
+getUserGroupsConversations ::
+  -- forall p r.
+  -- ( p ~ CassandraPaging,
+  --   ( Member ConversationStore r,
+  --     Member (Error InternalError) r,
+  --     Member (Input Env) r,
+  --     Member (ListItems p ConvId) r,
+  --     Member (ListItems p (Remote ConvId)) r,
+  --     Member P.TinyLog r,
+  --     Member TeamCollaboratorsSubsystem r
+  --   )
+  -- ) =>
+  Local UserId ->
+  UserGroupId ->
+  Public.GetPaginatedConversationIds ->
+  Sem r Public.ConvIdsPage
+getUserGroupsConversations _lusr _gid MTP.GetMultiTablePageRequest {} = do
+  -- Blocked by 17126 get inspired by @"list-conversation-ids"
+  undefined