get group and link in one query

apps/simplex-directory-service/src/Directory/Service.hs

@@ -1054,7 +1054,9 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           getRegisteredGroupByLink uri >>= \case
             Just (g, gr)
               | isAdmin -> sendGroupsInfo ct ciId True ([(g, gr)], 1)
-              | groupRegStatus gr == GRSActive -> sendFoundGroups "Found group:" [(g, gr)] 0
+              | groupRegStatus gr == GRSActive -> do
+                  gLink_ <- eitherToMaybe <$> getGroupLink' cc user g
+                  sendFoundGroups "Found group:" [(g, gr, gLink_)] 0
             _
               | isAdmin -> sendReply "This link is not registered in the directory"
               | otherwise -> sendReply linkNotFound
@@ -1238,8 +1240,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
         allGroupsReply sortName gs n =
           let more = if n > length gs then ", sending " <> sortName <> " " <> tshow (length gs) else ""
            in tshow n <> " group(s) listed" <> more <> "."
-        updateSearchRequest :: SearchType -> (GroupInfo, GroupReg) -> IO ()
-        updateSearchRequest searchType (GroupInfo {groupId}, _) = do
+        updateSearchRequest :: SearchType -> (GroupInfo, GroupReg, Maybe GroupLink) -> IO ()
+        updateSearchRequest searchType (GroupInfo {groupId}, _, _) = do
           searchTime <- getCurrentTime
           let search = SearchRequest {searchType, searchTime, lastGroup = groupId}
           atomically $ TM.insert (contactId' ct) search searchRequests
@@ -1254,27 +1256,21 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           where
             groupReg g = fmap (g,) . eitherToMaybe <$> getGroupReg cc (groupId' g)
         sendFoundGroups reply gs moreGroups =
-          void . forkIO $ do
-            msgs <- mapM foundGroup gs
-            sendComposedMessages_ cc (SRDirect $ contactId' ct) $ replyMsg :| msgs <> [moreMsg | moreGroups > 0]
+          void . forkIO $ sendComposedMessages_ cc (SRDirect $ contactId' ct) msgs
           where
+            msgs = replyMsg :| map foundGroup gs <> [moreMsg | moreGroups > 0]
             replyMsg = (Just ciId, MCText reply)
-            foundGroup (g@GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_, memberAdmission}, groupSummary}, _) = do
-              linkStr_ <- foundGroupLinkLine g p
+            foundGroup (g@GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_, memberAdmission}, groupSummary}, _, gLink_) =
               let membersStr = "_" <> membersCountStr p groupSummary <> "_"
                   showId = if isAdmin then tshow groupId <> ". " else ""
-                  text = T.unlines $ [showId <> groupInfoText (simplexNameStr <$> verifiedGroupDomain g) p] <> linkStr_ <> [membersStr] <> knockingStr memberAdmission
-              pure (Nothing, maybe (MCText text) (\image -> MCImage {text, image}) image_)
+                  text = T.unlines $ [showId <> groupInfoText (simplexNameStr <$> verifiedGroupDomain g) p] <> foundGroupLinkLine p gLink_ <> [membersStr] <> knockingStr memberAdmission
+               in (Nothing, maybe (MCText text) (\image -> MCImage {text, image}) image_)
             moreMsg = (Nothing, MCText $ "Send /next for " <> tshow moreGroups <> " more result(s).")
         -- link line for a non-public group in search results, unless its welcome message already contains it
-        foundGroupLinkLine g GroupProfile {displayName = n, description, publicGroup} = case publicGroup of
-          Just _ -> pure []
-          Nothing ->
-            withDB' "getGroupLink" cc (\db -> runExceptT $ getGroupLink db user g) >>= \case
-              Right (Right GroupLink {connLinkContact = gLink})
-                | not (maybe False (descriptionContainsLink gLink) description) ->
-                    pure [groupLinkLine n (groupLinkText gLink)]
-              _ -> pure []
+        foundGroupLinkLine GroupProfile {displayName = n, description, publicGroup} gLink_ = case (publicGroup, gLink_) of
+          (Nothing, Just GroupLink {connLinkContact = gLink})
+            | not (maybe False (descriptionContainsLink gLink) description) -> [groupLinkLine n (groupLinkText gLink)]
+          _ -> []
     deAdminCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRAdmin -> IO ()
     deAdminCommand ct ciId cmd
       | knownCt `elem` adminUsers || knownCt `elem` superUsers = case cmd of

apps/simplex-directory-service/src/Directory/Store.hs

@@ -93,7 +93,8 @@ import Simplex.Chat.Store
 import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Shared (groupInfoQueryFields, groupInfoQueryFrom)
 import Simplex.Chat.Types
-import Simplex.Messaging.Agent.Protocol (SimplexDomain)
+import Simplex.Chat.Types.Shared (GroupMemberRole (..))
+import Simplex.Messaging.Agent.Protocol (CreatedConnLink (..), SimplexDomain)
 import Simplex.Messaging.Agent.Store.DB (BoolInt (..), fromTextField_)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Encoding.String
@@ -357,12 +358,10 @@ getAllListedGroups cc user = withDB' "getAllListedGroups" cc $ \db -> getAllList
 getAllListedGroups_ :: DB.Connection -> StoreCxt -> User -> IO [(GroupInfo, GroupReg, Maybe GroupLink)]
 getAllListedGroups_ db cxt user@User {userId, userContactId} = do
   currentTs <- getCurrentTime
-  DB.query db (groupReqQuery <> " AND r.group_reg_status = ?") (userId, userContactId, GRSActive)
-    >>= mapM (withGroupLink . toGroupInfoReg currentTs cxt user)
-  where
-    withGroupLink (g, gr) = (g,gr,) . eitherToMaybe <$> runExceptT (getGroupLink db user g)
+  map (toGroupInfoRegLink currentTs cxt user)
+    <$> DB.query db (groupReqQuery <> " AND r.group_reg_status = ?") (userId, userContactId, GRSActive)
 
-searchListedGroups :: ChatController -> User -> SearchType -> Maybe GroupId -> Int -> IO (Either String ([(GroupInfo, GroupReg)], Int))
+searchListedGroups :: ChatController -> User -> SearchType -> Maybe GroupId -> Int -> IO (Either String ([(GroupInfo, GroupReg, Maybe GroupLink)], Int))
 searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pageSize =
   withDB' "searchListedGroups" cc $ \db -> do
     currentTs <- getCurrentTime
@@ -409,7 +408,7 @@ searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pa
           countQuery' = countQuery <> " JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id WHERE r.group_reg_status = ? "
           orderBy = " ORDER BY g.summary_current_members_count DESC, r.group_reg_id ASC "
   where
-    groups currentTs = (map (toGroupInfoReg currentTs (storeCxt cc) user) <$>)
+    groups currentTs = (map (toGroupInfoRegLink currentTs (storeCxt cc) user) <$>)
     count = maybeFirstRow' 0 fromOnly
     listedGroupQuery = groupReqQuery <> " AND r.group_reg_status = ? "
     countQuery = "SELECT COUNT(1) FROM groups g JOIN sx_directory_group_regs r ON g.group_id = r.group_id "
@@ -456,9 +455,12 @@ listPendingGroups cc user@User {userId, userContactId} count =
     n <- maybeFirstRow' 0 fromOnly $ DB.query_ db "SELECT COUNT(1) FROM sx_directory_group_regs WHERE group_reg_status LIKE 'pending_approval%'"
     pure (gs, n)
 
-toGroupInfoReg :: UTCTime -> StoreCxt -> User -> (GroupInfoRow :. GroupRegRow) -> (GroupInfo, GroupReg)
-toGroupInfoReg currentTs cxt User {userContactId} (groupRow :. grRow) =
-  (toGroupInfo currentTs cxt userContactId [] groupRow, rowToGroupReg grRow)
+toGroupInfoReg :: UTCTime -> StoreCxt -> User -> (GroupInfoRow :. GroupRegRow :. GroupLinkRow) -> (GroupInfo, GroupReg)
+toGroupInfoReg currentTs cxt user row = let (g, gr, _) = toGroupInfoRegLink currentTs cxt user row in (g, gr)
+
+toGroupInfoRegLink :: UTCTime -> StoreCxt -> User -> (GroupInfoRow :. GroupRegRow :. GroupLinkRow) -> (GroupInfo, GroupReg, Maybe GroupLink)
+toGroupInfoRegLink currentTs cxt User {userContactId} (groupRow :. grRow :. linkRow) =
+  (toGroupInfo currentTs cxt userContactId [] groupRow, rowToGroupReg grRow, toMaybeGroupLink linkRow)
 
 type GroupRegRow = (GroupId, UserGroupRegId, ContactId, Maybe GroupMemberId, GroupRegStatus, BoolInt, UTCTime)
 
@@ -466,10 +468,30 @@ rowToGroupReg :: GroupRegRow -> GroupReg
 rowToGroupReg (dbGroupId, userGroupRegId, dbContactId, dbOwnerMemberId, groupRegStatus, BI promoted, createdAt) =
   GroupReg {dbGroupId, userGroupRegId, dbContactId, dbOwnerMemberId, groupRegStatus, promoted, createdAt}
 
+type GroupLinkRow = (Maybe Int64, Maybe ConnReqContact, Maybe ShortLinkContact, Maybe BoolInt, Maybe BoolInt, Maybe GroupLinkId, Maybe GroupMemberRole)
+
+toMaybeGroupLink :: GroupLinkRow -> Maybe GroupLink
+toMaybeGroupLink (Just userContactLinkId, Just cReq, shortLink, slDataSet, slLarge, Just groupLinkId, mRole_) =
+  Just
+    GroupLink
+      { userContactLinkId,
+        connLinkContact = CCLink cReq shortLink,
+        shortLinkDataSet = boolInt slDataSet,
+        shortLinkLargeDataSet = BoolDef $ boolInt slLarge,
+        groupLinkId,
+        acceptMemberRole = fromMaybe GRMember mRole_
+      }
+  where
+    boolInt = maybe False (\(BI b) -> b)
+toMaybeGroupLink _ = Nothing
+
+-- group with its registration and its join link (user_contact_links) in one query
 groupReqQuery :: Query
-groupReqQuery = groupInfoQueryFields <> groupRegFields <> groupInfoQueryFrom <> groupRegFromCond
+groupReqQuery = groupInfoQueryFields <> groupRegFields <> groupLinkFields <> groupInfoQueryFrom <> groupLinkJoin <> groupRegFromCond
   where
     groupRegFields = ", r.group_id, r.user_group_reg_id, r.contact_id, r.owner_member_id, r.group_reg_status, r.group_promoted, r.created_at "
+    groupLinkFields = ", uc.user_contact_link_id, uc.conn_req_contact, uc.short_link_contact, uc.short_link_data_set, uc.short_link_large_data_set, uc.group_link_id, uc.group_link_member_role "
+    groupLinkJoin = " LEFT JOIN user_contact_links uc ON uc.group_id = g.group_id AND uc.user_id = g.user_id "
     groupRegFromCond = " JOIN sx_directory_group_regs r ON r.group_id = g.group_id WHERE g.user_id = ? AND mu.contact_id = ? "
 
 data DirectoryLogRecord