From a193159ebe3bed6af3454426c2d95b324e42747f Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 9 Aug 2026 11:31:41 +0000 Subject: [PATCH] get group and link in one query --- .../src/Directory/Service.hs | 32 ++++++-------- .../src/Directory/Store.hs | 44 ++++++++++++++----- 2 files changed, 47 insertions(+), 29 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index b5f6e70d27..7021f7c2c9 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/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 diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs index e3465e64b1..658aade26c 100644 --- a/apps/simplex-directory-service/src/Directory/Store.hs +++ b/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