From d293104ce2d0ebc71f904db33288cc0898b6cfe1 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Wed, 11 Jun 2025 15:53:29 +0000 Subject: [PATCH] core: update short link data (#5983) --- src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 175 ++++++++------- src/Simplex/Chat/Library/Subscriber.hs | 17 +- src/Simplex/Chat/Store/Groups.hs | 2 +- src/Simplex/Chat/Store/Profiles.hs | 38 ++-- .../SQLite/Migrations/chat_query_plans.txt | 93 ++++---- src/Simplex/Chat/Types.hs | 1 - src/Simplex/Chat/View.hs | 14 +- tests/ChatTests/Profiles.hs | 206 ++++++++++++++++++ 9 files changed, 408 insertions(+), 140 deletions(-) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 42c81db7e8..4c3be59ba8 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -680,7 +680,7 @@ data ChatResponse | CRUserPrivacy {user :: User, updatedUser :: User} | CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]} | CRInvitation {user :: User, connLinkInvitation :: CreatedLinkInvitation, connection :: PendingContactConnection} - | CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection} + | CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection, customUserProfile :: Maybe Profile} | CRConnectionUserChanged {user :: User, fromConnection :: PendingContactConnection, toConnection :: PendingContactConnection, newUser :: User} | CRConnectionPlan {user :: User, connLink :: ACreatedConnLink, connectionPlan :: ConnectionPlan} | CRNewPreparedContact {user :: User, contact :: Contact} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 9af29228a6..663c925fc0 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1276,7 +1276,6 @@ processChatCommand' vr = \case APICallStatus contactId receivedStatus -> withCurrentCall contactId $ \user ct call -> updateCallItemStatus user ct call receivedStatus Nothing $> Just call - -- TODO [short links] update address short link data APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile) APISetContactPrefs contactId prefs' -> withUser $ \user -> do ct <- withFastStore $ \db -> getContact db vr user contactId @@ -1697,13 +1696,13 @@ processChatCommand' vr = \case conn' <- withFastStore' $ \db -> do pId <- createIncognitoProfile db user incognitoProfile updatePCCIncognito db user conn (Just pId) sLnk - pure $ CRConnectionIncognitoUpdated user conn' + pure $ CRConnectionIncognitoUpdated user conn' (Just incognitoProfile) (ConnNew, Just pId, False) -> do sLnk <- updatePCCShortLinkData conn (ContactShortLinkData (userProfileToSend user Nothing Nothing False) Nothing) conn' <- withFastStore' $ \db -> do deletePCCIncognitoProfile db user pId updatePCCIncognito db user conn Nothing sLnk - pure $ CRConnectionIncognitoUpdated user conn' + pure $ CRConnectionIncognitoUpdated user conn' Nothing _ -> throwChatError CEConnectionIncognitoChangeProhibited APIChangeConnectionUser connId newUserId -> withUser $ \user@User {userId} -> do conn <- withFastStore $ \db -> getPendingContactConnection db userId connId @@ -1851,7 +1850,7 @@ processChatCommand' vr = \case deleteAgentConnectionAsync $ aConnId conn withFastStore' (`deleteUserAddress` user) let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing} - r <- updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing + r <- updateProfile_ user p' False $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing let user' = case r of CRUserProfileUpdated u' _ _ _ -> u' _ -> user @@ -1863,37 +1862,37 @@ processChatCommand' vr = \case ShowMyAddress -> withUser' $ \User {userId} -> processChatCommand $ APIShowMyAddress userId APIAddMyAddressShortLink userId -> withUserId' userId $ \user -> do - (ucl@UserContactLink {connLinkContact = CCLink connFullLink _sLnk_, autoAccept}, conn) <- - withFastStore $ \db -> (,) <$> getUserAddress db user <*> getUserAddressConnection db vr user - let shortLinkProfile = userProfileToSend user Nothing Nothing False - shortLinkMsg = autoAccept >>= autoReply >>= (Just . msgContentText) - userData = encodeShortLinkData (ContactShortLinkData shortLinkProfile shortLinkMsg) - sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData Nothing) - case entityId conn of - Just uclId -> do - withFastStore' $ \db -> setUserContactLinkShortLink db uclId sLnk - let autoAccept' = autoAccept >>= \aa -> Just aa {acceptIncognito = False} - ucl' = (ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk), shortLinkDataSet = True, autoAccept = autoAccept'} - pure $ CRUserContactLink user ucl' - Nothing -> throwChatError $ CEException "no user contact link id" + ucl <- withFastStore $ \db -> getUserAddress db user + setMyAddressData user ucl APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing} - updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing + updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing APISetProfileAddress userId True -> withUserId userId $ \user@User {profile = p} -> do ucl@UserContactLink {connLinkContact = CCLink cReq _} <- withFastStore (`getUserAddress` user) -- TODO [short links] replace with short links let p' = (fromLocalProfile p :: Profile) {contactLink = Just $ CLFull cReq} - updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl + updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl SetProfileAddress onOff -> withUser $ \User {userId} -> processChatCommand $ APISetProfileAddress userId onOff APIAddressAutoAccept userId autoAccept_ -> withUserId userId $ \user -> do - -- TODO [short links] update adress short link data if message changed - UserContactLink {shortLinkDataSet} <- withFastStore (`getUserAddress` user) + ucl@UserContactLink {userContactLinkId, shortLinkDataSet, autoAccept} <- withFastStore (`getUserAddress` user) forM_ autoAccept_ $ \AutoAccept {businessAddress, acceptIncognito} -> do when (shortLinkDataSet && acceptIncognito) $ throwCmdError "incognito not allowed for address with short link data" when (businessAddress && acceptIncognito) $ throwCmdError "requests to business address cannot be accepted incognito" - contactLink <- withFastStore (\db -> updateUserAddressAutoAccept db user autoAccept_) - pure $ CRUserContactLinkUpdated user contactLink + let ucl' = ucl {autoAccept = autoAccept_} + ucl'' <- + if shortLinkDataSet && replyMsgChanged autoAccept autoAccept_ + then setMyAddressData user ucl' >>= \case + CRUserContactLink _ ucl'' -> pure ucl'' + cr -> throwCmdError $ "unexpected response from setMyAddressData: " <> show cr + else pure ucl' + withFastStore' $ \db -> updateUserAddressAutoAccept db userContactLinkId autoAccept_ + pure $ CRUserContactLinkUpdated user ucl'' + where + replyMsgChanged prevAutoAccept newAutoAccept = + let prevReplyMsg = prevAutoAccept >>= autoReply + newReplyMsg = newAutoAccept >>= autoReply + in newReplyMsg /= prevReplyMsg AddressAutoAccept autoAccept_ -> withUser $ \User {userId} -> processChatCommand $ APIAddressAutoAccept userId autoAccept_ AcceptContact incognito cName -> withUser $ \User {userId} -> do @@ -2434,7 +2433,6 @@ processChatCommand' vr = \case processChatCommand $ APIListGroups userId (contactId' <$> ct_) search_ APIUpdateGroupProfile groupId p' -> withUser $ \user -> do g <- withFastStore $ \db -> getGroup db vr user groupId - -- TODO [short links] update group link short link data runUpdateGroupProfile user g p' UpdateGroupNames gName GroupProfile {displayName, fullName} -> updateGroupProfileByName gName $ \p -> p {displayName, fullName} @@ -2478,18 +2476,11 @@ processChatCommand' vr = \case gLnk <- withFastStore $ \db -> getGroupLink db user gInfo pure $ CRGroupLink user gInfo gLnk APIAddGroupShortLink groupId -> withUser $ \user -> do - (gInfo, gLink, conn) <- withFastStore $ \db -> do + (gInfo, gLink) <- withFastStore $ \db -> do gInfo <- getGroupInfo db vr user groupId gLink <- getGroupLink db user gInfo - conn <- getGroupLinkConnection db vr user gInfo - pure (gInfo, gLink, conn) - let GroupInfo {groupProfile} = gInfo - userData = encodeShortLinkData (GroupShortLinkData groupProfile) - GroupLink {groupLinkId} = gLink - crClientData = encodeJSON $ CRDataGroup groupLinkId - sLnk <- shortenShortLink' . toShortGroupLink =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData (Just crClientData)) - gLink' <- withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk - pure $ CRGroupLink user gInfo gLink' + pure (gInfo, gLink) + setGroupLinkData user gInfo gLink APICreateMemberContact gId gMemberId -> withUser $ \user -> do (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId assertUserGroupRole g GRAuthor @@ -2983,9 +2974,9 @@ processChatCommand' vr = \case when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f pure fileSize updateProfile :: User -> Profile -> CM ChatResponse - updateProfile user p' = updateProfile_ user p' $ withFastStore $ \db -> updateUserProfile db user p' - updateProfile_ :: User -> Profile -> CM User -> CM ChatResponse - updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} updateUser + updateProfile user p' = updateProfile_ user p' True $ withFastStore $ \db -> updateUserProfile db user p' + updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse + updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} shouldUpdateAddressData updateUser | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user | otherwise = do when (n /= n') $ checkValidName n' @@ -2994,41 +2985,63 @@ processChatCommand' vr = \case user' <- updateUser asks currentUser >>= atomically . (`writeTVar` Just user') withChatLock "updateProfile" . procCmd $ do - let changedCts_ = L.nonEmpty $ foldr (addChangedProfileContact user') [] contacts - summary <- case changedCts_ of - Nothing -> pure $ UserProfileUpdateSummary 0 0 [] - Just changedCts -> do - let idsEvts = L.map ctSndEvent changedCts - msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts - (errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_ - unless (null errs) $ toView $ CEvtChatErrors errs - let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts - lift $ createContactsSndFeatureItems user' changedCts' - pure - UserProfileUpdateSummary - { updateSuccesses = length cts, - updateFailures = length errs, - changedContacts = map (\ChangedProfileContact {ct'} -> ct') changedCts' - } + when shouldUpdateAddressData $ setMyAddressData' user' + summary <- sendUpdateToContacts user' contacts pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary where - -- [incognito] filter out contacts with whom user has incognito connections - addChangedProfileContact :: User -> Contact -> [ChangedProfileContact] -> [ChangedProfileContact] - addChangedProfileContact user' ct changedCts = case contactSendConn_ ct' of - Right conn - | not (connIncognito conn) && mergedProfile' /= mergedProfile -> - ChangedProfileContact ct ct' mergedProfile' conn : changedCts - _ -> changedCts + setMyAddressData' :: User -> CM () + setMyAddressData' user' = do + withFastStore' (\db -> runExceptT $ getUserAddress db user) >>= \case + Right ucl@UserContactLink {shortLinkDataSet} + | shortLinkDataSet -> void $ setMyAddressData user' ucl + _ -> pure () + sendUpdateToContacts :: User -> [Contact] -> CM UserProfileUpdateSummary + sendUpdateToContacts user' contacts = do + let changedCts_ = L.nonEmpty $ foldr addChangedProfileContact [] contacts + case changedCts_ of + Nothing -> pure $ UserProfileUpdateSummary 0 0 [] + Just changedCts -> do + let idsEvts = L.map ctSndEvent changedCts + msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts + (errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_ + unless (null errs) $ toView $ CEvtChatErrors errs + let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts + lift $ createContactsSndFeatureItems user' changedCts' + pure + UserProfileUpdateSummary + { updateSuccesses = length cts, + updateFailures = length errs, + changedContacts = map (\ChangedProfileContact {ct'} -> ct') changedCts' + } where - mergedProfile = userProfileToSend user Nothing (Just ct) False - ct' = updateMergedPreferences user' ct - mergedProfile' = userProfileToSend user' Nothing (Just ct') False - ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json) - ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile') - ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq - ctMsgReq ChangedProfileContact {conn} = - fmap $ \SndMessage {msgId, msgBody} -> - (conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId])) + -- [incognito] filter out contacts with whom user has incognito connections + addChangedProfileContact :: Contact -> [ChangedProfileContact] -> [ChangedProfileContact] + addChangedProfileContact ct changedCts = case contactSendConn_ ct' of + Right conn + | not (connIncognito conn) && mergedProfile' /= mergedProfile -> + ChangedProfileContact ct ct' mergedProfile' conn : changedCts + _ -> changedCts + where + mergedProfile = userProfileToSend user Nothing (Just ct) False + ct' = updateMergedPreferences user' ct + mergedProfile' = userProfileToSend user' Nothing (Just ct') False + ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json) + ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile') + ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq + ctMsgReq ChangedProfileContact {conn} = + fmap $ \SndMessage {msgId, msgBody} -> + (conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId])) + setMyAddressData :: User -> UserContactLink -> CM ChatResponse + setMyAddressData user ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _sLnk_, autoAccept} = do + conn <- withFastStore $ \db -> getUserAddressConnection db vr user + let shortLinkProfile = userProfileToSend user Nothing Nothing False + shortLinkMsg = autoAccept >>= autoReply >>= (Just . msgContentText) + userData = encodeShortLinkData (ContactShortLinkData shortLinkProfile shortLinkMsg) + sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData Nothing) + withFastStore' $ \db -> setUserContactLinkShortLink db userContactLinkId sLnk + let autoAccept' = autoAccept >>= \aa -> Just aa {acceptIncognito = False} + ucl' = (ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk), shortLinkDataSet = True, autoAccept = autoAccept'} + pure $ CRUserContactLink user ucl' updateContactPrefs :: User -> Contact -> Preferences -> CM ChatResponse updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' @@ -3040,7 +3053,7 @@ processChatCommand' vr = \case let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) False mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False when (mergedProfile' /= mergedProfile) $ - withContactLock "updateProfile" (contactId' ct) $ do + withContactLock "updateContactPrefs" (contactId' ct) $ do void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` eToView lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' pure $ CRContactPrefsUpdated user ct ct' @@ -3063,14 +3076,30 @@ processChatCommand' vr = \case recipients = filter memberCurrentOrPending newMs sendGroupMessage user g' Nothing recipients $ XGrpPrefs ps' Nothing -> do + setGroupLinkData' g' let recipients = filter memberCurrentOrPending ms sendGroupMessage user g' Nothing recipients (XGrpInfo p') + where + setGroupLinkData' :: GroupInfo -> CM () + setGroupLinkData' g' = do + withFastStore' (\db -> runExceptT $ getGroupLink db user g') >>= \case + Right gLink@GroupLink {shortLinkDataSet} + | shortLinkDataSet -> void $ setGroupLinkData user g' gLink + _ -> pure () let cd = CDGroupSnd g' Nothing unless (sameGroupProfileInfo p p') $ do ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') toView $ CEvtNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat g' Nothing) ci] createGroupFeatureChangedItems user cd CISndGroupFeature g g' pure $ CRGroupUpdated user g g' Nothing + setGroupLinkData :: User -> GroupInfo -> GroupLink -> CM ChatResponse + setGroupLinkData user gInfo@GroupInfo {groupProfile} gLink@GroupLink {groupLinkId} = do + conn <- withFastStore $ \db -> getGroupLinkConnection db vr user gInfo + let userData = encodeShortLinkData (GroupShortLinkData groupProfile) + crClientData = encodeJSON $ CRDataGroup groupLinkId + sLnk <- shortenShortLink' . toShortGroupLink =<< withAgent (\a -> setConnShortLink a (aConnId conn) SCMContact userData (Just crClientData)) + gLink' <- withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk + pure $ CRGroupLink user gInfo gLink' checkValidName :: GroupName -> CM () checkValidName displayName = do when (T.null displayName) $ throwChatError CEInvalidDisplayName {displayName, validName = ""} @@ -3290,7 +3319,7 @@ processChatCommand' vr = \case case ct of CCTContact -> withFastStore' (\db -> getUserContactLinkViaShortLink db user l') >>= \case - Just (UserContactLink (CCLink cReq _) _ _) -> pure (ACCL SCMContact $ CCLink cReq (Just l'), CPContactAddress CAPOwnLink) + Just UserContactLink {connLinkContact = CCLink cReq _} -> pure (ACCL SCMContact $ CCLink cReq (Just l'), CPContactAddress CAPOwnLink) Nothing -> do (cReq, cData) <- getShortLinkConnReq user l' let contactSLinkData_ = decodeShortLinkData $ linkUserData cData @@ -3412,9 +3441,9 @@ processChatCommand' vr = \case CSLContact _ ct srv linkKey -> CSLContact SLSServer ct srv linkKey restoreShortLink' l = (`restoreShortLink` l) <$> asks (shortLinkPresetServers . config) encodeShortLinkData :: J.ToJSON a => a -> ByteString - encodeShortLinkData = encodeUtf8 . encodeJSON + encodeShortLinkData = LB.toStrict . J.encode decodeShortLinkData :: J.FromJSON a => ByteString -> Maybe a - decodeShortLinkData = decodeJSON . safeDecodeUtf8 + decodeShortLinkData = J.decodeStrict updatePCCShortLinkData :: J.ToJSON a => PendingContactConnection -> a -> CM (Maybe ShortLinkInvitation) updatePCCShortLinkData conn@PendingContactConnection {connLinkInv} shortLinkData = do let short = isJust $ connShortLink =<< connLinkInv diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index ba5330312b..e64b358d68 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -1035,8 +1035,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just BusinessChatInfo {customerId, chatType = BCCustomer} | joiningMemberId == customerId -> useReply <$> withStore (`getUserAddress` user) where - useReply UserContactLink {autoAccept} = case autoAccept of - Just AutoAccept {businessAddress, autoReply} | businessAddress -> autoReply + useReply UserContactLink {autoAccept, shortLinkDataSet} = case autoAccept of + Just AutoAccept {businessAddress, autoReply} + | businessAddress && (not shortLinkDataSet || connChatVersion < shortLinkDataVersion) -> + autoReply _ -> Nothing _ -> pure Nothing send mc = do @@ -1237,7 +1239,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = forM_ mc_ $ \mc -> createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing toView $ CEvtReceivedContactRequest user cReq ct_ - Just AutoAccept {acceptIncognito, businessAddress} + Just AutoAccept {businessAddress, acceptIncognito, autoReply} | businessAddress -> if isSimplexTeam && v < businessChatsVersion then @@ -1245,6 +1247,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just ct -> toView $ CEvtContactRequestAlreadyAccepted user ct Nothing -> do ct <- acceptContactRequestAsync user uclId invId chatVRange p xContactId_ reqPQSup Nothing + forM_ autoReply $ \arMC -> + when (shortLinkDataSet && v >= shortLinkDataVersion) $ + createInternalChatItem user (CDDirectSnd ct) (CISndMsgContent arMC) Nothing forM_ mc_ $ \mc -> createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing toView $ CEvtAcceptingContactRequest user ct @@ -1253,6 +1258,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just gInfo -> toView $ CEvtBusinessRequestAlreadyAccepted user gInfo Nothing -> do (gInfo, clientMember) <- acceptBusinessJoinRequestAsync user uclId invId chatVRange p xContactId_ + forM_ autoReply $ \arMC -> + when (shortLinkDataSet && v >= shortLinkDataVersion) $ + createInternalChatItem user (CDGroupSnd gInfo Nothing) (CISndMsgContent arMC) Nothing forM_ mc_ $ \mc -> createInternalChatItem user (CDGroupRcv gInfo Nothing clientMember) (CIRcvMsgContent mc) Nothing toView $ CEvtAcceptingBusinessRequest user gInfo @@ -1267,6 +1275,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing ct <- acceptContactRequestAsync user uclId invId chatVRange p xContactId_ reqPQSup incognitoProfile + forM_ autoReply $ \arMC -> + when (shortLinkDataSet && v >= shortLinkDataVersion) $ + createInternalChatItem user (CDDirectSnd ct) (CISndMsgContent arMC) Nothing forM_ mc_ $ \mc -> createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing toView $ CEvtAcceptingContactRequest user ct diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 0d77d98e31..38923575d8 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -269,7 +269,7 @@ deleteGroupLink db User {userId} GroupInfo {groupId} = do DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId) data GroupLink = GroupLink - { userContactLinkId :: Int64, -- db id + { userContactLinkId :: Int64, connLinkContact :: CreatedLinkContact, shortLinkDataSet :: Bool, groupLinkId :: GroupLinkId, diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 2db11c5e31..5e5cdf8cb5 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -450,7 +450,8 @@ data UserMsgReceiptSettings = UserMsgReceiptSettings deriving (Show) data UserContactLink = UserContactLink - { connLinkContact :: CreatedLinkContact, + { userContactLinkId :: Int64, + connLinkContact :: CreatedLinkContact, shortLinkDataSet :: Bool, autoAccept :: Maybe AutoAccept } @@ -473,9 +474,9 @@ $(J.deriveJSON defaultJSON ''AutoAccept) $(J.deriveJSON defaultJSON ''UserContactLink) -toUserContactLink :: (ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt, BoolInt, BoolInt, Maybe MsgContent) -> UserContactLink -toUserContactLink (connReq, shortLink, BI shortLinkDataSet, BI autoAccept, BI businessAddress, BI acceptIncognito, autoReply) = - UserContactLink (CCLink connReq shortLink) shortLinkDataSet $ +toUserContactLink :: (Int64, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt, BoolInt, BoolInt, Maybe MsgContent) -> UserContactLink +toUserContactLink (userContactLinkId, connReq, shortLink, BI shortLinkDataSet, BI autoAccept, BI businessAddress, BI acceptIncognito, autoReply) = + UserContactLink userContactLinkId (CCLink connReq shortLink) shortLinkDataSet $ if autoAccept then Just AutoAccept {businessAddress, acceptIncognito, autoReply} else Nothing getUserAddress :: DB.Connection -> User -> ExceptT StoreError IO UserContactLink @@ -489,7 +490,7 @@ getUserContactLinkById db userId userContactLinkId = DB.query db [sql| - SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role + SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? |] @@ -525,7 +526,7 @@ getUserContactLinkViaShortLink db User {userId} shortLink = userContactLinkQuery :: Query userContactLinkQuery = [sql| - SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content + SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content FROM user_contact_links |] @@ -558,21 +559,18 @@ getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchem (userId, cReqSchema1, cReqSchema2) maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) ctId_ -updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink -updateUserAddressAutoAccept db user@User {userId} autoAccept = do - link <- getUserAddress db user - liftIO updateUserAddressAutoAccept_ $> link {autoAccept} +updateUserAddressAutoAccept :: DB.Connection -> Int64 -> Maybe AutoAccept -> IO () +updateUserAddressAutoAccept db userContactLinkId autoAccept = + DB.execute + db + [sql| + UPDATE user_contact_links + SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ? + WHERE user_contact_link_id = ? + |] + (autoAcceptValues :. Only userContactLinkId) where - updateUserAddressAutoAccept_ = - DB.execute - db - [sql| - UPDATE user_contact_links - SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ? - WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL - |] - (ucl :. Only userId) - ucl = case autoAccept of + autoAcceptValues = case autoAccept of Just AutoAccept {businessAddress, acceptIncognito, autoReply} -> (BI True, BI businessAddress, BI acceptIncognito, autoReply) _ -> (BI False, BI False, BI False, Nothing) diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index 19824f8ab3..03fea714ea 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -1362,14 +1362,6 @@ SEARCH group_profiles USING INTEGER PRIMARY KEY (rowid=?) LIST SUBQUERY 1 SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) -Query: - UPDATE user_contact_links - SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ? - WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL - -Plan: -SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=? AND local_display_name=?) - Query: INSERT INTO connections ( user_id, agent_conn_id, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id, @@ -3061,14 +3053,6 @@ Query: Plan: SEARCH commands USING INTEGER PRIMARY KEY (rowid=?) -Query: - SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role - FROM user_contact_links - WHERE user_id = ? AND user_contact_link_id = ? - -Plan: -SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) - Query: SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id, conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, @@ -3441,6 +3425,14 @@ Query: Plan: SEARCH usage_conditions USING INTEGER PRIMARY KEY (rowid=?) +Query: + SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role + FROM user_contact_links + WHERE user_id = ? AND user_contact_link_id = ? + +Plan: +SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) + Query: UPDATE chat_items SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ? @@ -4583,6 +4575,33 @@ Query: Plan: SEARCH server_operators USING INTEGER PRIMARY KEY (rowid=?) +Query: + UPDATE user_contact_links + SET auto_accept = ?, business_address = ?, auto_accept_incognito = ?, auto_reply_msg_content = ? + WHERE user_contact_link_id = ? + +Plan: +SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) + +Query: + UPDATE user_contact_links + SET short_link_contact = ?, + short_link_data_set = ? + WHERE user_contact_link_id = ? + +Plan: +SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) + +Query: + UPDATE user_contact_links + SET short_link_contact = ?, + short_link_data_set = ?, + auto_accept_incognito = ? + WHERE user_contact_link_id = ? + +Plan: +SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) + Query: UPDATE users SET view_pwd_hash = ?, view_pwd_salt = ?, show_ntfs = ? @@ -4853,27 +4872,6 @@ SEARCH c USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN CORRELATED SCALAR SUBQUERY 1 SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group_member_id=?) -Query: - SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content - FROM user_contact_links - WHERE user_id = ? AND conn_req_contact IN (?,?) -Plan: -SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?) - -Query: - SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content - FROM user_contact_links - WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL -Plan: -SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=? AND local_display_name=?) - -Query: - SELECT conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content - FROM user_contact_links - WHERE user_id = ? AND short_link_contact = ? -Plan: -SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?) - Query: SELECT f.file_id, f.ci_file_status, f.file_path FROM chat_items i @@ -5129,6 +5127,27 @@ Query: Plan: SCAN usage_conditions +Query: + SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content + FROM user_contact_links + WHERE user_id = ? AND conn_req_contact IN (?,?) +Plan: +SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?) + +Query: + SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content + FROM user_contact_links + WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL +Plan: +SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=? AND local_display_name=?) + +Query: + SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content + FROM user_contact_links + WHERE user_id = ? AND short_link_contact = ? +Plan: +SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?) + Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts < ? ) OR ( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts = ? AND chat_item_id < ? )) ORDER BY item_ts DESC, chat_item_id DESC LIMIT ? Plan: MULTI-INDEX OR diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index eecb8511b3..e4327ee59f 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -658,7 +658,6 @@ instance ToField ImageData where toField (ImageData t) = toField t deriving newtype instance FromField ImageData --- TODO [short links] StrEncoding instances? data ContactShortLinkData = ContactShortLinkData { profile :: Profile, welcomeMsg :: Maybe Text diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 75575feaaf..995152da3e 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -187,7 +187,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte CRUserPrivacy u u' -> ttyUserPrefix hu outputRH u $ viewUserPrivacy u u' CRVersionInfo info _ _ -> viewVersionInfo logLevel info CRInvitation u ccLink _ -> ttyUser u $ viewConnReqInvitation ccLink - CRConnectionIncognitoUpdated u c -> ttyUser u $ viewConnectionIncognitoUpdated c + CRConnectionIncognitoUpdated u c customUserProfile -> ttyUser u $ viewConnectionIncognitoUpdated c customUserProfile testView CRConnectionUserChanged u c c' nu -> ttyUser u $ viewConnectionUserChanged u c nu c' CRConnectionPlan u connLink connectionPlan -> ttyUser u $ viewConnectionPlan cfg connLink connectionPlan CRNewPreparedContact u c -> ttyUser u [ttyContact' c <> ": contact is prepared"] @@ -1803,9 +1803,15 @@ viewConnectionAliasUpdated PendingContactConnection {pccConnId, localAlias} | localAlias == "" = ["connection " <> sShow pccConnId <> " alias removed"] | otherwise = ["connection " <> sShow pccConnId <> " alias updated: " <> plain localAlias] -viewConnectionIncognitoUpdated :: PendingContactConnection -> [StyledString] -viewConnectionIncognitoUpdated PendingContactConnection {pccConnId, customUserProfileId} - | isJust customUserProfileId = ["connection " <> sShow pccConnId <> " changed to incognito"] +viewConnectionIncognitoUpdated :: PendingContactConnection -> Maybe Profile -> Bool -> [StyledString] +viewConnectionIncognitoUpdated PendingContactConnection {pccConnId, customUserProfileId} incognitoProfile testView + | isJust customUserProfileId = + case incognitoProfile of + Just profile + | testView -> incognitoProfile' profile : message + | otherwise -> message + where message = ["connection " <> sShow pccConnId <> " changed to incognito"] + Nothing -> ["unexpected response when changing connection, please report to developers"] | otherwise = ["connection " <> sShow pccConnId <> " changed to non incognito"] viewConnectionUserChanged :: User -> PendingContactConnection -> User -> PendingContactConnection -> [StyledString] diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index c9ae4e4bc8..ae3db38be5 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -111,6 +111,12 @@ chatProfileTests = do it "prepare contact using address short link data and connect" testShortLinkAddressPrepareContact it "prepare group using group short link data and connect" testShortLinkPrepareGroup it "prepare group using group short link data and connect, host rejects" testShortLinkPrepareGroupReject + -- TODO [short links] enable tests - AGENT A_MESSAGE error + xit "setting incognito for invitation should update short link data" testShortLinkInvitationSetIncognito + xit "changing user for invitation should update short link data" testShortLinkInvitationChangeUser + it "changing profile should update address short link data" testShortLinkAddressChangeProfile + it "changing auto-reply message should update address short link data" testShortLinkAddressChangeAutoReply + it "changing group profile should update short link data" testShortLinkGroupChangeProfile testUpdateProfile :: HasCallStack => TestParams -> IO () testUpdateProfile = @@ -1345,6 +1351,7 @@ testSetConnectionIncognito = testChat2 aliceProfile bobProfile $ alice ##> "/connect" inv <- getInvitation alice alice ##> "/_set incognito :1 on" + _ <- getTermLine alice alice <## "connection 1 changed to incognito" bob ##> ("/connect " <> inv) bob <## "confirmation sent!" @@ -1429,6 +1436,7 @@ testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $ alice ##> "/_set incognito :1 off" alice <## "incognito mode change prohibited" alice ##> "/_set incognito :1 on" + _ <- getTermLine alice alice <## "connection 1 changed to incognito" alice ##> "/_set incognito :1 on" alice <## "incognito mode change prohibited" @@ -1451,10 +1459,12 @@ testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $ alice ##> "/_connect 1 incognito=off" inv <- getInvitation alice alice ##> "/_set incognito :1 on" + _ <- getTermLine alice alice <## "connection 1 changed to incognito" alice ##> "/_set incognito :1 off" alice <## "connection 1 changed to non incognito" alice ##> "/_set incognito :1 on" + _ <- getTermLine alice alice <## "connection 1 changed to incognito" bob ##> ("/_connect 1 incognito=off " <> inv) bob <## "confirmation sent!" @@ -1873,6 +1883,7 @@ testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $ alice ##> "/connect" inv <- getInvitation alice alice ##> "/_set incognito :1 on" + _ <- getTermLine alice alice <## "connection 1 changed to incognito" -- Create new user and go back to original user alice ##> "/create user alisa" @@ -1915,6 +1926,7 @@ testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $ showActiveUser alice "alisa" -- Change connection to incognito and make sure it's attached to the newly created user profile alice ##> "/_set incognito :1 on" + _ <- getTermLine alice alice <## "connection 1 changed to incognito" bob ##> ("/connect " <> inv) bob <## "confirmation sent!" @@ -1935,6 +1947,7 @@ testChangePCCUserDiffSrv ps = do alice ##> "/connect" _ <- getInvitation alice alice ##> "/_set incognito :1 on" + _ <- getTermLine alice alice <## "connection 1 changed to incognito" -- Create new user with different servers alice ##> "/create user alisa" @@ -2880,3 +2893,196 @@ testShortLinkPrepareGroupReject = bob <## "bad chat command: not current member" where cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Left GRRBlockedName)}} + +testShortLinkInvitationSetIncognito :: HasCallStack => TestParams -> IO () +testShortLinkInvitationSetIncognito = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/_connect 1 short=on" + (shortLink, fullLink) <- getShortInvitation alice + + alice ##> "/_set incognito :1 on" + aliceIncognito <- getTermLine alice + alice <## "connection 1 changed to incognito" + + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "invitation link: ok to connect" + contactSLinkData <- getTermLine bob + bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> contactSLinkData) + bob <## (aliceIncognito <> ": contact is prepared") + bob ##> "/_connect contact @2 text hello" + _ <- getTermLine alice + bob + <### [ ConsoleString (aliceIncognito <> ": connection started"), + WithTime ("@" <> aliceIncognito <> " hello") + ] + alice ?<# "bob> hello" + concurrentlyN_ + [ bob <## (aliceIncognito <> ": contact is connected"), + do + alice <## ("bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito) + alice <## "use /i bob to print out this incognito profile again" + ] + alice ?#> ("@bob hi") + bob <# (aliceIncognito <> "> hi") + bob #> ("@" <> aliceIncognito <> " hey") + alice ?<# ("bob> hey") + +testShortLinkInvitationChangeUser :: HasCallStack => TestParams -> IO () +testShortLinkInvitationChangeUser = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/create user alisa" + showActiveUser alice "alisa" + alice ##> "/user alice" + showActiveUser alice "alice (Alice)" + + alice ##> "/_connect 1 short=on" + (shortLink, fullLink) <- getShortInvitation alice + + alice ##> "/_set conn user :1 2" + alice <## "connection 1 changed from user alice to user alisa" + alice ##> "/user alisa" + showActiveUser alice "alisa" + + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "invitation link: ok to connect" + contactSLinkData <- getTermLine bob + bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> contactSLinkData) + bob <## "alisa: contact is prepared" + bob ##> "/_connect contact @2 text hello" + bob + <### [ "alisa: connection started", + WithTime "@alisa hello" + ] + alice <# "bob> hello" + concurrently_ + (bob <## "alisa: contact is connected") + (alice <## "bob (Bob): contact is connected") + alice <##> bob + +testShortLinkAddressChangeProfile :: HasCallStack => TestParams -> IO () +testShortLinkAddressChangeProfile = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/ad short" + (shortLink, fullLink) <- getShortContactLink alice True + + alice ##> "/p alisa" + alice <## "user profile is changed to alisa (your 0 contacts are notified)" + + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "contact address: ok to connect" + contactSLinkData <- getTermLine bob + bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> contactSLinkData) + bob <## "alisa: contact is prepared" + bob ##> "/_connect contact @2 text hello" + bob + <### [ "alisa: connection started", + WithTime "@alisa hello" + ] + alice + <### [ "bob (Bob) wants to connect to you!", + WithTime "bob> hello" + ] + alice <## "to accept: /ac bob" + alice <## "to reject: /rc bob (the sender will NOT be notified)" + alice ##> "/ac i bob" + alice <## "bad chat command: incognito not allowed for address with short link data" + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request, you can send messages to contact" + concurrently_ + (bob <## "alisa: contact is connected") + (alice <## "bob (Bob): contact is connected") + alice <##> bob + +testShortLinkAddressChangeAutoReply :: HasCallStack => TestParams -> IO () +testShortLinkAddressChangeAutoReply = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + alice ##> "/ad short" + (shortLink, fullLink) <- getShortContactLink alice True + + alice ##> "/_auto_accept 1 on incognito=off text welcome!" + alice <## "auto_accept on" + alice <## "auto reply:" + alice <## "welcome!" + + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "contact address: ok to connect" + bobContactSLinkData <- getTermLine bob + bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> bobContactSLinkData) + bob <## "alice: contact is prepared" + bob <# "alice> welcome!" + bob ##> "/_connect contact @2 text hello" + bob + <### [ "alice: connection started", + WithTime "@alice hello" + ] + alice <# "@bob welcome!" + alice <# "bob> hello" + alice <## "bob (Bob): accepting contact request..." + alice <## "bob (Bob): you can send messages to contact" + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + alice <##> bob + + alice ##> "/_auto_accept 1 on incognito=off" + alice <## "auto_accept on" + + cath ##> ("/_connect plan 1 " <> shortLink) + cath <## "contact address: ok to connect" + cathContactSLinkData <- getTermLine cath + cath ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> cathContactSLinkData) + cath <## "alice: contact is prepared" + cath ##> "/_connect contact @2 text hello" + cath + <### [ "alice: connection started", + WithTime "@alice hello" + ] + alice <# "cath> hello" + alice <## "cath (Catherine): accepting contact request..." + alice <## "cath (Catherine): you can send messages to contact" + concurrently_ + (cath <## "alice (Alice): contact is connected") + (alice <## "cath (Catherine): contact is connected") + alice <##> cath + +testShortLinkGroupChangeProfile :: HasCallStack => TestParams -> IO () +testShortLinkGroupChangeProfile = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup2 "team" alice cath + alice ##> "/create link #team short" + (shortLink, fullLink) <- getShortGroupLink alice "team" GRMember True + + alice ##> "/gp team club" + alice <## "changed to #club" + cath <## "alice updated group #team:" + cath <## "changed to #club" + + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "group link: ok to connect" + groupSLinkData <- getTermLine bob + bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData) + bob <## "#club: group is prepared" + bob ##> "/_connect group #1" + bob <## "#club: connection started" + alice <## "bob (Bob): accepting request to join group #club..." + concurrentlyN_ + [ alice <## "#club: bob joined the group", + do + bob <## "#club: joining the group..." + bob <## "#club: you joined the group" + bob <## "#club: member cath (Catherine) is connected", + do + cath <## "#club: alice added bob (Bob) to the group (connecting...)" + cath <## "#club: new member bob is connected" + ] + alice #> "#club 1" + [bob, cath] *<# "#club alice> 1" + bob #> "#club 2" + [alice, cath] *<# "#club bob> 2" + cath #> "#club 3" + [alice, bob] *<# "#club cath> 3"