core: exclude contacts accepted via group link from chat previews (#1234)

* RGEInvitedViaGroupLink * CRSentGroupInvitationViaLink * via_group_link filtering * reset * refactor * remove brackets
2026-03-31 01:05:55 +00:00 · 2022-10-21 17:35:07 +04:00
parent 7f9c4ede02
commit 5bcb725ea5
9 changed files with 69 additions and 28 deletions
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -57,6 +57,7 @@ library
      Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
      Simplex.Chat.Migrations.M20221012_inline_files
      Simplex.Chat.Migrations.M20221019_unread_chat
+      Simplex.Chat.Migrations.M20221021_connections_via_group_link
      Simplex.Chat.Mobile
      Simplex.Chat.Options
      Simplex.Chat.ProfileGenerator
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1169,16 +1169,15 @@ processChatCommand = \case
        groupId <- getGroupIdByName db user gName
        groupMemberId <- getGroupMemberIdByName db user groupId groupMemberName
        pure (groupId, groupMemberId)
-
-sendGrpInvitation :: ChatMonad m => User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> m ()
-sendGrpInvitation user ct@Contact {localDisplayName} GroupInfo {groupId, groupProfile, membership} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do
-  let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
-      groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
-  (msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv
-  let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
-  ci <- saveSndChatItem user (CDDirectSnd ct) msg content Nothing Nothing
-  toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
-  setActive $ ActiveG localDisplayName
+    sendGrpInvitation :: User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> m ()
+    sendGrpInvitation user ct@Contact {localDisplayName} GroupInfo {groupId, groupProfile, membership} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do
+      let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
+          groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
+      (msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv
+      let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
+      ci <- saveSndChatItem user (CDDirectSnd ct) msg content Nothing Nothing
+      toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
+      setActive $ ActiveG localDisplayName

 setExpireCIs :: (MonadUnliftIO m, MonadReader ChatController m) => Bool -> m ()
 setExpireCIs b = do
@@ -1726,7 +1725,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
        _ -> pure ()

    processGroupMessage :: ACommand 'Agent -> Connection -> GroupInfo -> GroupMember -> m ()
-    processGroupMessage agentMsg conn@Connection {connId} gInfo@GroupInfo {groupId, localDisplayName = gName, membership, chatSettings} m = case agentMsg of
+    processGroupMessage agentMsg conn@Connection {connId} gInfo@GroupInfo {groupId, localDisplayName = gName, groupProfile, membership, chatSettings} m = case agentMsg of
      INV (ACR _ cReq) ->
        withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} ->
          case cReq of
@@ -1745,8 +1744,21 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
                  Nothing -> messageError "implementation error: invitee does not have contact"
                  Just ct -> do
                    withStore' $ \db -> setNewContactMemberConnRequest db user m cReq
-                    sendGrpInvitation user ct gInfo m cReq
-                    toView $ CRSentGroupInvitation gInfo ct m
+                    sendGrpInvitation ct m
+                    toView $ CRSentGroupInvitationViaLink gInfo ct m
+                where
+                  sendGrpInvitation :: Contact -> GroupMember -> m ()
+                  sendGrpInvitation ct GroupMember {memberId, memberRole = memRole} = do
+                    let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
+                        groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
+                    (_msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv
+                    createdAt <- liftIO getCurrentTime
+                    let content = CIRcvGroupEvent RGEInvitedViaGroupLink
+                        cd = CDGroupRcv gInfo m
+                    -- we could link chat item with sent group invitation message (_msg)
+                    ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content createdAt createdAt
+                    ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing createdAt createdAt
+                    toView $ CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
              _ -> throwChatError $ CECommandError "unexpected cmdFunction"
            CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
      CONF confId _ connInfo -> do
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -279,6 +279,7 @@ data ChatResponse
  | CRUserDeletedMember {groupInfo :: GroupInfo, member :: GroupMember}
  | CRGroupsList {groups :: [GroupInfo]}
  | CRSentGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
+  | CRSentGroupInvitationViaLink {groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
  | CRFileTransferStatus (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
  | CRUserProfile {profile :: Profile}
  | CRUserProfileNoChange
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -514,6 +514,7 @@ rcvGroupEventToText = \case
  RGEUserDeleted -> "removed you"
  RGEGroupDeleted -> "deleted group"
  RGEGroupUpdated _ -> "group profile updated"
+  RGEInvitedViaGroupLink -> "invited via your group link"

 sndGroupEventToText :: SndGroupEvent -> Text
 sndGroupEventToText = \case
@@ -557,6 +558,10 @@ data RcvGroupEvent
  | RGEUserDeleted -- CRDeletedMemberUser
  | RGEGroupDeleted -- CRGroupDeleted
  | RGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
+  -- RGEInvitedViaGroupLink chat items are not received - they're created when sending group invitations,
+  -- but being RcvGroupEvent allows them to be assigned to the respective member (and so enable "send direct message")
+  -- and be created as unread without adding / working around new status for sent items
+  | RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink
  deriving (Show, Generic)

 instance FromJSON RcvGroupEvent where
--- a/src/Simplex/Chat/Migrations/M20221021_connections_via_group_link.hs
+++ b/src/Simplex/Chat/Migrations/M20221021_connections_via_group_link.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20221021_connections_via_group_link where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20221021_connections_via_group_link :: Query
+m20221021_connections_via_group_link =
+  [sql|
+PRAGMA ignore_check_constraints=ON;
+
+ALTER TABLE connections ADD COLUMN via_group_link INTEGER DEFAULT 0 CHECK (via_group_link NOT NULL); -- flag, 1 for connections via group link
+UPDATE connections SET via_group_link = 0;
+
+PRAGMA ignore_check_constraints=OFF;
+|]
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -252,6 +252,7 @@ CREATE TABLE connections(
  custom_user_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
  conn_req_inv BLOB,
  local_alias DEFAULT '' CHECK(local_alias NOT NULL),
+  via_group_link INTEGER DEFAULT 0 CHECK(via_group_link NOT NULL),
  FOREIGN KEY(snd_file_id, connection_id)
  REFERENCES snd_files(file_id, connection_id)
  ON DELETE CASCADE
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -283,6 +283,7 @@ import Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
 import Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
 import Simplex.Chat.Migrations.M20221012_inline_files
 import Simplex.Chat.Migrations.M20221019_unread_chat
+import Simplex.Chat.Migrations.M20221021_connections_via_group_link
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@@ -325,7 +326,8 @@ schemaMigrations =
    ("20221004_idx_msg_deliveries_message_id", m20221004_idx_msg_deliveries_message_id),
    ("20221011_user_contact_links_group_id", m20221011_user_contact_links_group_id),
    ("20221012_inline_files", m20221012_inline_files),
-    ("20221019_unread_chat", m20221019_unread_chat)
+    ("20221019_unread_chat", m20221019_unread_chat),
+    ("20221021_connections_via_group_link", m20221021_connections_via_group_link)
  ]

 -- | The list of migrations in ascending order by date
@@ -495,15 +497,17 @@ getProfileById db userId profileId =

 createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> IO Connection
 createConnection_ db userId connType entityId acId viaContact viaUserContactLink customUserProfileId connLevel currentTs = do
+  viaLinkGroupId :: Maybe Int64 <- fmap join . forM viaUserContactLink $ \ucLinkId ->
+    maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? AND group_id IS NOT NULL" (userId, ucLinkId)
  DB.execute
    db
    [sql|
      INSERT INTO connections (
-        user_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, custom_user_profile_id, conn_status, conn_type,
+        user_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, custom_user_profile_id, conn_status, conn_type,
        contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, updated_at
-      ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+      ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
    |]
-    ( (userId, acId, connLevel, viaContact, viaUserContactLink, customUserProfileId, ConnNew, connType)
+    ( (userId, acId, connLevel, viaContact, viaUserContactLink, isJust viaLinkGroupId, customUserProfileId, ConnNew, connType)
        :. (ent ConnContact, ent ConnMember, ent ConnSndFile, ent ConnRcvFile, ent ConnUserContact, currentTs, currentTs)
    )
  connId <- insertedRowId db
@@ -3082,7 +3086,7 @@ getDirectChatPreviews_ db User {userId} = do
        ) ChatStats ON ChatStats.contact_id = ct.contact_id
        LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id
        WHERE ct.user_id = ?
-          AND (c.conn_level = 0 OR i.chat_item_id IS NOT NULL)
+          AND ((c.conn_level = 0 AND c.via_group_link = 0) OR i.chat_item_id IS NOT NULL)
          AND c.connection_id = (
            SELECT cc_connection_id FROM (
              SELECT
@@ -3204,7 +3208,7 @@ getContactConnectionChatPreviews_ db User {userId} _ =
      [sql|
        SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, custom_user_profile_id, conn_req_inv, local_alias, created_at, updated_at
        FROM connections
-        WHERE user_id = ? AND conn_type = ? AND contact_id IS NULL AND conn_level = 0 AND via_contact IS NULL
+        WHERE user_id = ? AND conn_type = ? AND contact_id IS NULL AND conn_level = 0 AND via_group_link = 0 AND via_contact IS NULL
      |]
      (userId, ConnContact)
  where
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -93,7 +93,8 @@ responseToView testView = \case
  CRGroupCreated g -> viewGroupCreated g
  CRGroupMembers g -> viewGroupMembers g
  CRGroupsList gs -> viewGroupsList gs
-  CRSentGroupInvitation g c _ -> viewSentGroupInvitation g c
+  CRSentGroupInvitation g c _ -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
+  CRSentGroupInvitationViaLink g c _ -> [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
  CRFileTransferStatus ftStatus -> viewFileTransferStatus ftStatus
  CRUserProfile p -> viewUserProfile p
  CRUserProfileNoChange -> ["user profile did not change"]
@@ -391,10 +392,6 @@ viewConnReqInvitation cReq =
    "and ask them to connect: " <> highlight' "/c <invitation_link_above>"
  ]

-viewSentGroupInvitation :: GroupInfo -> Contact -> [StyledString]
-viewSentGroupInvitation g c =
-  ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
-
 viewChatCleared :: AChatInfo -> [StyledString]
 viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of
  DirectChat ct -> [ttyContact' ct <> ": all messages are removed locally ONLY"]
--- a/tests/ChatTests.hs
+++ b/tests/ChatTests.hs
@@ -3287,13 +3287,16 @@ testGroupLink =
      concurrentlyN_
        [ do
            alice <## "bob (Bob): contact is connected"
-            alice <## "invitation to join the group #team sent to bob",
+            alice <## "bob invited to group #team via your group link",
          do
            bob <## "alice (Alice): contact is connected"
            bob <## "#team: alice invites you to join the group as member"
            bob <## "use /j team to accept"
        ]
+      alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link")])
+      alice @@@ [("#team", "invited via your group link")] -- contacts connected via group link are not in chat previews
      alice <##> bob
+      alice @@@ [("@bob", "hey"), ("#team", "invited via your group link")]
      bob ##> "/j team"
      concurrently_
        (alice <## "#team: bob joined the group")
@@ -3318,7 +3321,7 @@ testGroupLink =
      concurrentlyN_
        [ do
            alice <## "cath_1 (Catherine): contact is connected"
-            alice <## "invitation to join the group #team sent to cath_1",
+            alice <## "cath_1 invited to group #team via your group link",
          do
            cath <## "alice_1 (Alice): contact is connected"
            cath <## "#team: alice_1 invites you to join the group as member"
@@ -3404,7 +3407,7 @@ testGroupLinkIncognitoMembership =
        [ do
            bob <## ("cath (Catherine): contact is connected, your incognito profile for this contact is " <> bobIncognito)
            bob <## "use /info cath to print out this incognito profile again"
-            bob <## "invitation to join the group #team sent to cath",
+            bob <## "cath invited to group #team via your group link",
          do
            cath <## (bobIncognito <> ": contact is connected")
            cath <## ("#team: " <> bobIncognito <> " invites you to join the group as member")
@@ -3436,7 +3439,7 @@ testGroupLinkIncognitoMembership =
        [ do
            bob <## (danIncognito <> ": contact is connected, your incognito profile for this contact is " <> bobIncognito)
            bob <## ("use /info " <> danIncognito <> " to print out this incognito profile again")
-            bob <## ("invitation to join the group #team sent to " <> danIncognito),
+            bob <## (danIncognito <> " invited to group #team via your group link"),
          do
            dan <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> danIncognito)
            dan <## ("use /info " <> bobIncognito <> " to print out this incognito profile again")