From 1f93d91af51653a7c1429159a8a1c0b1ad828764 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 8 Mar 2024 13:36:09 +0000 Subject: [PATCH] core: simplify feature versions (#3879) * core: simplify feature versions * update version agreement * fix * remove EmptyCase --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 62 ++++++++++++++++---------------- src/Simplex/Chat/Protocol.hs | 40 ++++++++++----------- src/Simplex/Chat/Store/Groups.hs | 32 ++++++++--------- src/Simplex/Chat/Store/Shared.hs | 6 ++-- src/Simplex/Chat/Types.hs | 31 ++++++---------- src/Simplex/Chat/View.hs | 4 +-- 8 files changed, 83 insertions(+), 96 deletions(-) diff --git a/cabal.project b/cabal.project index a589035483..0318aa7de4 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 5e23fa6cfc60c5efd561f9131a9528b9ccb9782d + tag: b4e55146b8a910add95d0756734ca5ba3f0850fc source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index ca49a9a013..c4e16fe399 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."5e23fa6cfc60c5efd561f9131a9528b9ccb9782d" = "1h2cxnyn2z2qscny7gsz0zpvmnpn1h668ic4za36l43swddwwb7s"; + "https://github.com/simplex-chat/simplexmq.git"."b4e55146b8a910add95d0756734ca5ba3f0850fc" = "0hwrzn02284myqcv4gdxabk5dw0zisyy13vym5h2k461005jl6sb"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 644404955e..754eae464c 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1653,7 +1653,7 @@ processChatCommand' vr = \case dm <- encodeConnInfo $ XGrpAcpt membershipMemId agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm PQSupportOff subMode withStore' $ \db -> do - createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode + createMemberConnection db userId fromMember agentConnId peerChatVRange subMode updateGroupMemberStatus db userId fromMember GSMemAccepted updateGroupMemberStatus db userId membership GSMemAccepted updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` \_ -> pure () @@ -1811,7 +1811,7 @@ processChatCommand' vr = \case unless (groupFeatureAllowed SGFDirectMessages g) $ throwChatError $ CECommandError "direct messages not allowed" case memberConn m of Just mConn@Connection {peerChatVRange} -> do - unless (isCompatibleRange (fromJVersionRange peerChatVRange) xGrpDirectInvVRange) $ throwChatError CEPeerChatVRangeIncompatible + unless (maxVersion peerChatVRange >= groupDirectInvVersion) $ throwChatError CEPeerChatVRangeIncompatible when (isJust $ memberContactId m) $ throwChatError $ CECommandError "member contact already exists" subMode <- chatReadVar subscriptionMode (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode @@ -2890,7 +2890,7 @@ acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId inv let pqSup' = pqSup `CR.pqSupportAnd` pqSupport dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend acId <- withAgent $ \a -> acceptContact a True invId dm pqSup' subMode - withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode pqSup' contactUsed + withStore' $ \db -> createAcceptedContact db user acId cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile subMode pqSup' contactUsed acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> PQSupport -> m Contact acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed pqSup = do @@ -2898,7 +2898,7 @@ acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvI let profileToSend = profileToSendOnAccept user incognitoProfile False (cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode pqSup withStore' $ \db -> do - ct@Contact {activeConn} <- createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed + ct@Contact {activeConn} <- createAcceptedContact db user acId cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed forM_ activeConn $ \Connection {connId} -> setCommandConnId db user cmdId connId pure ct @@ -3677,7 +3677,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = subMode <- chatReadVar subscriptionMode groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode gVar <- asks random - withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode + withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds peerChatVRange subMode Just (gInfo, m@GroupMember {activeConn}) -> when (maybe False ((== ConnReady) . connStatus) activeConn) $ do notifyMemberConnected gInfo m $ Just ct @@ -3744,7 +3744,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = groupConnReq@(CRInvitationUri _ _) -> case cmdFunction of -- [async agent commands] XGrpMemIntro continuation on receiving INV CFCreateConnGrpMemInv - | isCompatibleRange (fromJVersionRange $ peerChatVRange conn) groupNoDirectVRange -> sendWithoutDirectCReq + | maxVersion (peerChatVRange conn) >= groupDirectInvVersion -> sendWithoutDirectCReq | otherwise -> sendWithDirectCReq where sendWithoutDirectCReq = do @@ -3840,9 +3840,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = memberConnectedChatItem gInfo m unless expectHistory $ forM_ description $ groupDescriptionChatItem gInfo m where - expectHistory = - groupFeatureAllowed SGFHistory gInfo - && isCompatibleRange (memberChatVRange' m) groupHistoryIncludeWelcomeVRange + expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion GCInviteeMember -> do memberConnectedChatItem gInfo m toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} @@ -3860,7 +3858,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendIntroductions members = do intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m shuffledIntros <- liftIO $ shuffleIntros intros - if isCompatibleRange (memberChatVRange' m) batchSendVRange + if m `supportsVersion` batchSendVersion then do let events = map (memberIntro . reMember) shuffledIntros forM_ (L.nonEmpty events) $ \events' -> @@ -3885,7 +3883,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId withStore' $ \db -> updateIntroStatus db introId GMIntroSent sendHistory = - when (isCompatibleRange (memberChatVRange' m) batchSendVRange) $ do + when (m `supportsVersion` batchSendVersion) $ do (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo 100) (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items let errors = map ChatErrorStore errs <> errs' @@ -3895,7 +3893,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendGroupMemberMessages user conn events'' groupId descrEvent_ :: Maybe (ChatMsgEvent 'Json) descrEvent_ - | isCompatibleRange (memberChatVRange' m) groupHistoryIncludeWelcomeVRange = do + | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do let GroupInfo {groupProfile = GroupProfile {description}} = gInfo fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description | otherwise = Nothing @@ -4323,7 +4321,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just groupId -> do gInfo <- withStore $ \db -> getGroupInfo db vr user groupId let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo - if isCompatibleRange chatVRange groupLinkNoContactVRange + if maxVersion chatVRange >= groupFastLinkJoinVersion then do mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing @@ -4972,7 +4970,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = connIds <- joinAgentConnectionAsync user True connRequest dm subMode withStore' $ \db -> do setViaGroupLinkHash db groupId connId - createMemberConnectionAsync db user hostId connIds (fromJVersionRange peerChatVRange) subMode + createMemberConnectionAsync db user hostId connIds peerChatVRange subMode updateGroupMemberStatusById db userId hostId GSMemAccepted updateGroupMemberStatus db userId membership GSMemAccepted toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) @@ -5408,8 +5406,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = groupConnIds <- createConn subMode directConnIds <- case memChatVRange of Nothing -> Just <$> createConn subMode - Just mcvr - | isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> pure Nothing + Just (ChatVersionRange mcvr) + | maxVersion mcvr >= groupDirectInvVersion -> pure Nothing | otherwise -> Just <$> createConn subMode let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo memRestrictions groupConnIds directConnIds customUserProfileId subMode @@ -5815,7 +5813,7 @@ sameMemberId memId GroupMember {memberId} = memId == memberId updatePeerChatVRange :: ChatMonad m => Connection -> VersionRangeChat -> m Connection updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange = do - let jMsgChatVRange = JVersionRange msgChatVRange + let jMsgChatVRange = msgChatVRange if jMsgChatVRange /= peerChatVRange then do withStore' $ \db -> setPeerChatVRange db connId msgChatVRange @@ -5824,7 +5822,7 @@ updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange = do updateMemberChatVRange :: ChatMonad m => GroupMember -> Connection -> VersionRangeChat -> m (GroupMember, Connection) updateMemberChatVRange mem@GroupMember {groupMemberId} conn@Connection {connId, peerChatVRange} msgChatVRange = do - let jMsgChatVRange = JVersionRange msgChatVRange + let jMsgChatVRange = msgChatVRange if jMsgChatVRange /= peerChatVRange then do withStore' $ \db -> do @@ -6132,7 +6130,7 @@ encodeConnInfo = encodeConnInfoPQ PQSupportOff encodeConnInfoPQ :: (MsgEncodingI e, ChatMonad m) => PQSupport -> ChatMsgEvent e -> m ByteString encodeConnInfoPQ pqSup chatMsgEvent = do chatVRange <- chatVersionRange pqSup - let shouldCompress = maxVersion chatVRange >= compressedBatchingVersion + let shouldCompress = maxVersion chatVRange >= pqEncryptionCompressionVersion r = encodeChatMessage maxConnInfoLength ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} case r of ECMEncoded encodedBody @@ -6166,12 +6164,18 @@ deliverMessagesB msgReqs = do void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent) withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent where - compressBodies = liftIO $ withCompressCtx (toEnum maxRawMsgLength) $ \cctx -> + compressBodies = liftIO $ withCompressCtx (toEnum maxRawMsgLength) $ \cctx -> do forM msgReqs $ \case - mr@(Right (conn@Connection {pqSupport, pqEncryption}, msgFlags, msgBody, msgId)) -> case pqSupport `CR.pqSupportOrEnc` pqEncryption of - PQSupportOn -> - Right . (\cBody -> (conn, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody - PQSupportOff -> pure mr + mr@(Right (conn@Connection {pqSupport, pqEncryption, peerChatVRange}, msgFlags, msgBody, msgId)) + | shouldCompress pqSupport pqEncryption -> + Right . (\cBody -> (conn, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody + | otherwise -> pure mr + where + --- TODO PQ + -- This version agreement is ephemeral and in case of peer downgrade it will get reduced, and pqSupport may be turned off in the result + -- We probably should store agreed version on Connection and do not allow reducing it. + chatV = maybe currentChatVersion (\(Compatible v') -> v') $ supportedChatVRange pqSupport `compatibleVersion` peerChatVRange + shouldCompress (PQSupport sup) (PQEncryption enc) = sup && (chatV >= pqEncryptionCompressionVersion && enc) skip -> pure skip toAgent = \case Right (conn@Connection {pqEncryption}, msgFlags, msgBody, _msgId) -> Right (aConnId conn, pqEncryption, msgFlags, msgBody) @@ -6207,7 +6211,7 @@ sendGroupMessage user gInfo members chatMsgEvent = do (Nothing, Just _) -> True _ -> False sendProfileUpdate = do - let members' = filter (\m -> isCompatibleRange (memberChatVRange' m) memberProfileUpdateVRange) members + let members' = filter (`supportsVersion` memberProfileUpdateVersion) members profileUpdateEvent = XInfo $ redactedMemberProfile $ fromLocalProfile p void $ sendGroupMessage' user gInfo members' profileUpdateEvent currentTs <- liftIO getCurrentTime @@ -6256,16 +6260,12 @@ memberSendAction chatMsgEvent members m@GroupMember {invitedByGroupMemberId} = c | isXGrpMsgForward chatMsgEvent = Nothing | otherwise = Just MSAPending where - forwardSupported = - let mcvr = memberChatVRange' m - in isCompatibleRange mcvr groupForwardVRange && invitingMemberSupportsForward + forwardSupported = m `supportsVersion` groupForwardVersion && invitingMemberSupportsForward invitingMemberSupportsForward = case invitedByGroupMemberId of Just invMemberId -> -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember case find (\m' -> groupMemberId' m' == invMemberId) members of - Just invitingMember -> do - let mcvr = memberChatVRange' invitingMember - isCompatibleRange mcvr groupForwardVRange + Just invitingMember -> invitingMember `supportsVersion` groupForwardVersion Nothing -> False Nothing -> False isXGrpMsgForward ev = case ev of diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 624de31f41..703850c85d 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -52,7 +52,7 @@ import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON) import Simplex.Messaging.Protocol (MsgBody) -import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$$>), (<$?>)) +import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) import Simplex.Messaging.Version hiding (version) -- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig. @@ -65,41 +65,37 @@ currentChatVersion = VersionChat 7 -- TODO remove parameterization in 5.7 supportedChatVRange :: PQSupport -> VersionRangeChat supportedChatVRange pq = mkVersionRange (VersionChat 1) $ case pq of - PQSupportOn -> compressedBatchingVersion + PQSupportOn -> pqEncryptionCompressionVersion PQSupportOff -> currentChatVersion {-# INLINE supportedChatVRange #-} --- version range that supports skipping establishing direct connections in a group -groupNoDirectVRange :: VersionRangeChat -groupNoDirectVRange = mkVersionRange (VersionChat 2) currentChatVersion - --- version range that supports establishing direct connection via x.grp.direct.inv with a group member -xGrpDirectInvVRange :: VersionRangeChat -xGrpDirectInvVRange = mkVersionRange (VersionChat 2) currentChatVersion +-- version range that supports skipping establishing direct connections in a group and establishing direct connection via x.grp.direct.inv +groupDirectInvVersion :: VersionChat +groupDirectInvVersion = VersionChat 2 -- version range that supports joining group via group link without creating direct contact -groupLinkNoContactVRange :: VersionRangeChat -groupLinkNoContactVRange = mkVersionRange (VersionChat 3) currentChatVersion +groupFastLinkJoinVersion :: VersionChat +groupFastLinkJoinVersion = VersionChat 3 -- version range that supports group forwarding -groupForwardVRange :: VersionRangeChat -groupForwardVRange = mkVersionRange (VersionChat 4) currentChatVersion +groupForwardVersion :: VersionChat +groupForwardVersion = VersionChat 4 -- version range that supports batch sending in groups -batchSendVRange :: VersionRangeChat -batchSendVRange = mkVersionRange (VersionChat 5) currentChatVersion +batchSendVersion :: VersionChat +batchSendVersion = VersionChat 5 -- version range that supports sending group welcome message in group history -groupHistoryIncludeWelcomeVRange :: VersionRangeChat -groupHistoryIncludeWelcomeVRange = mkVersionRange (VersionChat 6) currentChatVersion +groupHistoryIncludeWelcomeVersion :: VersionChat +groupHistoryIncludeWelcomeVersion = VersionChat 6 -- version range that supports sending member profile updates to groups -memberProfileUpdateVRange :: VersionRangeChat -memberProfileUpdateVRange = mkVersionRange (VersionChat 7) currentChatVersion +memberProfileUpdateVersion :: VersionChat +memberProfileUpdateVersion = VersionChat 7 --- version range that supports compressing messages -compressedBatchingVersion :: VersionChat -compressedBatchingVersion = VersionChat 8 +-- version range that supports compressing messages and PQ e2e encryption +pqEncryptionCompressionVersion :: VersionChat +pqEncryptionCompressionVersion = VersionChat 8 data ConnectionEntity = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact} diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 0385d96c69..4a87893e58 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -133,7 +133,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime) import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..)) import Database.SQLite.Simple.QQ (sql) import Simplex.Chat.Messages -import Simplex.Chat.Protocol (groupForwardVRange) +import Simplex.Chat.Protocol (groupForwardVersion) import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Shared import Simplex.Chat.Types @@ -156,7 +156,7 @@ type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Ver toGroupInfo :: VersionRangeChat -> Int64 -> GroupInfoRow -> GroupInfo toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. userMemberRow) = - let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange vr} + let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences} @@ -169,7 +169,7 @@ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, blockedByAdmin = maybe False mrsBlocked memberRestriction_ invitedBy = toInvitedBy userContactId invitedById activeConn = Nothing - memberChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer + memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer in GroupMember {..} toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember @@ -393,7 +393,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ |] (profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs) insertedRowId db - let JVersionRange hostVRange = peerChatVRange + let hostVRange = peerChatVRange GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} @@ -444,7 +444,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe memberContactId = Just $ contactId' userOrContact, memberContactProfileId = localProfileId (profile' userOrContact), activeConn = Nothing, - memberChatVRange = JVersionRange memberChatVRange + memberChatVRange } where insertMember_ :: IO ContactName @@ -789,10 +789,10 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, createWithRandomId gVar $ \memId -> do createdAt <- liftIO getCurrentTime member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt - void $ createMemberConnection_ db userId groupMemberId agentConnId (fromJVersionRange peerChatVRange) Nothing 0 createdAt subMode + void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode pure member where - JVersionRange (VersionRange minV maxV) = peerChatVRange + VersionRange minV maxV = peerChatVRange invitedByGroupMemberId = groupMemberId' membership createMember_ memberId createdAt = do insertMember_ @@ -873,7 +873,7 @@ createAcceptedMember groupMemberId <- liftIO $ insertedRowId db pure (groupMemberId, MemberId memId) where - JVersionRange (VersionRange minV maxV) = cReqChatVRange + VersionRange minV maxV = cReqChatVRange insertMember_ memberId createdAt = DB.execute db @@ -898,7 +898,7 @@ createAcceptedMemberConnection groupMemberId subMode = do createdAt <- liftIO getCurrentTime - Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId (fromJVersionRange cReqChatVRange) Nothing (Just userContactLinkId) Nothing 0 createdAt subMode PQSupportOff + Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) Nothing 0 createdAt subMode PQSupportOff setCommandConnId db user cmdId connId getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact @@ -1002,7 +1002,7 @@ createNewMember_ createdAt = do let invitedById = fromInvitedBy userContactId invitedBy activeConn = Nothing - mcvr@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange + memberChatVRange@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange DB.execute db [sql| @@ -1034,7 +1034,7 @@ createNewMember_ memberContactId, memberContactProfileId, activeConn, - memberChatVRange = JVersionRange mcvr + memberChatVRange } checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId) @@ -1174,7 +1174,7 @@ getForwardIntroducedMembers db user invitee highlyAvailable = do DB.query db (q <> " AND intro_chat_protocol_version >= ?") - (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange) + (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, groupForwardVersion) q = [sql| SELECT re_group_member_id @@ -1194,7 +1194,7 @@ getForwardInvitedMembers db user forwardMember highlyAvailable = do DB.query db (q <> " AND intro_chat_protocol_version >= ?") - (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange) + (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, groupForwardVersion) q = [sql| SELECT to_group_member_id @@ -1882,7 +1882,7 @@ createMemberContact cReq gInfo GroupMember {groupMemberId, localDisplayName, memberProfile, memberContactProfileId} - Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))} + Connection {connLevel, peerChatVRange = peerChatVRange@(VersionRange minV maxV)} subMode = do currentTs <- getCurrentTime let incognitoProfile = incognitoMembershipProfile gInfo @@ -2030,7 +2030,7 @@ createMemberContactConn_ user@User {userId} (cmdId, acId) gInfo - _memberConn@Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))} + _memberConn@Connection {connLevel, peerChatVRange = peerChatVRange@(VersionRange minV maxV)} contactId subMode = do currentTs <- liftIO getCurrentTime @@ -2169,7 +2169,7 @@ updateUnknownMemberAnnounced db user@User {userId} invitingMember unknownMember@ ) getGroupMemberById db user groupMemberId where - VersionRange minV maxV = maybe (fromJVersionRange memberChatVRange) fromChatVRange v + VersionRange minV maxV = maybe memberChatVRange fromChatVRange v updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO () updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs = diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 6824c94f0f..1a5b41be68 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -160,7 +160,7 @@ toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroup Connection { connId, agentConnId = AgentConnId acId, - peerChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer, + peerChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer, connLevel, viaContact, viaUserContactLink, @@ -216,7 +216,7 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange Connection { connId, agentConnId = AgentConnId acId, - peerChatVRange = JVersionRange peerChatVRange, + peerChatVRange, connType, contactConnInitiated = False, entityId, @@ -397,7 +397,7 @@ type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, In toContactRequest :: ContactRequestRow -> UserContactRequest toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, pqSupport, preferences, createdAt, updatedAt, minVer, maxVer)) = do let profile = Profile {displayName, fullName, image, contactLink, preferences} - cReqChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer + cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, createdAt, updatedAt} userQuery :: Query diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 3bfe3b8577..ec7ac736da 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -329,7 +329,7 @@ data UserContactRequest = UserContactRequest agentInvitationId :: AgentInvId, userContactLinkId :: Int64, agentContactConnId :: AgentConnId, -- connection id of user contact - cReqChatVRange :: JVersionRange, + cReqChatVRange :: VersionRangeChat, localDisplayName :: ContactName, profileId :: Int64, profile :: Profile, @@ -660,7 +660,7 @@ memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} = MemberInfo { memberId, memberRole, - v = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn, + v = ChatVersionRange . peerChatVRange <$> activeConn, profile = redactedMemberProfile $ fromLocalProfile memberProfile } @@ -742,7 +742,7 @@ data GroupMember = GroupMember -- member chat protocol version range; if member has active connection, its version range is preferred; -- for membership current supportedChatVRange is set, it's not updated on protocol version increase in database, -- but it's correctly set on read (see toGroupInfo) - memberChatVRange :: JVersionRange + memberChatVRange :: VersionRangeChat } deriving (Eq, Show) @@ -760,10 +760,12 @@ memberConnId :: GroupMember -> Maybe ConnId memberConnId GroupMember {activeConn} = aConnId <$> activeConn memberChatVRange' :: GroupMember -> VersionRangeChat -memberChatVRange' GroupMember {activeConn, memberChatVRange} = - fromJVersionRange $ case activeConn of - Just Connection {peerChatVRange} -> peerChatVRange - Nothing -> memberChatVRange +memberChatVRange' GroupMember {activeConn, memberChatVRange} = case activeConn of + Just Connection {peerChatVRange} -> peerChatVRange + Nothing -> memberChatVRange + +supportsVersion :: GroupMember -> VersionChat -> Bool +supportsVersion m v = maxVersion (memberChatVRange' m) >= v groupMemberId' :: GroupMember -> GroupMemberId groupMemberId' GroupMember {groupMemberId} = groupMemberId @@ -1340,7 +1342,7 @@ type ConnReqContact = ConnectionRequestUri 'CMContact data Connection = Connection { connId :: Int64, agentConnId :: AgentConnId, - peerChatVRange :: JVersionRange, + peerChatVRange :: VersionRangeChat, connLevel :: Int, viaContact :: Maybe Int64, -- group member contact ID, if not direct connection viaUserContactLink :: Maybe Int64, -- user contact link ID, if connected via "user address" @@ -1694,6 +1696,7 @@ type VersionRangeChat = VersionRange ChatVersion pattern VersionChat :: Word16 -> VersionChat pattern VersionChat v = Version v +-- this newtype exists to have a concise JSON encoding of version ranges in chat protocol messages in the form of "1-2" or just "1" newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRangeChat} deriving (Eq, Show) initialChatVersion :: VersionChat @@ -1709,18 +1712,6 @@ instance ToJSON ChatVersionRange where toJSON (ChatVersionRange vr) = strToJSON vr toEncoding (ChatVersionRange vr) = strToJEncoding vr -newtype JVersionRange = JVersionRange {fromJVersionRange :: VersionRangeChat} deriving (Eq, Show) - -instance FromJSON JVersionRange where - parseJSON = J.withObject "JVersionRange" $ \o -> do - minv <- o .: "minVersion" - maxv <- o .: "maxVersion" - maybe (fail "bad version range") (pure . JVersionRange) $ safeVersionRange minv maxv - -instance ToJSON JVersionRange where - toJSON (JVersionRange (VersionRange minV maxV)) = J.object ["minVersion" .= minV, "maxVersion" .= maxV] - toEncoding (JVersionRange (VersionRange minV maxV)) = J.pairs $ "minVersion" .= minV <> "maxVersion" .= maxV - $(JQ.deriveJSON defaultJSON ''UserContact) $(JQ.deriveJSON defaultJSON ''Profile) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index ed0095c531..276550a490 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1200,8 +1200,8 @@ viewConnectionVerified :: Maybe SecurityCode -> StyledString viewConnectionVerified (Just _) = "connection verified" -- TODO show verification time? viewConnectionVerified _ = "connection not verified, use " <> highlight' "/code" <> " command to see security code" -viewPeerChatVRange :: JVersionRange -> StyledString -viewPeerChatVRange (JVersionRange (VersionRange minVer maxVer)) = "peer chat protocol version range: (" <> sShow minVer <> ", " <> sShow maxVer <> ")" +viewPeerChatVRange :: VersionRangeChat -> StyledString +viewPeerChatVRange (VersionRange minVer maxVer) = "peer chat protocol version range: (" <> sShow minVer <> ", " <> sShow maxVer <> ")" viewConnectionStats :: ConnectionStats -> [StyledString] viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =