core: create business chat when preparing via contact link data with business flag (#6008)

* core: create business chat when preparing via contact link data with business flag

* add to test

* plans

* ios

* ios

src/Simplex/Chat/Library/Commands.hs

@@ -1735,22 +1735,38 @@ processChatCommand' vr = \case
         pure conn'
   APIConnectPlan userId cLink -> withUserId userId $ \user ->
     uncurry (CRConnectionPlan user) <$> connectPlan user cLink
-  APIPrepareContact userId accLink@(ACCL _ (CCLink cReq _)) contactSLinkData -> withUserId userId $ \user -> do
+  APIPrepareContact userId accLink contactSLinkData -> withUserId userId $ \user -> do
     let ContactShortLinkData {profile, message, business} = contactSLinkData
-    -- TODO [short links] create business contact as group
-    ct <- withStore $ \db -> createPreparedContact db user profile accLink
-    let createItem content = createInternalItemForChat user (CDDirectRcv ct) False content Nothing
-        cInfo = DirectChat ct
-    void $ createItem $ CIRcvDirectE2EEInfo $ E2EInfo $ connRequestPQEncryption cReq
-    void $ createFeatureEnabledItems_ user ct
-    aci <- mapM (createItem . CIRcvMsgContent . MCText) message
-    let chat = case aci of
-          Just (AChatItem SCTDirect dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
-          _ -> Chat cInfo [] emptyChatStats
-    pure $ CRNewPreparedChat user $ AChat SCTDirect chat
+    case accLink of
+      ACCL SCMContact ccLink
+        | business -> do
+            let Profile {preferences} = profile
+                groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences
+                groupProfile = businessGroupProfile profile groupPreferences
+            (gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user groupProfile True ccLink
+            let cd = CDGroupRcv gInfo Nothing hostMember
+                createItem content = createInternalItemForChat user cd True content Nothing
+                cInfo = GroupChat gInfo Nothing
+            void $ createGroupFeatureItems_ user cd True CIRcvGroupFeature gInfo
+            aci <- mapM (createItem . CIRcvMsgContent . MCText) message
+            let chat = case aci of
+                  Just (AChatItem SCTGroup dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
+                  _ -> Chat cInfo [] emptyChatStats
+            pure $ CRNewPreparedChat user $ AChat SCTGroup chat
+      ACCL _ (CCLink cReq _) -> do
+        ct <- withStore $ \db -> createPreparedContact db user profile accLink
+        let createItem content = createInternalItemForChat user (CDDirectRcv ct) False content Nothing
+            cInfo = DirectChat ct
+        void $ createItem $ CIRcvDirectE2EEInfo $ E2EInfo $ connRequestPQEncryption cReq
+        void $ createFeatureEnabledItems_ user ct
+        aci <- mapM (createItem . CIRcvMsgContent . MCText) message
+        let chat = case aci of
+              Just (AChatItem SCTDirect dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
+              _ -> Chat cInfo [] emptyChatStats
+        pure $ CRNewPreparedChat user $ AChat SCTDirect chat
   APIPrepareGroup userId ccLink groupSLinkData -> withUserId userId $ \user -> do
     let GroupShortLinkData {groupProfile = gp@GroupProfile {description}} = groupSLinkData
-    (gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user gp ccLink
+    (gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user gp False ccLink
     let cd = CDGroupRcv gInfo Nothing hostMember
         createItem content = createInternalItemForChat user cd True content Nothing
         cInfo = GroupChat gInfo Nothing

src/Simplex/Chat/Library/Internal.hs

@@ -1023,10 +1023,10 @@ acceptBusinessJoinRequestAsync
     createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = Just PQEncOff}) Nothing
     createGroupFeatureItems user cd CISndGroupFeature gInfo
     pure (gInfo, clientMember)
-    where
-      businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile
-      businessGroupProfile Profile {displayName, fullName, image} groupPreferences =
-        GroupProfile {displayName, fullName, description = Nothing, image, groupPreferences = Just groupPreferences, memberAdmission = Nothing}
+
+businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile
+businessGroupProfile Profile {displayName, fullName, image} groupPreferences =
+  GroupProfile {displayName, fullName, description = Nothing, image, groupPreferences = Just groupPreferences, memberAdmission = Nothing}
 
 profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Bool -> Profile
 profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ip) Nothing
@@ -2355,7 +2355,7 @@ sameGroupProfileInfo p p' = p {groupPreferences = Nothing} == p' {groupPreferenc
 createGroupFeatureItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> CM ()
 createGroupFeatureItems user cd ciContent g = createGroupFeatureItems_ user cd False ciContent g >>= toView . CEvtNewChatItems user
 
-createGroupFeatureItems_ :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> Bool -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> CM [AChatItem]
+createGroupFeatureItems_ :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> ShowGroupAsSender -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> CM [AChatItem]
 createGroupFeatureItems_ user cd showGroupAsSender ciContent GroupInfo {fullGroupPreferences} =
   forM allGroupFeatures $ \(AGF f) -> do
     let p = getGroupPreference f fullGroupPreferences
@@ -2367,7 +2367,7 @@ createInternalChatItem user cd content itemTs_ = do
   ci <- createInternalItemForChat user cd False content itemTs_
   toView $ CEvtNewChatItems user [ci]
 
-createInternalItemForChat :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> Bool -> CIContent d -> Maybe UTCTime -> CM AChatItem
+createInternalItemForChat :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe UTCTime -> CM AChatItem
 createInternalItemForChat user cd showGroupAsSender content itemTs_ =
   lift (createInternalItemsForChats user itemTs_ [(cd, showGroupAsSender, [content])]) >>= \case
     [Right ci] -> pure ci

src/Simplex/Chat/Store/Groups.hs

@@ -525,15 +525,16 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {
   DB.execute db "DELETE FROM contacts WHERE contact_id = ?" (Only contactId)
   DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
 
-createPreparedGroup :: DB.Connection -> VersionRangeChat -> User -> GroupProfile -> CreatedLinkContact -> ExceptT StoreError IO (GroupInfo, GroupMember)
-createPreparedGroup db vr user@User {userId, userContactId} groupProfile connLinkToConnect = do
+createPreparedGroup :: DB.Connection -> VersionRangeChat -> User -> GroupProfile -> Bool -> CreatedLinkContact -> ExceptT StoreError IO (GroupInfo, GroupMember)
+createPreparedGroup db vr user@User {userId, userContactId} groupProfile business connLinkToConnect = do
   currentTs <- liftIO getCurrentTime
   (groupId, groupLDN) <- createGroup_ db userId groupProfile (Just connLinkToConnect) Nothing currentTs
   hostMemberId <- insertHost_ currentTs groupId groupLDN
   let userMember = MemberIdRole (MemberId $ encodeUtf8 groupLDN <> "_user_unknown_id") GRMember
-  void $ createContactMemberInv_ db user groupId (Just hostMemberId) user userMember GCUserMember GSMemUnknown IBUnknown Nothing currentTs vr
-  g <- getGroupInfo db vr user groupId
+  membership <- createContactMemberInv_ db user groupId (Just hostMemberId) user userMember GCUserMember GSMemUnknown IBUnknown Nothing currentTs vr
   hostMember <- getGroupMember db vr user groupId hostMemberId
+  when business $ liftIO $ setGroupBusinessChatInfo groupId membership hostMember
+  g <- getGroupInfo db vr user groupId
   pure (g, hostMember)
   where
     insertHost_ currentTs groupId groupLDN = do
@@ -553,6 +554,23 @@ createPreparedGroup db vr user@User {userId, userContactId} groupProfile connLin
               :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
           )
         insertedRowId db
+    setGroupBusinessChatInfo :: GroupId -> GroupMember -> GroupMember -> IO ()
+    setGroupBusinessChatInfo groupId membership hostMember = do
+      let businessChatInfo = Just BusinessChatInfo {chatType = BCBusiness, businessId = memberId' hostMember, customerId = memberId' membership}
+      updateBusinessChatInfo db groupId businessChatInfo
+
+updateBusinessChatInfo :: DB.Connection -> GroupId -> Maybe BusinessChatInfo -> IO ()
+updateBusinessChatInfo db groupId businessChatInfo =
+  DB.execute
+    db
+    [sql|
+      UPDATE groups
+      SET business_chat = ?,
+          business_member_id = ?,
+          customer_member_id = ?
+      WHERE group_id = ?
+    |]
+    (businessChatInfoRow businessChatInfo :. (Only groupId))
 
 updatePreparedGroupUser :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> User -> ExceptT StoreError IO GroupInfo
 updatePreparedGroupUser db vr user gInfo@GroupInfo {groupId, membership} hostMember newUser@User {userId = newUserId} = do
@@ -619,33 +637,36 @@ updatePreparedGroupUser db vr user gInfo@GroupInfo {groupId, membership} hostMem
             safeDeleteLDN db user oldHostLDN
 
 updatePreparedUserAndHostMembersInvited :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
-updatePreparedUserAndHostMembersInvited db vr user gInfo hostMember GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted} = do
+updatePreparedUserAndHostMembersInvited db vr user gInfo hostMember GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
   let fromMemberProfile = profileFromName fromMemberName
       initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted
-  updatePreparedUserAndHostMembers' db vr user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile initialStatus
+  updatePreparedUserAndHostMembers' db vr user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile business initialStatus
 
 updatePreparedUserAndHostMembersRejected :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
 updatePreparedUserAndHostMembersRejected db vr user gInfo hostMember GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
   let fromMemberProfile = profileFromName $ nameFromMemberId memberId
-  updatePreparedUserAndHostMembers' db vr user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile GSMemRejected
+  updatePreparedUserAndHostMembers' db vr user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected
 
-updatePreparedUserAndHostMembers' :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
+updatePreparedUserAndHostMembers' :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
 updatePreparedUserAndHostMembers'
   db
   vr
   user
-  gInfo@GroupInfo {groupId, groupProfile = gp}
+  gInfo@GroupInfo {groupId, groupProfile = gp, businessChat}
   hostMember
   fromMember
   fromMemberProfile
   invitedMember
   groupProfile
+  business
   membershipStatus = do
     currentTs <- liftIO getCurrentTime
     liftIO $ updateUserMember currentTs
     hostMember' <- updateHostMember currentTs
     when (gp /= groupProfile) $
       void $ updateGroupProfile db user gInfo groupProfile
+    when (isJust businessChat && isJust business) $
+      liftIO $ updateBusinessChatInfo db groupId business
     gInfo' <- getGroupInfo db vr user groupId
     pure (gInfo', hostMember')
     where

src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt

@@ -4562,6 +4562,16 @@ Query:
 Plan:
 SEARCH group_snd_item_statuses USING INDEX idx_group_snd_item_statuses_chat_item_id_group_member_id (chat_item_id=? AND group_member_id=?)
 
+Query: 
+      UPDATE groups
+      SET business_chat = ?,
+          business_member_id = ?,
+          customer_member_id = ?
+      WHERE group_id = ?
+    
+Plan:
+SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: 
       UPDATE groups
       SET members_require_attention = members_require_attention + 1

src/Simplex/Chat/View.hs

@@ -1888,7 +1888,7 @@ viewGroupUserChanged
 viewConnectionPlan :: ChatConfig -> ACreatedConnLink -> ConnectionPlan -> [StyledString]
 viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
   CPInvitationLink ilp -> case ilp of
-    ILPOk contactSLinkData -> [invLink "ok to connect"] <> [viewJSON contactSLinkData | testView]
+    ILPOk contactSLinkData -> [invOrBiz contactSLinkData "ok to connect"] <> [viewJSON contactSLinkData | testView]
     ILPOwnLink -> [invLink "own link"]
     ILPConnecting Nothing -> [invLink "connecting"]
     ILPConnecting (Just ct) -> [invLink ("connecting to contact " <> ttyContact' ct)]
@@ -1898,8 +1898,12 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
       ]
     where
       invLink = ("invitation link: " <>)
+      invOrBiz = \case
+        Just ContactShortLinkData {business}
+          | business -> ("business link: " <>)
+        _ -> ("invitation link: " <>)
   CPContactAddress cap -> case cap of
-    CAPOk contactSLinkData -> [ctAddr "ok to connect"] <> [viewJSON contactSLinkData | testView]
+    CAPOk contactSLinkData -> [addrOrBiz contactSLinkData "ok to connect"] <> [viewJSON contactSLinkData | testView]
     CAPOwnLink -> [ctAddr "own address"]
     CAPConnectingConfirmReconnect -> [ctAddr "connecting, allowed to reconnect"]
     CAPConnectingProhibit ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
@@ -1910,6 +1914,10 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
     CAPContactViaAddress ct -> [ctAddr ("known contact without connection " <> ttyContact' ct)]
     where
       ctAddr = ("contact address: " <>)
+      addrOrBiz = \case
+        Just ContactShortLinkData {business}
+          | business -> ("business link: " <>)
+        _ -> ("contact address: " <>)
   CPGroupLink glp -> case glp of
     GLPOk groupSLinkData -> [grpLink "ok to connect"] <> [viewJSON groupSLinkData | testView]
     GLPOwnLink g -> [grpLink "own link for group " <> ttyGroup' g]