cleanup

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"))
-                }
             }
         }
     }

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"))
-            }
         }
     }
 }

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)

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

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
     )
 }
 

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
   }
 

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()

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

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'

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

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)

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

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

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

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 $

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