core, ios: improve business address (connection plan, repeat requests, feature items) (#5303)

* core, ios: connection plan for business address * core: store xcontact_id on business groups to prevent duplicate contact requests * core: create feature items in new groups and in business groups * fix tests * error message
2026-05-26 03:14:36 +00:00 · 2024-12-03 12:11:38 +00:00
parent e61babdc8f
commit 9d992735f4
17 changed files with 195 additions and 132 deletions
@@ -669,6 +669,7 @@ data ChatResponse
  | CRAcceptingBusinessRequest {user :: User, groupInfo :: GroupInfo}
  | CRContactAlreadyExists {user :: User, contact :: Contact}
  | CRContactRequestAlreadyAccepted {user :: User, contact :: Contact}
+  | CRBusinessRequestAlreadyAccepted {user :: User, groupInfo :: GroupInfo}
  | CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
  | CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo}
  | CRForwardPlan {user :: User, itemsCount :: Int, chatItemIds :: [ChatItemId], forwardConfirmation :: Maybe ForwardConfirmation}
@@ -11,12 +11,18 @@ m20241128_business_chats =
 ALTER TABLE user_contact_links ADD business_address INTEGER DEFAULT 0;
 ALTER TABLE groups ADD COLUMN business_member_id BLOB NULL;
 ALTER TABLE groups ADD COLUMN business_chat TEXT NULL;
+ALTER TABLE groups ADD COLUMN business_xcontact_id BLOB NULL;
+
+CREATE INDEX idx_groups_business_xcontact_id ON groups(business_xcontact_id);
 |]

 down_m20241128_business_chats :: Query
 down_m20241128_business_chats =
  [sql|
+DROP INDEX idx_groups_business_xcontact_id;
+
 ALTER TABLE user_contact_links DROP COLUMN business_address;
 ALTER TABLE groups DROP COLUMN business_member_id;
 ALTER TABLE groups DROP COLUMN business_chat;
+ALTER TABLE groups DROP COLUMN business_xcontact_id;
 |]
@@ -129,7 +129,8 @@ CREATE TABLE groups(
  custom_data BLOB,
  ui_themes TEXT,
  business_member_id BLOB NULL,
-  business_chat TEXT NULL, -- received
+  business_chat TEXT NULL,
+  business_xcontact_id BLOB NULL, -- received
  FOREIGN KEY(user_id, local_display_name)
  REFERENCES display_names(user_id, local_display_name)
  ON DELETE CASCADE
@@ -926,3 +927,4 @@ CREATE INDEX idx_chat_items_notes ON chat_items(
  item_status,
  created_at
 );
+CREATE INDEX idx_groups_business_xcontact_id ON groups(business_xcontact_id);
@@ -102,6 +102,7 @@ import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Crypto.Ratchet (PQSupport)
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
+import Simplex.Messaging.Util ((<$$>))
 import Simplex.Messaging.Version

 getPendingContactConnection :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO PendingContactConnection
@@ -591,13 +592,17 @@ getUserContacts db vr user@User {userId} = do
  contacts <- rights <$> mapM (runExceptT . getContact db vr user) contactIds
  pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts

-createOrUpdateContactRequest :: DB.Connection -> VersionRangeChat -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> ExceptT StoreError IO ContactOrRequest
-createOrUpdateContactRequest db vr user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ pqSup =
-  liftIO (maybeM getContact' xContactId_) >>= \case
-    Just contact -> pure $ CORContact contact
+createOrUpdateContactRequest :: DB.Connection -> VersionRangeChat -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> ExceptT StoreError IO ChatOrRequest
+createOrUpdateContactRequest db vr user@User {userId, userContactId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ pqSup =
+  liftIO (maybeM getContactOrGroup xContactId_) >>= \case
+    Just cr -> pure cr
    Nothing -> CORRequest <$> createOrUpdate_
  where
    maybeM = maybe (pure Nothing)
+    getContactOrGroup xContactId =
+      getContact' xContactId >>= \case
+        Just ct -> pure $ Just $ CORContact ct
+        Nothing -> CORGroup <$$> getGroupInfo' xContactId
    createOrUpdate_ :: ExceptT StoreError IO UserContactRequest
    createOrUpdate_ = do
      cReqId <-
@@ -651,6 +656,13 @@ createOrUpdateContactRequest db vr user@User {userId} userContactLinkId invId (V
            LIMIT 1
          |]
          (userId, xContactId)
+    getGroupInfo' :: XContactId -> IO (Maybe GroupInfo)
+    getGroupInfo' xContactId =
+      maybeFirstRow (toGroupInfo vr userContactId) $
+        DB.query
+          db
+          (groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
+          (xContactId, userId, userContactId)
    getContactRequestByXContactId :: XContactId -> IO (Maybe UserContactRequest)
    getContactRequestByXContactId xContactId =
      maybeFirstRow toContactRequest $
@@ -155,31 +155,8 @@ import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
 import Simplex.Messaging.Version
 import UnliftIO.STM

-type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe MemberId, Maybe BusinessChatType, Maybe UIThemeEntityOverrides, Maybe CustomData) :. GroupMemberRow
-
-type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
-
 type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))

-toGroupInfo :: VersionRangeChat -> Int64 -> GroupInfoRow -> GroupInfo
-toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, businessMemberId, businessChatType, uiThemes, customData) :. userMemberRow) =
-  let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
-      chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
-      fullGroupPreferences = mergeGroupPreferences groupPreferences
-      groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
-      businessChat = BusinessChatInfo <$> businessMemberId <*> businessChatType
-   in GroupInfo {groupId, localDisplayName, groupProfile, businessChat, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, uiThemes, customData}
-
-toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
-toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
-  let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
-      memberSettings = GroupMemberSettings {showMessages}
-      blockedByAdmin = maybe False mrsBlocked memberRestriction_
-      invitedBy = toInvitedBy userContactId invitedById
-      activeConn = Nothing
-      memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
-   in GroupMember {..}
-
 toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
 toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
  Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
@@ -937,7 +914,7 @@ createBusinessRequestGroup
  vr
  gVar
  user@User {userId, userContactId}
-  UserContactRequest {cReqChatVRange, profile = Profile {displayName, fullName, image, contactLink, preferences}}
+  UserContactRequest {cReqChatVRange, xContactId, profile = Profile {displayName, fullName, image, contactLink, preferences}}
  groupPreferences = do
    currentTs <- liftIO getCurrentTime
    groupInfo <- insertGroup_ currentTs
@@ -959,10 +936,10 @@ createBusinessRequestGroup
              [sql|
                INSERT INTO groups
                  (group_profile_id, local_display_name, user_id, enable_ntfs,
-                   created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat)
-                VALUES (?,?,?,?,?,?,?,?,?)
+                   created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_xcontact_id)
+                VALUES (?,?,?,?,?,?,?,?,?,?)
              |]
-              (profileId, localDisplayName, userId, True, currentTs, currentTs, currentTs, currentTs, BCCustomer)
+              (profileId, localDisplayName, userId, True, currentTs, currentTs, currentTs, currentTs, BCCustomer, xContactId)
            insertedRowId db
          memberId <- liftIO $ encodedRandomBytes gVar 12
          void $ createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs vr
@@ -1484,22 +1461,7 @@ getGroupInfo db vr User {userId, userContactId} groupId =
  ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $
    DB.query
      db
-      [sql|
-        SELECT
-          -- GroupInfo
-          g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
-          g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
-          g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_member_id, g.business_chat, g.ui_themes, g.custom_data,
-          -- GroupMember - membership
-          mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
-          mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-          pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
-        FROM groups g
-        JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
-        JOIN group_members mu ON mu.group_id = g.group_id
-        JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
-        WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?
-      |]
+      (groupInfoQuery <> " WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?")
      (groupId, userId, userContactId)

 getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
@@ -5,6 +5,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeOperators #-}
@@ -33,6 +34,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
+import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
 import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
@@ -543,3 +545,44 @@ safeDeleteLDN db User {userId} localDisplayName = do
        AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
    |]
    (userId, localDisplayName, userId)
+
+type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe MemberId, Maybe BusinessChatType, Maybe UIThemeEntityOverrides, Maybe CustomData) :. GroupMemberRow
+
+type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
+
+toGroupInfo :: VersionRangeChat -> Int64 -> GroupInfoRow -> GroupInfo
+toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, businessMemberId, businessChatType, uiThemes, customData) :. userMemberRow) =
+  let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
+      chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
+      fullGroupPreferences = mergeGroupPreferences groupPreferences
+      groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
+      businessChat = BusinessChatInfo <$> businessMemberId <*> businessChatType
+   in GroupInfo {groupId, localDisplayName, groupProfile, businessChat, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, uiThemes, customData}
+
+toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
+toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
+  let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
+      memberSettings = GroupMemberSettings {showMessages}
+      blockedByAdmin = maybe False mrsBlocked memberRestriction_
+      invitedBy = toInvitedBy userContactId invitedById
+      activeConn = Nothing
+      memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
+   in GroupMember {..}
+
+groupInfoQuery :: Query
+groupInfoQuery =
+  [sql|
+    SELECT
+      -- GroupInfo
+      g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
+      g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
+      g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_member_id, g.business_chat, g.ui_themes, g.custom_data,
+      -- GroupMember - membership
+      mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
+      mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
+      pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
+    FROM groups g
+    JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
+    JOIN group_members mu ON mu.group_id = g.group_id
+    JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
+  |]
@@ -349,7 +349,7 @@ instance ToJSON ConnReqUriHash where
  toJSON = strToJSON
  toEncoding = strToJEncoding

-data ContactOrRequest = CORContact Contact | CORRequest UserContactRequest
+data ChatOrRequest = CORContact Contact | CORGroup GroupInfo | CORRequest UserContactRequest

 type UserName = Text

@@ -207,6 +207,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
  CRAcceptingBusinessRequest u g -> ttyUser u $ viewAcceptingBusinessRequest g
  CRContactAlreadyExists u c -> ttyUser u [ttyFullContact c <> ": contact already exists"]
  CRContactRequestAlreadyAccepted u c -> ttyUser u [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
+  CRBusinessRequestAlreadyAccepted u g -> ttyUser u [ttyFullGroup g <> ": sent you a duplicate connection request, but you are already connected, no action needed"]
  CRUserContactLinkCreated u cReq -> ttyUser u $ connReqContact_ "Your new chat address is created!" cReq
  CRUserContactLinkDeleted u -> ttyUser u viewUserContactLinkDeleted
  CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
@@ -1670,13 +1671,16 @@ viewConnectionPlan = \case
    GLPOwnLink g -> [grpLink "own link for group " <> ttyGroup' g]
    GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
    GLPConnectingProhibit Nothing -> [grpLink "connecting"]
-    GLPConnectingProhibit (Just g) -> [grpLink ("connecting to group " <> ttyGroup' g)]
+    GLPConnectingProhibit (Just g) -> [grpOrBiz g <> " link: connecting to " <> grpOrBiz g <> " " <> ttyGroup' g]
    GLPKnown g ->
-      [ grpLink ("known group " <> ttyGroup' g),
+      [ grpOrBiz g <> " link: known " <> grpOrBiz g <> " " <> ttyGroup' g,
        "use " <> ttyToGroup g <> highlight' "<message>" <> " to send messages"
      ]
    where
      grpLink = ("group link: " <>)
+      grpOrBiz GroupInfo {businessChat} = case businessChat of
+        Just _ -> "business"
+        Nothing -> "group"

 viewContactUpdated :: Contact -> Contact -> [StyledString]
 viewContactUpdated