diff --git a/apps/ios/Shared/Views/Chat/ChatInfoView.swift b/apps/ios/Shared/Views/Chat/ChatInfoView.swift index ad93e8dc44..3d1e7ef477 100644 --- a/apps/ios/Shared/Views/Chat/ChatInfoView.swift +++ b/apps/ios/Shared/Views/Chat/ChatInfoView.swift @@ -630,9 +630,6 @@ struct ChatInfoView: View { } } catch { logger.error("ContactPreferencesView apiSetContactPrefs error: \(responseError(error))") - await MainActor.run { - showErrorAlert(error, NSLocalizedString("Error saving preferences", comment: "alert title")) - } } } } diff --git a/apps/ios/Shared/Views/Chat/ChatItem/CIFeaturePreferenceView.swift b/apps/ios/Shared/Views/Chat/ChatItem/CIFeaturePreferenceView.swift index 19b405a05c..dcd6ea579c 100644 --- a/apps/ios/Shared/Views/Chat/ChatItem/CIFeaturePreferenceView.swift +++ b/apps/ios/Shared/Views/Chat/ChatItem/CIFeaturePreferenceView.swift @@ -69,9 +69,6 @@ func allowFeatureToContact(_ contact: Contact, _ feature: ChatFeature, param: In } } catch { logger.error("allowFeatureToContact apiSetContactPrefs error: \(responseError(error))") - await MainActor.run { - showErrorAlert(error, NSLocalizedString("Error saving preferences", comment: "alert title")) - } } } } diff --git a/apps/ios/Shared/Views/LocalAuth/LocalAuthView.swift b/apps/ios/Shared/Views/LocalAuth/LocalAuthView.swift index 8bac3e2f06..36608c58d6 100644 --- a/apps/ios/Shared/Views/LocalAuth/LocalAuthView.swift +++ b/apps/ios/Shared/Views/LocalAuth/LocalAuthView.swift @@ -87,7 +87,7 @@ struct LocalAuthView: View { AppChatState.shared.set(.active) if m.currentUser != nil || !m.chatInitialized { return } var profile: Profile? = nil - if let displayName = displayName.map(mkValidName), displayName != "" { + if let displayName = displayName, displayName != "" { profile = Profile(displayName: displayName, fullName: "") } m.currentUser = try apiCreateActiveUser(profile, pastTimestamp: true) diff --git a/apps/ios/Shared/Views/UserSettings/UserAddressView.swift b/apps/ios/Shared/Views/UserSettings/UserAddressView.swift index 7cd131e39b..61c808dda1 100644 --- a/apps/ios/Shared/Views/UserSettings/UserAddressView.swift +++ b/apps/ios/Shared/Views/UserSettings/UserAddressView.swift @@ -444,7 +444,6 @@ struct UserAddressView: View { } label: { Text("Address settings") } - .disabled(progressIndicator) } private func learnMoreButton() -> some View { @@ -693,7 +692,6 @@ struct UserAddressSettingsView: View { private func shareWithContactsButton() -> some View { settingsRow("person", color: theme.colors.secondary) { Toggle("Share with SimpleX contacts", isOn: $shareViaProfile) - .disabled(progressIndicator) .onChange(of: shareViaProfile) { on in if ignoreShareViaProfileChange { ignoreShareViaProfileChange = false diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index f75c4978ef..a8c5de3672 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -598,8 +598,7 @@ public func fromLocalProfile (_ profile: LocalProfile) -> Profile { image: profile.image, contactLink: profile.contactLink, preferences: profile.preferences, - peerType: profile.peerType, - contactDomain: profile.contactDomain + peerType: profile.peerType ) } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index 3c52cecfe2..5f1603423a 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -1986,9 +1986,7 @@ object ChatController { suspend fun apiSetContactPrefs(rh: Long?, contactId: Long, prefs: ChatPreferences): Contact? { val r = sendCmd(rh, CC.ApiSetContactPrefs(contactId, prefs)) if (r is API.Result && r.res is CR.ContactPrefsUpdated) return r.res.toContact - if (!(networkErrorAlert(r))) { - apiErrorAlert("apiSetContactPrefs", generalGetString(MR.strings.error_saving_preferences), r) - } + Log.e(TAG, "apiSetContactPrefs bad response: ${r.responseType} ${r.details}") return null } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/localauth/LocalAuthView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/localauth/LocalAuthView.kt index 2cfd1a498f..04c1239d84 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/localauth/LocalAuthView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/localauth/LocalAuthView.kt @@ -73,7 +73,7 @@ private fun deleteStorageAndRestart(m: ChatModel, password: String, completed: ( ntfManager.cancelAllNotifications() val selfDestructPref = m.controller.appPrefs.selfDestruct val displayNamePref = m.controller.appPrefs.selfDestructDisplayName - val displayName = displayNamePref.get()?.let { mkValidName(it) } + val displayName = displayNamePref.get() selfDestructPref.set(false) displayNamePref.set(null) reinitChatController() diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserAddressView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserAddressView.kt index 78f79c2d3e..826648ddb8 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserAddressView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/UserAddressView.kt @@ -56,7 +56,6 @@ fun UserAddressView( fun setProfileAddress(on: Boolean) { progressIndicator.value = true - shareViaProfile.value = on withBGApi { try { val u = chatModel.controller.apiSetProfileAddress(user.value?.remoteHostId, on) @@ -99,11 +98,13 @@ fun UserAddressView( confirmText = generalGetString(MR.strings.share_verb), onConfirm = { setProfileAddress(true) + shareViaProfile.value = true } ) progressIndicator.value = false } else { setProfileAddress(true) + shareViaProfile.value = true } } else { progressIndicator.value = false diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index fa7b6c82ed..f9de25e7db 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -555,14 +555,13 @@ processChatCommand cxt nm = \case salt <- drgRandomBytes 16 let hash = B64UrlByteString $ C.sha512Hash $ encodeUtf8 viewPwd <> salt pure $ Just UserPwdHash {hash, salt = B64UrlByteString salt} - APIUnhideUser userId' viewPwd@(UserPwd pwd) -> withUser $ \user -> withUserNamesLock $ do - user'@User {profile = LocalProfile {displayName}} <- privateGetUser userId' + APIUnhideUser userId' viewPwd@(UserPwd pwd) -> withUser $ \user -> do + user' <- privateGetUser userId' case viewPwdHash user' of Nothing -> throwChatError $ CEUserNotHidden userId' _ -> do when (T.null pwd) $ throwChatError $ CEEmptyUserPassword userId' validateUserPassword user user' $ Just viewPwd - checkOtherUsersName userId' displayName setUserPrivacy user user' {viewPwdHash = Nothing, showNtfs = True} APIMuteUser userId' -> setUserNotifications userId' False APIUnmuteUser userId' -> setUserNotifications userId' True @@ -571,9 +570,9 @@ processChatCommand cxt nm = \case MuteUser -> withUser $ \User {userId} -> processChatCommand cxt nm $ APIMuteUser userId UnmuteUser -> withUser $ \User {userId} -> processChatCommand cxt nm $ APIUnmuteUser userId SetClientService userId' name enable -> checkChatStopped $ withUser' $ \currUser@User {userId} -> do - user@User {agentUserId = AgentUserId auId, clientService, localDisplayName} <- + user@User {agentUserId = AgentUserId auId, clientService, profile = LocalProfile {displayName}} <- if userId == userId' then pure currUser else privateGetUser userId' - unless (name == localDisplayName) $ throwChatError CEUserUnknown + unless (name == displayName) $ throwChatError CEUserUnknown if enable == isTrue clientService then ok user else do @@ -1616,7 +1615,9 @@ processChatCommand cxt nm = \case pure $ Just (CLShort sl) _ -> throwCmdError "create the address short link and add it to name" let p' = (fromLocalProfile p :: Profile) {contactDomain = mkDomainClaim <$> domain_, contactLink = cl'} - updateProfile_ user p' True $ withFastStore $ \db -> updateUserProfile db user p' + updateProfile_ user p' True $ withFastStore $ \db -> do + user' <- updateUserProfile db user p' + liftIO $ setUserSimplexDomain db user' domain_ APISetContactPrefs contactId prefs' -> withUser $ \user -> do ct <- withFastStore $ \db -> getContact db cxt user contactId updateContactPrefs user ct prefs' @@ -2457,7 +2458,7 @@ processChatCommand cxt nm = \case CRContactsList user <$> withFastStore' (\db -> getUserContacts db cxt user) ListContacts -> withUser $ \User {userId} -> processChatCommand cxt nm $ APIListContacts userId - APICreateMyAddress userId server_ pqRatchet_ -> withUserId userId $ \u -> withUserProfileLock u $ \user@User {userChatRelay} -> do + APICreateMyAddress userId server_ pqRatchet_ -> withUserId userId $ \user@User {userChatRelay} -> do withFastStore' (\db -> runExceptT $ getUserAddress db user) >>= \case Left SEUserContactLinkNotFound -> pure () Left e -> throwError $ ChatErrorStore e @@ -2501,11 +2502,11 @@ processChatCommand cxt nm = \case CRUserContactLink user <$> withFastStore (`getUserAddress` user) ShowMyAddress -> withUser' $ \User {userId} -> processChatCommand cxt nm $ APIShowMyAddress userId - APIAddMyAddressShortLink userId pqRatchet_ -> withUserId' userId $ \u -> withUserProfileLock u $ \user -> do + APIAddMyAddressShortLink userId pqRatchet_ -> withUserId' userId $ \user -> do -- TODO [address DR] remove the option, and use IKUsePQ let pqInitKeys = (\case True -> IKUsePQ; False -> IKPQOn) <$> pqRatchet_ CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData False pqInitKeys user) - APIRotateAddressRatchetKeys userId -> withUserId' userId $ \u -> withUserProfileLock u $ \user -> + APIRotateAddressRatchetKeys userId -> withUserId' userId $ \user -> CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData True (Just IKUsePQ) user) APISetProfileAddress userId False -> withUserProfileLock "setProfileAddress" $ withUserId userId $ \user@User {profile = p} -> do let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing, contactDomain = Nothing} @@ -2517,7 +2518,7 @@ processChatCommand cxt nm = \case updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl SetProfileAddress onOff -> withUser $ \User {userId} -> processChatCommand cxt nm $ APISetProfileAddress userId onOff - APISetAddressSettings userId pqRatchet_ settings@AddressSettings {businessAddress, autoAccept} -> withUserId userId $ \u -> withUserProfileLock u $ \user -> do + APISetAddressSettings userId pqRatchet_ settings@AddressSettings {businessAddress, autoAccept} -> withUserId userId $ \user -> do ucl@UserContactLink {userContactLinkId, shortLinkDataSet, addressSettings} <- withFastStore (`getUserAddress` user) forM_ autoAccept $ \AutoAccept {acceptIncognito} -> do when (shortLinkDataSet && acceptIncognito) $ throwCmdError "incognito not allowed for address with short link data" @@ -3598,7 +3599,8 @@ processChatCommand cxt nm = \case updateProfile user p UpdateProfileImageFromFile path -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do img <- readProfileImageFile path - updateProfile user $ \User {profile} -> (fromLocalProfile profile :: Profile) {image = Just img} + let p = (fromLocalProfile profile :: Profile) {image = Just img} + updateProfile user p ShowProfileImage -> withUser $ \user@User {profile} -> pure $ CRUserProfileImage user $ fromLocalProfile profile SetUserFeature (ACF f) allowed -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user} @@ -3621,7 +3623,8 @@ processChatCommand cxt nm = \case SetUserTimedMessages onOff -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do let allowed = if onOff then FAYes else FANo pref = TimedMessagesPreference allowed Nothing - in (fromLocalProfile profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user'} + p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user} + updateProfile user p SetContactTimedMessages cName timedMessagesEnabled_ -> withUser $ \user -> do ct@Contact {userPreferences = userPreferences@Preferences {timedMessages}} <- withFastStore $ \db -> getContactByName db cxt user cName let currentTTL = timedMessages >>= \TimedMessagesPreference {ttl} -> ttl @@ -4019,7 +4022,7 @@ processChatCommand cxt nm = \case where p' = (p :: Profile) {contactDomain} updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse - updateProfile_ user@User {userId, profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n', image = img'} shouldUpdateAddressData updateUser + updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n', image = img'} shouldUpdateAddressData updateUser | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user | otherwise = do when (n /= n') $ do @@ -5212,21 +5215,22 @@ verifyOwnBadge cred@(BadgeCredential keyIdx _ _ _) = do -- attach an issued badge credential to the user's own profile and present it to all current contacts. -- the credential is stored once; every profile send generates a fresh single-use proof (see presentUserBadge). addUserBadge :: User -> BadgeCredential -> CM () -addUserBadge user@User {userId} cred@(BadgeCredential _ _ _ info) = +addUserBadge user cred@(BadgeCredential _ _ _ info) = verifyOwnBadge cred >>= \case Nothing -> throwCmdError "unknown badge key index" Just False -> throwCmdError "badge credential does not verify against configured key" Just True -> do now <- liftIO getCurrentTime - withUserProfileLock_ userId $ do - user' <- withFastStore $ \db -> setUserBadge db user (Just (OwnBadge cred (mkBadgeStatus now (Just True) info))) - presentUserBadgeToContacts user' + user' <- withFastStore $ \db -> setUserBadge db user (Just (OwnBadge cred (mkBadgeStatus now (Just True) info))) + presentUserBadgeToContacts user' presentUserBadgeToContacts :: User -> CM () -presentUserBadgeToContacts user'@User {profile = LocalProfile {localBadge}} = do +presentUserBadgeToContacts user'@User {userId, profile = LocalProfile {localBadge}} = do -- a badge worker runs for every profile, not only the active one, so this refreshes the active -- record where it is the same profile and must never switch to another - updateCurrentUser user' + chatModifyVar currentUser $ \case + Just User {userId = activeId} | activeId == userId -> Just user' + active_ -> active_ lift $ withAgent' $ \a -> setUserEntitlement a (aUserId user') (badgeServerCredential localBadge) cxt <- chatStoreCxt contacts <- withFastStore' $ \db -> getUserContacts db cxt user' @@ -5268,7 +5272,7 @@ redeemBadgeCode nm user@User {userId} codeText = do J.Success BSPBadgeCredential {credential = Just cred, statement} -> storeRedeemedBadge user redemption cred statement J.Success _ -> throwRedeemError $ BREInvalidResponse "unexpected response type" -- outside the badge lock: the chat lock must not be taken under it - forM_ present_ $ \u -> withUserProfileLock u presentUserBadgeToContacts + mapM_ presentUserBadgeToContacts present_ pure redeemed where -- the code will never work, so the keys stashed for it are dead; a timeout keeps them @@ -5642,7 +5646,7 @@ verifyIssuedCredential masterKey (Just cred@(BadgeCredential _ credMasterKey _ _ -- | Present the newest issued credential once the one on the profile has run out. It is written in -- a separate transaction from the issuance, so a crash between the two is repaired at the next run. presentIssuedBadge :: User -> UserBadgePurchase -> UTCTime -> CM () -presentIssuedBadge user@User {userId} p@UserBadgePurchase {badgePurchaseId, shown} now +presentIssuedBadge user p@UserBadgePurchase {badgePurchaseId, shown} now | not shown = pure () | otherwise = do cred_ <- withStore' (`getLatestIssuedCredential` badgePurchaseId) @@ -5658,7 +5662,7 @@ presentIssuedBadge user@User {userId} p@UserBadgePurchase {badgePurchaseId, show -- | The visible half of "the badge expired". retireExpiredBadge :: User -> UserBadgePurchase -> UTCTime -> StatementEntry -> CM Bool -retireExpiredBadge user@User {userId} UserBadgePurchase {badgePurchaseId, shown} now balance +retireExpiredBadge user UserBadgePurchase {badgePurchaseId, shown} now balance | not (shown && L.paidThrough balance <= now) = pure False | otherwise = withUserProfileLock "retireExpiredBadge" $ do user' <- withStore $ \db -> do @@ -5691,15 +5695,12 @@ storeRedeemedBadge user@User {userId} redemption@BadgeCodeRedemption {masterKey} now <- badgeNow let badge = OwnBadge cred (mkBadgeStatus now (Just True) info) -- TODO [badges] retire a previously held badge - (user', newBadge, applied) <- withUserProfileLock_ userId $ do - r@(user', newBadge, _) <- withStore $ \db -> do - (purchaseId, newBadge) <- liftIO $ createCodeBadgePurchase db user redemption cred now - applied <- liftIO $ applyBadgeStatement db g purchaseId badgeType statement (Just cred) now - -- a replay must not put a superseded badge back, or tell every contact again - user' <- if newBadge then setUserBadge db user (Just badge) else getUser db userId - pure (user', newBadge, applied) - when newBadge $ updateCurrentUser user' - pure r + (user', newBadge, applied) <- withStore $ \db -> do + (purchaseId, newBadge) <- liftIO $ createCodeBadgePurchase db user redemption cred now + applied <- liftIO $ applyBadgeStatement db g purchaseId badgeType statement (Just cred) now + -- a replay must not put a superseded badge back, or tell every contact again + user' <- if newBadge then setUserBadge db user (Just badge) else getUser db userId + pure (user', newBadge, applied) unless applied $ eToView $ ChatError $ CEInternalError "redeemed badge credential has no ledger row to store it against" -- nothing is due yet, but a pass is what arms the next wake, and this is the first purchase lift $ startBadgeWork user' diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 6fa524bffe..bd23335900 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -60,7 +60,7 @@ import Simplex.Chat.Controller import Simplex.Chat.Files import Simplex.Chat.Markdown import Simplex.Chat.Messages -import Simplex.Chat.Messages.Batch (BatchMode (..), MsgBatch (..), batchElements, batchJsonElements, batchMessages, encodeBatchElement, encodeBinaryBatch, encodeFwdElement, encodeLegacyFwdElement) +import Simplex.Chat.Messages.Batch (BatchMode (..), MsgBatch (..), batchElements, batchMessages, encodeBatchElement, encodeBinaryBatch, encodeFwdElement) import Simplex.Chat.Messages.CIContent import Simplex.Chat.Messages.CIContent.Events import Simplex.Chat.Operators @@ -1419,9 +1419,8 @@ sendHistory user gInfo@GroupInfo {membership} m@GroupMember {activeConn = Just c unless (null errors) $ toView $ CEvtChatErrors errors -- signed items keep the author's original bytes/signature, unsigned are re-encoded; the welcome message -- (regular groups only; never channels) is an authored element -- all batch together in order. - vr <- chatVersionRange - welcomeEl <- welcomeElement let fwdEls = map (uncurry encodeFwdElement) (concat fwdMsgsByItem) + welcomeEl <- welcomeElement let (batches, dropped) = batchElements maxForwardBatchLength (fwdEls <> maybe [] (: []) welcomeEl) when (dropped > 0) $ toView $ CEvtChatErrors [ChatError $ CEInternalError ("sendHistory: dropped " <> show dropped <> " oversized history messages")] forM_ batches $ \body -> @@ -2902,10 +2901,7 @@ sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} c sendFwdMemberMessage :: GroupMember -> GrpMsgForward -> VerifiedMsg 'Json -> CM () sendFwdMemberMessage member fwd verifiedMsg = forM_ (readyMemberConn member) $ \(_, conn) -> do - vr <- chatVersionRange - let body - | member `supportsVersion` relayWebCapVersion = encodeBinaryBatch [encodeFwdElement fwd verifiedMsg] - | otherwise = encodeLegacyFwdElement vr fwd (verifiedChatMsg verifiedMsg) + let body = encodeBinaryBatch [encodeFwdElement fwd verifiedMsg] void $ withAgent $ \a -> sendMessages a [(aConnId conn, PQEncOff, MsgFlags False, VRValue Nothing body)] -- TODO ensure order - pending messages interleave with user input messages diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 1828853a77..adddc6342d 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -29,7 +29,7 @@ import Data.Either (lefts, partitionEithers, rights) import Data.Foldable (foldr', foldrM) import Data.Functor (($>)) import Data.Int (Int64) -import Data.List (find, foldl', partition) +import Data.List (find, foldl') import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L import qualified Data.IntSet as IS @@ -54,7 +54,7 @@ import Simplex.Chat.Files (getChatTempDirectory, safeFileNameStr) import Simplex.Chat.Library.Internal import Simplex.Chat.Web (channelContentChanged, channelProfileUpdated, channelRemoved) import Simplex.Chat.Messages -import Simplex.Chat.Messages.Batch (batchDeliveryTasks1, batchProfiles, batchProfilesWithBody, encodeBinaryBatch, encodeFwdElement, legacyFwdBodies, maxBatchElementSize) +import Simplex.Chat.Messages.Batch (batchDeliveryTasks1, batchProfiles, batchProfilesWithBody, encodeBinaryBatch, encodeFwdElement, maxBatchElementSize) import Simplex.Chat.Messages.CIContent import Simplex.Chat.Messages.CIContent.Events import Simplex.Chat.ProfileGenerator (generateRandomProfile) @@ -4420,15 +4420,7 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do && maxVersion (memberChatVRange m) >= groupKnockingVersion where deliver :: ByteString -> [GroupMember] -> CM () - deliver msgBody mems = do - let (mems', legacyMems) = partition (`supportsVersion` relayWebCapVersion) mems - unless (null mems') $ deliverBody msgBody mems' - unless (null legacyMems) $ do - let (legacyBodies, dropped) = legacyFwdBodies (vr cxt) maxForwardBatchLength msgBody - when (dropped > 0) $ toView $ CEvtChatErrors [ChatError $ CEInternalError ("delivery job: dropped " <> show dropped <> " oversized forwarded messages")] - forM_ legacyBodies (`deliverBody` legacyMems) - deliverBody :: ByteString -> [GroupMember] -> CM () - deliverBody msgBody mems = + deliver msgBody mems = let mConns = mapMaybe (fmap snd . readyMemberConn) mems msgReqs = foldMemConns mConns in void $ withAgent (`sendMessages` msgReqs) diff --git a/src/Simplex/Chat/Messages/Batch.hs b/src/Simplex/Chat/Messages/Batch.hs index cbe464e8aa..0aa177cf27 100644 --- a/src/Simplex/Chat/Messages/Batch.hs +++ b/src/Simplex/Chat/Messages/Batch.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -11,9 +10,6 @@ module Simplex.Chat.Messages.Batch BatchMode (..), encodeBatchElement, encodeFwdElement, - encodeLegacyFwdElement, - legacyFwdBodies, - batchJsonElements, encodeBinaryBatch, batchMessages, batchDeliveryTasks1, @@ -38,7 +34,7 @@ import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..)) import Simplex.Chat.Delivery import Simplex.Chat.Messages import Simplex.Chat.Protocol -import Data.Maybe (isJust, mapMaybe) +import Data.Maybe (isJust) import Simplex.Chat.Types (GroupMember (..), LocalProfile (..), VersionRangeChat) import Simplex.Messaging.Encoding (Large (..), smpEncode, smpEncodeList) @@ -131,35 +127,6 @@ encodeFwdElement fwd verifiedMsg = ">" <> smpEncode fwd <> encodeBatchElement si where (_, signedMsg_, msgBody) = verifiedMsgParts verifiedMsg -encodeLegacyFwdElement :: VersionRangeChat -> GrpMsgForward -> ChatMessage 'Json -> ByteString -encodeLegacyFwdElement vr fwd chatMsg = chatMsgToBody ChatMessage {chatVRange = vr, msgId = Nothing, chatMsgEvent = XGrpMsgForward fwd chatMsg} - -legacyFwdBodies :: VersionRangeChat -> Int -> ByteString -> ([ByteString], Int) -legacyFwdBodies vr maxLen body = case B.uncons body of - Just ('=', _) -> batchJsonElements maxLen $ mapMaybe legacyElement $ parseChatMessages body - _ -> ([body], 0) - where - legacyElement = \case - Right (APMsg SJson (ParsedMsg (Just fwd) _ chatMsg)) -> Just $ encodeLegacyFwdElement vr fwd chatMsg - _ -> Nothing - -batchJsonElements :: Int -> [ByteString] -> ([ByteString], Int) -batchJsonElements maxLen = finish . foldl' addToBatch ([], [], 0, 0, 0) - where - addToBatch (batches, els, len, n, dropped) el - | elLen > maxLen = (batches, els, len, n, dropped + 1) - | n == 0 = (batches, [el], elLen, 1, dropped) - | n < maxBatchElementCount && len + 1 + elLen + 2 <= maxLen = (batches, el : els, len + 1 + elLen, n + 1, dropped) - | otherwise = (closeBatch els : batches, [el], elLen, 1, dropped) - where - elLen = B.length el - closeBatch = \case - [el] -> el - els -> B.concat ["[", B.intercalate "," (reverse els), "]"] - finish (batches, els, _, n, dropped) - | n == 0 = (reverse batches, dropped) - | otherwise = (reverse (closeBatch els : batches), dropped) - encodeBatch :: BatchMode -> [ByteString] -> ByteString encodeBatch _ [] = mempty encodeBatch _ [msg] = msg diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index a04269f532..3b52c46fef 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -52,6 +52,7 @@ module Simplex.Chat.Store.Profiles getUserAddressConnection, deleteUserAddress, getUserAddress, + setUserSimplexDomain, getUserContactLinkById, getGroupLinkInfo, getUserContactLinkByConnReq, @@ -88,7 +89,6 @@ module Simplex.Chat.Store.Profiles ) where -import qualified Control.Exception as E import Control.Monad import Control.Monad.Except import Control.Monad.IO.Class @@ -118,7 +118,6 @@ import Simplex.Chat.Types.UITheme import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..)) import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, ConnectionLink (..), CreatedConnLink (..), SimplexDomain, SimplexNameInfo (..), UserId) import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow) -import Simplex.Messaging.Agent.Store.Common (withSavepoint) import Simplex.Messaging.Agent.Store.DB (BoolInt (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB import qualified Simplex.Messaging.Crypto as C @@ -138,17 +137,28 @@ import Database.SQLite.Simple.QQ (sql) #endif createUserRecordAt :: DB.Connection -> AgentUserId -> Bool -> Bool -> Profile -> Bool -> UTCTime -> ExceptT StoreError IO User -createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {displayName, fullName, shortDescr, description, image, peerType, preferences = userPreferences} activeUser currentTs = do - order <- liftIO $ getNextActiveOrder db - (userId, ldn, ldnSuffix) <- insertUser order 0 (20 :: Int) - liftIO $ do +createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {displayName, fullName, shortDescr, description, image, peerType, preferences = userPreferences} activeUser currentTs = + checkConstraint SEDuplicateName . liftIO $ do + let showNtfs = True + sendRcptsContacts = True + sendRcptsSmallGroups = True + autoAcceptMemberContacts = False + autoAcceptGroupInvitations = False + order <- getNextActiveOrder db + DB.execute + db + "INSERT INTO users (agent_user_id, local_display_name, active_user, is_user_chat_relay, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, auto_accept_member_contacts, auto_accept_group_invitations, client_service, created_at, updated_at) VALUES (?,?,?,?,?,0,?,?,?,?,?,?,?,?)" + ( (auId, displayName, BI activeUser, BI userChatRelay, order) + :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInvitations, BI clientService, currentTs, currentTs) + ) + userId <- insertedRowId db -- After the insert: the name is unique in users, so a duplicate fails -- above, and deactivating first would commit a database with no active user. when activeUser $ DB.execute db "UPDATE users SET active_user = 0 WHERE user_id != ?" (Only userId) DB.execute db - "INSERT INTO display_names (local_display_name, ldn_base, ldn_suffix, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" - (ldn, displayName, ldnSuffix, userId, currentTs, currentTs) + "INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)" + (displayName, displayName, userId, currentTs, currentTs) DB.execute db "INSERT INTO contact_profiles (display_name, full_name, short_descr, description, image, chat_peer_type, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)" @@ -157,7 +167,7 @@ createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {di DB.execute db "INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)" - (profileId, ldn, userId, BI True, currentTs, currentTs, currentTs) + (profileId, displayName, userId, BI True, currentTs, currentTs, currentTs) contactId <- insertedRowId db DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId) pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order, displayName) :. (displayName, fullName, shortDescr, description, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInvitations, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing, Nothing) @@ -361,16 +371,16 @@ updatedUserProfile User {profile = LocalProfile {profileId, localBadge, localAli -- own profile field update; leaves the badge columns alone (the credential is owned by setUserBadge/addUserBadge) updateUserProfileFields_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO () -updateUserProfileFields_' db userId profileId Profile {displayName, fullName, shortDescr, description, image, contactLink, contactDomain, preferences, peerType} updatedAt = +updateUserProfileFields_' db userId profileId Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType} updatedAt = DB.execute db [sql| UPDATE contact_profiles SET preferences = ?, preferences_json = ?, - display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?, contact_link = ?, contact_domain = ?, chat_peer_type = ?, updated_at = ? + display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?, contact_link = ?, chat_peer_type = ?, updated_at = ? WHERE user_id = ? AND contact_profile_id = ? |] - (prefsToRow preferences :. (displayName, fullName, shortDescr, description, image, contactLink, claimDomain <$> contactDomain, peerType, updatedAt) :. (userId, profileId)) + (prefsToRow preferences :. (displayName, fullName, shortDescr, description, image, contactLink, peerType, updatedAt) :. (userId, profileId)) -- store the user's own badge credential; touches only the badge columns. -- bumps user_member_profile_updated_at so groups receive the updated profile (with the badge) on the next message. @@ -390,6 +400,15 @@ setUserBadge db User {userId, profile = LocalProfile {profileId}} localBadge = d DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (ts, userId) getUser db userId +setUserSimplexDomain :: DB.Connection -> User -> Maybe SimplexDomain -> IO User +setUserSimplexDomain db user@User {userId, profile = p@LocalProfile {profileId}} domain_ = do + ts <- getCurrentTime + DB.execute + db + "UPDATE contact_profiles SET contact_domain = ?, updated_at = ? WHERE user_id = ? AND contact_profile_id = ?" + (domain_, ts, userId, profileId) + pure (user :: User) {profile = p {contactDomain = mkDomainClaim <$> domain_}} + setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId, contactDomain}} ucl_ = do ts <- getCurrentTime diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 30f4df20c1..2aeec7af3f 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -600,10 +600,7 @@ getConnReqContact db connId = -- | Saves unique local display name based on passed displayName, suffixed with _N if required. -- This function should be called inside transaction. withLocalDisplayName :: forall a. DB.Connection -> UserId -> Text -> (Text -> IO (Either StoreError a)) -> IO (Either StoreError a) -withLocalDisplayName db userId displayName = withLocalDisplayName_ db userId displayName Nothing - -withLocalDisplayName_ :: forall a. DB.Connection -> UserId -> Text -> Maybe (Text -> IO ()) -> (Text -> IO (Either StoreError a)) -> IO (Either StoreError a) -withLocalDisplayName_ db userId displayName reserveName_ action = getLdnSuffix >>= (`tryCreateName` 20) +withLocalDisplayName db userId displayName action = getLdnSuffix >>= (`tryCreateName` 20) where getLdnSuffix :: IO Int getLdnSuffix = @@ -623,16 +620,7 @@ withLocalDisplayName_ db userId displayName reserveName_ action = getLdnSuffix > currentTs <- getCurrentTime let ldn = displayName <> (if ldnSuffix == 0 then "" else T.pack $ '_' : show ldnSuffix) withSavepoint db "ldn_insert" (insertName ldn currentTs) >>= \case - Right () -> case reserveName_ of - Nothing -> action ldn - Just reserveName -> - withSavepoint db "ldn_reserve" (reserveName ldn) >>= \case - Right () -> action ldn - Left e - | constraintError e -> do - DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, ldn) - tryCreateName (ldnSuffix + 1) (attempts - 1) - | otherwise -> E.throwIO e + Right () -> action ldn Left e | constraintError e -> tryCreateName (ldnSuffix + 1) (attempts - 1) | otherwise -> E.throwIO e diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index ba3c7c6427..55f47ea186 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -193,7 +193,6 @@ chatGroupTests = do it "forward group deletion (x.grp.del)" testGroupMsgForwardGroupDeletion describe "group history" $ do it "text messages" testGroupHistory - it "text messages to member below version 18" testGroupHistoryOldMember it "history is sent when joining via group link" testGroupHistoryGroupLink it "file with badge proof is received from history" testGroupHistoryFileBadgeProof it "file received from member with badge proof is received from history" testGroupHistoryRcvFileBadgeProof @@ -5985,45 +5984,6 @@ testGroupHistory = cath #> "#team 3" [alice, bob] *<# "#team cath> 3" -testGroupHistoryOldMember :: HasCallStack => TestParams -> IO () -testGroupHistoryOldMember ps = - withNewTestChat ps "alice" aliceProfile $ \alice -> - withNewTestChat ps "bob" bobProfile $ \bob -> - withNewTestChatCfg ps oldCfg "cath" cathProfile $ \cath -> do - createGroup2 "team" alice bob - - threadDelay 1000000 - - alice #> "#team hello" - bob <# "#team alice> hello" - - threadDelay 1000000 - - bob #> "#team hey!" - alice <# "#team bob> hey!" - - connectUsers alice cath - addMember "team" alice cath GRAdmin - cath ##> "/j team" - concurrentlyN_ - [ alice <## "#team: cath joined the group", - cath - <### [ "#team: you joined the group", - WithTime "#team alice> hello [>>]", - WithTime "#team bob> hey! [>>]", - "#team: member bob (Bob) is connected" - ], - do - bob <## "#team: alice added cath (Catherine) to the group (connecting...)" - bob <## "#team: new member cath is connected" - ] - - cath ##> "/_get chat #1 count=100" - r <- chat <$> getTermLine cath - r `shouldContain` [(0, "hello"), (0, "hey!")] - where - oldCfg = testCfg {chatVRange = mkVersionRange (VersionChat 9) (VersionChat 17)} - testGroupHistoryGroupLink :: HasCallStack => TestParams -> IO () testGroupHistoryGroupLink = testChat3 aliceProfile bobProfile cathProfile $ diff --git a/tests/MessageBatching.hs b/tests/MessageBatching.hs index 67dd8abd74..71cf2d5f49 100644 --- a/tests/MessageBatching.hs +++ b/tests/MessageBatching.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -29,23 +27,18 @@ import Simplex.Chat.Messages.Batch import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..)) import Simplex.Chat.Messages (SndMessage (..)) import Simplex.Chat.Protocol - ( AParsedMsg (..), - ChatMessage (ChatMessage), - ChatMsgEvent (XGrpMsgForward, XMsgNew), - FwdSender (FwdChannel, FwdMember), + ( ChatMessage (ChatMessage), + ChatMsgEvent (XMsgNew), + FwdSender (FwdChannel), GrpMsgForward (GrpMsgForward), MsgContent (MCText), - MsgEncoding (Json), - ParsedMsg (..), - SMsgEncoding (SJson), VerifiedMsg (VMUnsigned), fwdMemberName, maxBatchElementCount, maxEncodedMsgLength, mcSimple, - parseChatMessages, ) -import Simplex.Chat.Types (MemberId (..), SharedMsgId (..), chatInitialVRange) +import Simplex.Chat.Types (SharedMsgId (..), chatInitialVRange) import Simplex.Messaging.Encoding (Large (..), smpEncodeList) import Test.Hspec