diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 7e7d201d88..e328af5c90 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3379,20 +3379,16 @@ subscribeUserConnections vr onlyNeeded user = do addSub :: Connection -> [ConnId] -> [ConnId] addSub c = (aConnId c :) getContactConns :: CM [ConnId] - getContactConns = do - cts <- withStore_ (`getUserContacts` vr) -- TODO: lightweight query - let cts' = mapMaybe (\ct -> (,ct) <$> contactConnId ct) $ filter contactActive cts - pure (map fst cts') + getContactConns = withStore_ getUserContactConnIds getUserContactLinkConns :: CM ([ConnId], Map ConnId UserContact) getUserContactLinkConns = do (cs, ucs) <- unzip <$> withStore_ (`getUserContactLinks` vr) let connIds = map aConnId cs pure (connIds, M.fromList $ zip connIds ucs) - getGroupMemberConns :: CM ([Group], [ConnId]) + getGroupMemberConns :: CM ([(GroupInfo, [ConnId])], [ConnId]) getGroupMemberConns = do - gs <- withStore_ (`getUserGroups` vr) -- TODO: lightweight query - let mPairs = concatMap (\(Group _ ms) -> mapMaybe (\m -> (,m) <$> memberConnId m) (filter (not . memberRemoved) ms)) gs - pure (gs, map fst mPairs) + gs <- withStore_ (`getUserGroupMemberConnIds` vr) + pure (gs, concatMap snd gs) getSndFileTransferConns :: CM ([ConnId], Map ConnId SndFileTransfer) getSndFileTransferConns = do sfts <- withStore_ getLiveSndFileTransfers @@ -3438,31 +3434,29 @@ subscribeUserConnections vr onlyNeeded user = do okSubs = S.size groups - M.size errGroups, errSubs = M.size errGroups } - groupSubsToView :: Map ConnId AgentErrorType -> [Group] -> [ConnId] -> Map ConnId ContactRef -> Bool -> CM () - groupSubsToView errs gs ms connRefs ce = do - mapM_ groupSub $ - sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs + groupSubsToView :: Map ConnId AgentErrorType -> [(GroupInfo, [ConnId])] -> [ConnId] -> Map ConnId ContactRef -> Bool -> CM () + groupSubsToView errs gs allMembers connRefs ce = do + mapM_ (uncurry groupSub) gs toView CRMemberSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns} where - conns = S.fromList ms + conns = S.fromList allMembers errConns = M.restrictKeys errs conns - groupSub :: Group -> CM () - groupSub (Group g@GroupInfo {membership} members) = do + groupSub :: GroupInfo -> [ConnId] -> CM () + groupSub g@GroupInfo {membership} groupMembers = do when ce $ mapM_ (toView . uncurry (CRMemberSubError user g) ) mErrors toView groupEvent where mErrors :: [(ContactName, ChatError)] - mErrors = sortOn fst $ mapMaybe mError members - mError :: GroupMember -> Maybe (ContactName, ChatError) - mError gm = do - mConnId <- memberConnId gm + mErrors = sortOn fst $ mapMaybe mError groupMembers + mError :: ConnId -> Maybe (ContactName, ChatError) + mError mConnId = do mErr <- M.lookup mConnId errConns ContactRef {localDisplayName} <- M.lookup mConnId connRefs Just (localDisplayName, ChatErrorAgent mErr Nothing) groupEvent :: ChatResponse groupEvent | memberStatus membership == GSMemInvited = CRGroupInvitation user g - | all (\GroupMember {activeConn} -> isNothing activeConn) members = + | null groupMembers = if memberActive membership then CRGroupEmpty user g else CRGroupRemoved user g diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index ecba9be7fa..5bb12e8715 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -54,6 +54,7 @@ module Simplex.Chat.Store.Direct incConnectionAuthErrCounter, setConnectionAuthErrCounter, getUserContacts, + getUserContactConnIds, createOrUpdateContactRequest, getContactRequest', getContactRequest, @@ -858,6 +859,19 @@ getContactConnections db vr userId Contact {contactId} = connections [] = pure [] connections rows = pure $ map (toConnection vr) rows +getUserContactConnIds :: DB.Connection -> User -> IO [ConnId] +getUserContactConnIds db User {userId} = + map fromOnly + <$> DB.query + db + [sql| + SELECT c.agent_conn_id + FROM connections c + JOIN contacts ct ON ct.contact_id = c.contact_id + WHERE c.user_id = ? AND ct.user_id = ? AND ct.deleted = 0 + |] + (userId, userId) + getConnectionById :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Connection getConnectionById db vr User {userId} connId = ExceptT $ do firstRow (toConnection vr) (SEConnectionNotFoundById connId) $ diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 5e603a40c9..fed286e8f4 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -52,6 +52,7 @@ module Simplex.Chat.Store.Groups deleteGroupItemsAndMembers, deleteGroup, getUserGroups, + getUserGroupMemberConnIds, getUserGroupDetails, getUserGroupsWithSummary, getGroupSummary, @@ -628,6 +629,14 @@ getUserGroups db vr user@User {userId} = do groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId) rights <$> mapM (runExceptT . getGroup db vr user) groupIds +getUserGroupMemberConnIds :: DB.Connection -> VersionRangeChat -> User -> IO [(GroupInfo, [ConnId])] +getUserGroupMemberConnIds db vr user@User {userId} = do + groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ? ORDER BY local_display_name" (Only userId) + fmap rights . forM groupIds $ \groupId -> runExceptT $ do + gInfo <- getGroupInfo db vr user groupId + members <- liftIO $ getGroupMemberConnIds db user gInfo + pure (gInfo, members) + getUserGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo] getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = map (toGroupInfo vr userContactId) @@ -748,6 +757,26 @@ getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do (groupMemberQuery <> " WHERE m.group_id = ? AND m.user_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)") (userId, groupId, userId, userContactId) +getGroupMemberConnIds :: DB.Connection -> User -> GroupInfo -> IO [ConnId] +getGroupMemberConnIds db User {userId, userContactId} GroupInfo {groupId} = do + map fromOnly + <$> DB.query + db + [sql| + SELECT c.agent_conn_id + FROM group_members m + JOIN connections c ON c.connection_id = ( + SELECT max(cc.connection_id) + FROM connections cc + WHERE cc.user_id = ? AND cc.group_member_id = m.group_member_id + ) + WHERE m.group_id = ? + AND m.user_id = ? + AND (m.contact_id IS NULL OR m.contact_id != ?) + AND m.member_status NOT IN (?, ?, ?, ?) + |] + (userId, groupId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown) + getGroupMembersForExpiration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember] getGroupMembersForExpiration db vr user@User {userId, userContactId} GroupInfo {groupId} = do map (toContactMember vr user)