feat: add store

Author: blackheaven

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

@@ -38,5 +38,6 @@ data UserGroupStore m a where
   UpdateUsers :: UserGroupId -> Vector UserId -> UserGroupStore m ()
   RemoveUser :: UserGroupId -> UserId -> UserGroupStore m ()
   UpdateUserGroupChannels :: TeamId -> UserGroupId -> Vector ConvId -> UserGroupStore m ()
+  ListUserGroupChannels :: TeamId -> UserGroupId -> UserGroupStore m (Vector ConvId)
 
 makeSem ''UserGroupStore

libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs

@@ -54,6 +54,7 @@ interpretUserGroupStoreToPostgres =
     UpdateUsers gid uids -> updateUsers gid uids
     RemoveUser gid uid -> removeUser gid uid
     UpdateUserGroupChannels _ gid convIds -> updateUserGroupChannels gid convIds
+    ListUserGroupChannels _ gid -> listUserGroupChannels gid
 
 updateUsers :: (UserGroupStorePostgresEffectConstraints r) => UserGroupId -> Vector UserId -> Sem r ()
 updateUsers gid uids = do
@@ -443,6 +444,28 @@ updateUserGroupChannels gid convIds = do
           on conflict (user_group_id) do nothing
           |]
 
+listUserGroupChannels ::
+  forall r.
+  (UserGroupStorePostgresEffectConstraints r) =>
+  UserGroupId ->
+  Sem r (Vector ConvId)
+listUserGroupChannels gid = do
+  pool <- input
+  eitherErrorOrUnit <- liftIO $ use pool session
+  either throw pure eitherErrorOrUnit
+  where
+    session :: Session (Vector ConvId)
+    session = statement gid selectStatement
+
+    selectStatement :: Statement UserGroupId (Vector ConvId)
+    selectStatement =
+      dimap
+        toUUID
+        (fmap Id)
+        [vectorStatement|
+            select (channel_id :: uuid) from user_group_channel where user_group_id = ($1 :: uuid)
+            |]
+
 crudUser ::
   forall r.
   (UserGroupStorePostgresEffectConstraints r) =>

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

@@ -33,5 +33,6 @@ data UserGroupSubsystem m a where
   UpdateUsers :: UserId -> UserGroupId -> Vector UserId -> UserGroupSubsystem m ()
   RemoveUser :: UserId -> UserGroupId -> UserId -> UserGroupSubsystem m ()
   UpdateChannels :: UserId -> UserGroupId -> Vector ConvId -> UserGroupSubsystem m ()
+  ListChannels :: UserId -> UserGroupId -> UserGroupSubsystem m (Vector ConvId)
 
 makeSem ''UserGroupSubsystem

libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs

@@ -53,6 +53,7 @@ interpretUserGroupSubsystem = interpret $ \case
   UpdateUsers updater groupId uids -> updateUsers updater groupId uids
   RemoveUser remover groupId removeeId -> removeUser remover groupId removeeId
   UpdateChannels remover groupId channelIds -> updateChannels remover groupId channelIds
+  ListChannels remover groupId -> listChannels remover groupId
 
 data UserGroupSubsystemError
   = UserGroupNotATeamAdmin
@@ -350,3 +351,17 @@ updateChannels performer groupId channelIds = do
   teamId <- getTeamAsAdmin performer >>= note UserGroupNotATeamAdmin
   traverse_ (getTeamConv performer teamId >=> note UserGroupChannelNotFound) channelIds
   Store.updateUserGroupChannels teamId groupId channelIds
+
+listChannels ::
+  ( Member UserSubsystem r,
+    Member Store.UserGroupStore r,
+    Member (Error UserGroupSubsystemError) r,
+    Member TeamSubsystem r
+  ) =>
+  UserId ->
+  UserGroupId ->
+  Sem r (Vector ConvId)
+listChannels performer groupId = do
+  void $ getUserGroup performer groupId >>= note UserGroupNotFound
+  teamId <- getUserTeam performer >>= note UserGroupNotATeamAdmin
+  Store.listUserGroupChannels teamId groupId