core: update business chat profile (#5313)

* core: update business chat profile * fix, test * refactor * test changing non-title member profile * fix history
2024-12-17 17:20:21 +01:00 · 2024-12-04 16:32:01 +00:00
parent 4f1cf6e79f
commit 89f380400e
4 changed files with 131 additions and 27 deletions
@@ -5110,7 +5110,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
            void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
            sendIntroductions members
            when (groupFeatureAllowed SGFHistory gInfo) sendHistory
-            when (connChatVersion < batchSend2Version) $ sendGroupAutoReply members
+            when (connChatVersion < batchSend2Version) sendGroupAutoReply
            where
              sendXGrpLinkMem = do
                let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
@@ -5145,7 +5145,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                withStore' $ \db -> updateIntroStatus db introId GMIntroSent
              sendHistory =
                when (m `supportsVersion` batchSendVersion) $ do
-                  (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo 100)
+                  (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100)
                  (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items
                  let errors = map ChatErrorStore errs <> errs'
                  unless (null errors) $ toView $ CRChatErrors (Just user) errors
@@ -5376,9 +5376,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
      JOINED sqSecured ->
        -- [async agent commands] continuation on receiving JOINED
        when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData ->
-          when sqSecured $ do
-            members <- withStore' $ \db -> getGroupMembers db vr user gInfo
-            when (connChatVersion >= batchSend2Version) $ sendGroupAutoReply members
+          when (sqSecured && connChatVersion >= batchSend2Version) sendGroupAutoReply
      QCONT -> do
        continued <- continueSending connEntity conn
        when continued $ sendPendingGroupMessages user m conn
@@ -5406,7 +5404,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
        updateGroupItemsErrorStatus db msgId groupMemberId newStatus = do
          itemIds <- getChatItemIdsByAgentMsgId db connId msgId
          forM_ itemIds $ \itemId -> updateGroupMemSndStatus' db itemId groupMemberId newStatus
-        sendGroupAutoReply members = autoReplyMC >>= mapM_ send
+        sendGroupAutoReply = autoReplyMC >>= mapM_ send
          where
            autoReplyMC = do
              let GroupInfo {businessChat} = gInfo
@@ -5420,8 +5418,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                      _ -> Nothing
                _ -> pure Nothing
            send mc = do
-              msg <- sendGroupMessage' user gInfo members (XMsgNew $ MCSimple (extMsgContent mc Nothing))
+              msg <- sendGroupMessage' user gInfo [m] (XMsgNew $ MCSimple (extMsgContent mc Nothing))
              ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent mc)
+              withStore' $ \db -> createGroupSndStatus db (chatItemId' ci) (groupMemberId' m) GSSNew
              toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]

    agentMsgDecryptError :: AgentCryptoError -> (MsgDecryptError, Word32)
@@ -6459,7 +6458,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =

    processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember
    processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_
-      | redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' =
+      | redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' = do
+          updateBusinessChatProfile gInfo m
          case memberContactId of
            Nothing -> do
              m' <- withStore $ \db -> updateMemberProfile db user m p'
@@ -6485,6 +6485,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
      | otherwise =
          pure m
      where
+        updateBusinessChatProfile g@GroupInfo {businessChat} GroupMember {memberId} = case businessChat of
+          Just BusinessChatInfo {memberId = mId} | mId == memberId -> do
+            g' <- withStore $ \db -> updateGroupProfileFromMember db user g p'
+            toView $ CRGroupUpdated user g g' (Just m)
+          _ -> pure ()
        createProfileUpdatedItem m' =
          when createItems $ do
            let ciContent = CIRcvGroupEvent $ RGEMemberProfileUpdated (fromLocalProfile p) p'
@@ -39,6 +39,7 @@ module Simplex.Chat.Store.Groups
    getGroupInfoByUserContactLinkConnReq,
    getGroupInfoByGroupLinkHash,
    updateGroupProfile,
+    updateGroupProfileFromMember,
    getGroupIdByName,
    getGroupMemberIdByName,
    getActiveMembersByName,
@@ -917,11 +918,12 @@ createBusinessRequestGroup
  UserContactRequest {cReqChatVRange, xContactId, profile = Profile {displayName, fullName, image, contactLink, preferences}}
  groupPreferences = do
    currentTs <- liftIO getCurrentTime
-    groupInfo <- insertGroup_ currentTs
-    (groupMemberId, memberId) <- insertClientMember_ currentTs groupInfo
-    groupInfo' <- liftIO $ setBusinessMemberId groupInfo memberId
+    (groupId, membership) <- insertGroup_ currentTs
+    (groupMemberId, memberId) <- insertClientMember_ currentTs groupId membership
+    liftIO $ DB.execute db "UPDATE groups SET business_member_id = ? WHERE group_id = ?" (memberId, groupId)
+    groupInfo <- getGroupInfo db vr user groupId
    clientMember <- getGroupMemberById db vr user groupMemberId
-    pure (groupInfo', clientMember)
+    pure (groupInfo, clientMember)
    where
      insertGroup_ currentTs = ExceptT $
        withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
@@ -942,10 +944,10 @@ createBusinessRequestGroup
              (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
-          getGroupInfo db vr user groupId
+          membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs vr
+          pure (groupId, membership)
      VersionRange minV maxV = cReqChatVRange
-      insertClientMember_ currentTs GroupInfo {groupId, membership} = ExceptT $ do
+      insertClientMember_ currentTs groupId membership = ExceptT $ do
        withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
          liftIO $
            DB.execute
@@ -969,9 +971,6 @@ createBusinessRequestGroup
              )
            groupMemberId <- liftIO $ insertedRowId db
            pure (groupMemberId, MemberId memId)
-      setBusinessMemberId groupInfo@GroupInfo {groupId} memberId = do
-        DB.execute db "UPDATE groups SET business_member_id = ? WHERE group_id = ?" (memberId, groupId)
-        pure (groupInfo {businessChat = Just BusinessChatInfo {memberId, chatType = BCCustomer}} :: GroupInfo)

 getContactViaMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> ExceptT StoreError IO Contact
 getContactViaMember db vr user@User {userId} GroupMember {groupMemberId} = do
@@ -1457,6 +1456,27 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
        (ldn, currentTs, userId, groupId)
      safeDeleteLDN db user localDisplayName

+updateGroupProfileFromMember :: DB.Connection -> User -> GroupInfo -> Profile -> ExceptT StoreError IO GroupInfo
+updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName = n, fullName = fn, image = img} = do
+  p <- getGroupProfile -- to avoid any race conditions with UI
+  let g' = g {groupProfile = p} :: GroupInfo
+      p' = p {displayName = n, fullName = fn, image = img} :: GroupProfile
+  updateGroupProfile db user g' p'
+  where
+    getGroupProfile =
+      ExceptT $ firstRow toGroupProfile (SEGroupNotFound groupId) $
+        DB.query
+          db
+          [sql|
+            SELECT gp.display_name, gp.full_name, gp.description, gp.image, gp.preferences
+            FROM group_profiles gp
+            JOIN groups g ON gp.group_profile_id = g.group_profile_id
+            WHERE g.group_id = ?
+          |]
+          (Only groupId)
+    toGroupProfile (displayName, fullName, description, image, groupPreferences) =
+      GroupProfile {displayName, fullName, description, image, groupPreferences}
+
 getGroupInfo :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO GroupInfo
 getGroupInfo db vr User {userId, userContactId} groupId =
  ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $
@@ -3034,8 +3034,8 @@ getGroupSndStatusCounts db itemId =
    |]
    (Only itemId)

-getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
-getGroupHistoryItems db user@User {userId} GroupInfo {groupId} count = do
+getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> GroupMember -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
+getGroupHistoryItems db user@User {userId} GroupInfo {groupId} m count = do
  ciIds <- getLastItemIds_
  -- use getGroupCIWithReactions to read reactions data
  reverse <$> mapM (runExceptT . getGroupChatItem db user groupId) ciIds
@@ -3046,12 +3046,14 @@ getGroupHistoryItems db user@User {userId} GroupInfo {groupId} count = do
        <$> DB.query
          db
          [sql|
-            SELECT chat_item_id
-            FROM chat_items
-            WHERE user_id = ? AND group_id = ?
-              AND item_content_tag IN (?,?)
-              AND item_deleted = 0
-            ORDER BY item_ts DESC, chat_item_id DESC
+            SELECT i.chat_item_id
+            FROM chat_items i
+            LEFT JOIN group_snd_item_statuses s ON s.chat_item_id = i.chat_item_id AND s.group_member_id = ?
+            WHERE i.user_id = ? AND i.group_id = ?
+              AND i.item_content_tag IN (?,?)
+              AND i.item_deleted = 0
+              AND s.group_snd_item_status_id IS NULL
+            ORDER BY i.item_ts DESC, i.chat_item_id DESC
            LIMIT ?
          |]
-          (userId, groupId, rcvMsgContentTag, sndMsgContentTag, count)
+          (groupMemberId' m, userId, groupId, rcvMsgContentTag, sndMsgContentTag, count)
@@ -49,6 +49,7 @@ chatProfileTests = do
    it "auto-reply message in incognito" testAutoReplyMessageInIncognito
    describe "business address" $ do
      it "create and connect via business address" testBusinessAddress
+      it "update profiles with business address" testBusinessUpdateProfiles
  describe "contact address connection plan" $ do
    it "contact address ok to connect; known contact" testPlanAddressOkKnown
    it "own contact address" testPlanAddressOwn
@@ -732,6 +733,82 @@ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice
      (alice <# "#bob bob_1> hey there")
      (biz <# "#bob bob_1> hey there")

+testBusinessUpdateProfiles :: HasCallStack => FilePath -> IO ()
+testBusinessUpdateProfiles = testChat3 businessProfile aliceProfile bobProfile $
+  \biz alice bob -> do
+    biz ##> "/ad"
+    cLink <- getContactLink biz True
+    biz ##> "/auto_accept on business text Welcome"
+    biz <## "auto_accept on, business"
+    biz <## "auto reply:"
+    biz <## "Welcome"
+    alice ##> ("/c " <> cLink)
+    alice <## "connection request sent!"
+    biz <## "#alice (Alice): accepting business address request..."
+    alice <## "#biz: joining the group..."
+    biz <# "#alice Welcome" -- auto reply
+    biz <## "#alice: alice_1 joined the group"
+    alice <# "#biz biz_1> Welcome"
+    alice <## "#biz: you joined the group"
+    biz #> "#alice hi"
+    alice <# "#biz biz_1> hi"
+    alice #> "#biz hello"
+    biz <# "#alice alice_1> hello"
+    alice ##> "/p alisa"
+    alice <## "user profile is changed to alisa (your 0 contacts are notified)"
+    alice #> "#biz hello again" -- profile update is sent with message
+    biz <## "alice_1 updated group #alice:"
+    biz <## "changed to #alisa"
+    biz <# "#alisa alisa_1> hello again"
+    -- customer can invite members too, if business allows
+    biz ##> "/mr alisa alisa_1 admin"
+    biz <## "#alisa: you changed the role of alisa_1 from member to admin"
+    alice <## "#biz: biz_1 changed your role from member to admin"
+    connectUsers alice bob
+    alice ##> "/a #biz bob"
+    alice <## "invitation to join the group #biz sent to bob"
+    bob <## "#biz (Biz Inc): alisa invites you to join the group as member"
+    bob <## "use /j biz to accept"
+    bob ##> "/j biz"
+    concurrentlyN_
+      [ do
+          bob <## "#biz: you joined the group"
+          bob
+            <###
+              [ WithTime "#biz biz_1> Welcome [>>]",
+                WithTime "#biz biz_1> hi [>>]",
+                WithTime "#biz alisa> hello [>>]",
+                WithTime "#biz alisa> hello again [>>]"
+              ]
+          bob <## "#biz: member biz_1 (Biz Inc) is connected",
+        alice <## "#biz: bob joined the group",
+        do
+          biz <## "#alisa: alisa_1 added bob (Bob) to the group (connecting...)"
+          biz <## "#alisa: new member bob is connected"
+      ]
+    -- changing other member profiles does not change group profile
+    bob ##> "/p robert"
+    bob <## "user profile is changed to robert (your 1 contacts are notified)"
+    alice <## "contact bob changed to robert" -- only alice receives profile update
+    alice <## "use @robert <message> to send messages"
+    bob #> "#biz hi there" -- profile update is sent to group with message
+    alice <# "#biz robert> hi there"
+    biz <# "#alisa robert> hi there"
+    -- both customers receive business profile change
+    biz ##> "/p business"
+    biz <## "user profile is changed to business (your 0 contacts are notified)"
+    biz #> "#alisa hey"
+    concurrentlyN_
+      [ do
+          alice <## "biz_1 updated group #biz:"
+          alice <## "changed to #business"
+          alice <# "#business business_1> hey",
+        do
+          bob <## "biz_1 updated group #biz:"
+          bob <## "changed to #business"
+          bob <# "#business business_1> hey"
+      ]
+
 testPlanAddressOkKnown :: HasCallStack => FilePath -> IO ()
 testPlanAddressOkKnown =
  testChat2 aliceProfile bobProfile $