From 89f380400e9b973f6b83417b069fbef88984c0dc Mon Sep 17 00:00:00 2001 From: Evgeny Date: Wed, 4 Dec 2024 16:32:01 +0000 Subject: [PATCH] core: update business chat profile (#5313) * core: update business chat profile * fix, test * refactor * test changing non-title member profile * fix history --- src/Simplex/Chat.hs | 21 ++++---- src/Simplex/Chat/Store/Groups.hs | 40 ++++++++++++---- src/Simplex/Chat/Store/Messages.hs | 20 ++++---- tests/ChatTests/Profiles.hs | 77 ++++++++++++++++++++++++++++++ 4 files changed, 131 insertions(+), 27 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 31862253dd..e78d6de288 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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' diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index dec4b6847e..895acf0a7d 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -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) $ diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index cff7f6b785..13cadcca77 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -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) diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index c5a464d969..ebfeecdbca 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -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 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 $