From bc2b1358801c0a15c4df1d0c38a6c6ccfba3682f Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 7 Mar 2024 17:39:09 +0400 Subject: [PATCH] core (pq): update types (#3872) * core (pq): update types * imports * encode / max msg size types * integrate new types * update types/pq support * tests compile --------- Co-authored-by: Evgeny Poberezkin --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 411 +++++++++--------- src/Simplex/Chat/Controller.hs | 10 +- src/Simplex/Chat/Messages/CIContent.hs | 68 +-- src/Simplex/Chat/Messages/CIContent/Events.hs | 5 +- src/Simplex/Chat/Protocol.hs | 27 +- src/Simplex/Chat/Store/Direct.hs | 25 +- src/Simplex/Chat/Store/Files.hs | 4 +- src/Simplex/Chat/Store/Groups.hs | 18 +- src/Simplex/Chat/Store/Profiles.hs | 3 +- src/Simplex/Chat/Store/Shared.hs | 31 +- src/Simplex/Chat/Types.hs | 16 +- src/Simplex/Chat/View.hs | 3 +- tests/ChatClient.hs | 7 +- tests/ChatTests/Direct.hs | 22 +- tests/ChatTests/Groups.hs | 8 +- tests/ChatTests/Utils.hs | 8 +- tests/ProtocolTests.hs | 12 +- 19 files changed, 361 insertions(+), 321 deletions(-) diff --git a/cabal.project b/cabal.project index 64e2e5e447..f7f929a95b 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: e04705d9c5e6b3d3652f909a5176c375acf29411 + tag: 11288866f90bafb0892701b0e0679eddb030b5df source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 40228c262d..2faa7a1dd4 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."e04705d9c5e6b3d3652f909a5176c375acf29411" = "1dc4nv5zcbv4712sjv0ncyswdcx4igwzhgybx1rd9x6a7mwv2kr5"; + "https://github.com/simplex-chat/simplexmq.git"."00ae2cb6e134e3cd7c8089e30f95a9430d3c4e3d" = "1dvghlsrf0dw8g279gnb4m2s7jrj9bwdibcq61hkkb9h5975f93d"; "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 d8089d48d2..8a5f88f45f 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -102,7 +102,7 @@ import Simplex.Messaging.Compression (withCompressCtx) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF -import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOff) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKNoPQ, pattern IKPQOff, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String @@ -247,7 +247,7 @@ newChatController encryptLocalFiles <- newTVarIO False tempDirectory <- newTVarIO Nothing contactMergeEnabled <- newTVarIO True - pqExperimentalEnabled <- newTVarIO False + pqExperimentalEnabled <- newTVarIO PQSupportOff pure ChatController { firstTime, @@ -368,7 +368,7 @@ subscribeUsers :: forall m. ChatMonad' m => Bool -> [User] -> m () subscribeUsers onlyNeeded users = do let (us, us') = partition activeUser users -- TODO PQ this is only used to set membership version range - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff subscribe vr us subscribe vr us' where @@ -451,7 +451,7 @@ parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace -- | Chat API commands interpreted in context of a local zone processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse processChatCommand cmd = - chatVersionRange PQEncOff -- TODO PQ this is only used to set membership version range (?) + chatVersionRange PQSupportOff -- TODO PQ this is only used to set membership version range (?) >>= (`processChatCommand'` cmd) {-# INLINE processChatCommand #-} @@ -595,23 +595,20 @@ processChatCommand' vr = \case chatWriteVar remoteHostsFolder $ Just rf ok_ APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_ - SetContactMergeEnabled onOff -> do - asks contactMergeEnabled >>= atomically . (`writeTVar` onOff) - ok_ - APISetPQEnabled onOff -> do - asks pqExperimentalEnabled >>= atomically . (`writeTVar` onOff) - ok_ + SetContactMergeEnabled onOff -> chatWriteVar contactMergeEnabled onOff >> ok_ + APISetPQEnabled onOff -> chatWriteVar pqExperimentalEnabled onOff >> ok_ APIAllowContactPQ contactId -> withUser $ \user -> do ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId -- TODO PQ check different flag? case activeConn of - Just conn@Connection {connId, enablePQ} - | enablePQ -> pure $ chatCmdError (Just user) "already allowed" - | otherwise -> do - withStore' $ \db -> allowConnEnablePQ db connId - let conn' = conn {enablePQ = True} :: Connection - ct' = ct {activeConn = Just conn'} :: Contact - pure $ CRContactPQAllowed user ct' + Just conn@Connection {connId, pqEncryption} -> case pqEncryption of + PQEncOn -> pure $ chatCmdError (Just user) "already allowed" + PQEncOff -> do + -- TODO PQ add / change database field(s) + withStore' $ \db -> allowConnEnablePQ db connId + let conn' = conn {pqSupport = PQSupportOn, pqEncryption = PQEncOn} :: Connection + ct' = ct {activeConn = Just conn'} :: Contact + pure $ CRContactPQAllowed user ct' Nothing -> throwChatError $ CEContactNotActive ct APIExportArchive cfg -> checkChatStopped $ exportArchive cfg >> ok_ ExportArchive -> do @@ -1306,8 +1303,8 @@ processChatCommand' vr = \case APISyncContactRatchet contactId force -> withUser $ \user -> withChatLock "syncContactRatchet" $ do ct <- withStore $ \db -> getContact db user contactId case contactConn ct of - Just conn@Connection {enablePQ} -> do - cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (aConnId conn) (CR.PQEncryption enablePQ) force + Just conn@Connection {pqSupport} -> do + cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (aConnId conn) pqSupport force createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCERatchetSync rss Nothing) Nothing pure $ CRContactRatchetSyncStarted user ct cStats Nothing -> throwChatError $ CEContactNotActive ct @@ -1315,7 +1312,7 @@ processChatCommand' vr = \case (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId case memberConnId m of Just connId -> do - cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId CR.PQEncOff force + cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId PQSupportOff force createInternalChatItem user (CDGroupSnd g) (CISndConnEvent . SCERatchetSync rss . Just $ groupMemberRef m) Nothing pure $ CRGroupMemberRatchetSyncStarted user g m cStats _ -> throwChatError CEGroupMemberNotActive @@ -1404,9 +1401,9 @@ processChatCommand' vr = \case -- [incognito] generate profile for connection incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing subMode <- chatReadVar subscriptionMode - enablePQ <- readTVarIO =<< asks pqExperimentalEnabled - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing (CR.IKNoPQ $ CR.PQEncryption enablePQ) subMode - conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile subMode enablePQ + pqSup <- chatReadVar pqExperimentalEnabled + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing (IKNoPQ pqSup) subMode + conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile subMode pqSup pure $ CRInvitation user cReq conn AddContact incognito -> withUser $ \User {userId} -> processChatCommand $ APIAddContact userId incognito @@ -1433,10 +1430,15 @@ processChatCommand' vr = \case -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing False - enablePQ <- readTVarIO =<< asks pqExperimentalEnabled - dm <- directMessagePQ (CR.PQEncryption enablePQ) maxConnInfoLength $ XInfo profileToSend - connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm (CR.PQEncryption enablePQ) subMode - conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode enablePQ + pqSup <- chatReadVar pqExperimentalEnabled + -- TODO PQ connRequestPQSupport + -- connRequestPQSupport :: AgentMonad' m => PQSupport -> ConnectionRequestUri c -> m (Maybe PQSupport) + -- connRequestPQSupport pqSup cReq + -- or if you know support of another side alread (e.g. in REQ) use: + -- pqSupportAnd :: PQSupport -> PQSupport -> PQSupport + dm <- encodeConnInfoPQ pqSup $ XInfo profileToSend + connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup subMode + conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode pqSup pure $ CRSentConfirmation user conn APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq @@ -1470,7 +1472,8 @@ processChatCommand' vr = \case processChatCommand $ APIListContacts userId APICreateMyAddress userId -> withUserId userId $ \user -> withChatLock "createMyAddress" . procCmd $ do subMode <- chatReadVar subscriptionMode - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing CR.IKPQOff subMode + -- TODO v5.7 pass IPPQOn + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing IKPQOff subMode withStore $ \db -> createUserContactLink db user connId cReq subMode pure $ CRUserContactLinkCreated user cReq CreateMyAddress -> withUser $ \User {userId} -> @@ -1607,7 +1610,7 @@ processChatCommand' vr = \case -- [incognito] generate incognito profile for group membership incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing groupInfo <- withStore $ \db -> createNewGroup db vr gVar user gProfile incognitoProfile - createInternalChatItem user (CDGroupSnd groupInfo) (CISndGroupE2EEInfo $ E2EEInfo {pqEnabled = False}) Nothing + createInternalChatItem user (CDGroupSnd groupInfo) (CISndGroupE2EEInfo $ E2EInfo {pqEnabled = PQEncOff}) Nothing pure $ CRGroupCreated user groupInfo NewGroup incognito gProfile -> withUser $ \User {userId} -> processChatCommand $ APINewGroup userId incognito gProfile @@ -1627,7 +1630,7 @@ processChatCommand' vr = \case Nothing -> do gVar <- asks random subMode <- chatReadVar subscriptionMode - (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing CR.IKPQOff subMode + (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode member <- withStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode sendInvitation member cReq pure $ CRSentGroupInvitation user gInfo contact member @@ -1651,8 +1654,8 @@ processChatCommand' vr = \case case activeConn of Just Connection {peerChatVRange} -> do subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XGrpAcpt membershipMemId - agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm CR.PQEncOff subMode + 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 updateGroupMemberStatus db userId fromMember GSMemAccepted @@ -1788,7 +1791,7 @@ processChatCommand' vr = \case groupLinkId <- GroupLinkId <$> drgRandomBytes 16 subMode <- chatReadVar subscriptionMode let crClientData = encodeJSON $ CRDataGroup groupLinkId - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact (Just crClientData) CR.IKPQOff subMode + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact (Just crClientData) IKPQOff subMode withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole subMode pure $ CRGroupLinkCreated user gInfo cReq mRole APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withChatLock "groupLinkMemberRole " $ do @@ -1815,7 +1818,7 @@ processChatCommand' vr = \case unless (isCompatibleRange (fromJVersionRange peerChatVRange) xGrpDirectInvVRange) $ 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 CR.IKPQOff subMode + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode -- [incognito] reuse membership incognito profile ct <- withStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode -- TODO not sure it is correct to set connections status here? @@ -1828,7 +1831,7 @@ processChatCommand' vr = \case case memberConn m of Just mConn -> do let msg = XGrpDirectInv cReq msgContent_ - (sndMsg, _, _) <- sendDirectMessage mConn CR.PQEncOff msg $ GroupId groupId + (sndMsg, _, _) <- sendDirectMemberMessage mConn msg groupId withStore' $ \db -> setContactGrpInvSent db ct True let ct' = ct {contactGrpInvSent = True} forM_ msgContent_ $ \mc -> do @@ -2162,27 +2165,32 @@ processChatCommand' vr = \case connect' (Just gLinkId) cReqHash xContactId True where connect' groupLinkId cReqHash xContactId inGroup = do - enablePQ <- (not inGroup &&) <$> (readTVarIO =<< asks pqExperimentalEnabled) - (connId, incognitoProfile, subMode) <- requestContact user incognito cReq xContactId inGroup (CR.PQEncryption enablePQ) - conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode enablePQ + pqSup <- if inGroup then pure PQSupportOff else chatReadVar pqExperimentalEnabled + (connId, incognitoProfile, subMode) <- requestContact user incognito cReq xContactId inGroup pqSup + conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode pqSup pure $ CRSentInvitation user conn incognitoProfile connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> m ChatResponse connectContactViaAddress user incognito ct cReq = withChatLock "connectViaContact" $ do newXContactId <- XContactId <$> drgRandomBytes 16 - enablePQ <- readTVarIO =<< asks pqExperimentalEnabled - (connId, incognitoProfile, subMode) <- requestContact user incognito cReq newXContactId False (CR.PQEncryption enablePQ) + pqSup <- chatReadVar pqExperimentalEnabled + (connId, incognitoProfile, subMode) <- requestContact user incognito cReq newXContactId False pqSup let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq - ct' <- withStore $ \db -> createAddressContactConnection db user ct connId cReqHash newXContactId incognitoProfile subMode enablePQ + ct' <- withStore $ \db -> createAddressContactConnection db user ct connId cReqHash newXContactId incognitoProfile subMode pqSup pure $ CRSentInvitationToContact user ct' incognitoProfile - requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> PQEncryption -> m (ConnId, Maybe Profile, SubscriptionMode) - requestContact user incognito cReq xContactId inGroup pqEnc = do + requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> PQSupport -> m (ConnId, Maybe Profile, SubscriptionMode) + requestContact user incognito cReq xContactId inGroup pqSup = do -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup - dm <- directMessagePQ pqEnc maxConnInfoLength (XContact profileToSend $ Just xContactId) + -- TODO PQ connecting via address + -- 0) toggle disabled - PQSupportOff + -- 1) toggle enabled, address supports PQ (connRequestPQSupport returns Just True) - PQSupportOn, enable support with compression + -- 2) toggle enabled, address doesn't support PQ - PQSupportOn but without compression, with version range indicating support + -- see joinContactInitialKeys: PQSupportOn -> IKUsePQ - I will change to IKNoPQ PQSupportOn + dm <- encodeConnInfoPQ pqSup (XContact profileToSend $ Just xContactId) subMode <- chatReadVar subscriptionMode - connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqEnc subMode + connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup subMode pure (connId, incognitoProfile, subMode) contactMember :: Contact -> [GroupMember] -> Maybe GroupMember contactMember Contact {contactId} = @@ -2236,12 +2244,12 @@ processChatCommand' vr = \case mergedProfile = userProfileToSend user Nothing (Just ct) False ct' = updateMergedPreferences user' ct mergedProfile' = userProfileToSend user' Nothing (Just ct') False - ctSndMsg :: ChangedProfileContact -> (ConnOrGroupId, PQEncryption, ChatMsgEvent 'Json) - ctSndMsg ChangedProfileContact {mergedProfile', conn = Connection {connId, enablePQ}} = (ConnectionId connId, CR.PQEncryption enablePQ, XInfo mergedProfile') + ctSndMsg :: ChangedProfileContact -> (ConnOrGroupId, PQSupport, ChatMsgEvent 'Json) + ctSndMsg ChangedProfileContact {mergedProfile', conn = Connection {connId, pqSupport}} = (ConnectionId connId, pqSupport, XInfo mergedProfile') ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError MsgReq - ctMsgReq ChangedProfileContact {conn = conn@Connection {enablePQ}} = + ctMsgReq ChangedProfileContact {conn} = fmap $ \SndMessage {msgId, msgBody} -> - (conn, CR.PQEncryption enablePQ, MsgFlags {notification = hasNotification XInfo_}, msgBody, msgId) + (conn, MsgFlags {notification = hasNotification XInfo_}, msgBody, msgId) updateContactPrefs :: User -> Contact -> Preferences -> m ChatResponse updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' @@ -2745,12 +2753,12 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI RFSCancelled _ -> throwChatError $ CEFileCancelled fName _ -> throwChatError $ CEFileAlreadyReceiving fName -- TODO PQ this is only used to set membership version range - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff case (xftpRcvFile, fileConnReq) of -- direct file protocol (Nothing, Just connReq) -> do subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XFileAcpt fName + dm <- encodeConnInfo $ XFileAcpt fName connIds <- joinAgentConnectionAsync user True connReq dm subMode filePath <- getRcvFilePath fileId filePath_ fName True withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnJoined filePath subMode @@ -2776,7 +2784,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI GroupMember {activeConn} <- withStoreCtx (Just "acceptFileReceive, getGroupMember") $ \db -> getGroupMember db user groupId memId case activeConn of Just conn -> do - acceptFile CFCreateConnFileInvGroup $ \msg -> void $ sendDirectMessage conn CR.PQEncOff msg $ GroupId groupId + acceptFile CFCreateConnFileInvGroup $ \msg -> void $ sendDirectMemberMessage conn msg groupId _ -> throwChatError $ CEFileInternal "member connection not active" _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" where @@ -2785,7 +2793,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI filePath <- getRcvFilePath fileId filePath_ fName True inline <- receiveInline -- TODO PQ this is only used to set membership version range - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff if | inline -> do -- accepting inline @@ -2833,7 +2841,7 @@ receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile startReceivingFile :: ChatMonad m => User -> FileTransferId -> m () startReceivingFile user fileId = do -- TODO PQ this is only used to set membership version range - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff ci <- withStoreCtx (Just "startReceivingFile, updateRcvFileStatus ...") $ \db -> do liftIO $ updateRcvFileStatus db fileId FSConnected liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1 @@ -2878,18 +2886,19 @@ acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe Incog acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile contactUsed = do subMode <- chatReadVar subscriptionMode let profileToSend = profileToSendOnAccept user incognitoProfile False - enablePQ <- readTVarIO =<< asks pqExperimentalEnabled - dm <- directMessagePQ (CR.PQEncryption enablePQ) maxConnInfoLength $ XInfo profileToSend - acId <- withAgent $ \a -> acceptContact a True invId dm (CR.PQEncryption enablePQ) subMode - withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode enablePQ contactUsed + pqSup <- chatReadVar pqExperimentalEnabled + -- TODO combine pqSup with pqSupport from UserContactRequest + 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 -acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> PQFlag -> m Contact -acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed pqEnabled = do +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 subMode <- chatReadVar subscriptionMode let profileToSend = profileToSendOnAccept user incognitoProfile False - (cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode (CR.PQEncryption pqEnabled) + (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 pqEnabled contactUsed + ct@Contact {activeConn} <- createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed forM_ activeConn $ \Connection {connId} -> setCommandConnId db user cmdId connId pure ct @@ -2915,7 +2924,7 @@ acceptGroupJoinRequestAsync groupSize = Just currentMemCount } subMode <- chatReadVar subscriptionMode - connIds <- agentAcceptContactAsync user True invId msg subMode (CR.PQEncryption False) + connIds <- agentAcceptContactAsync user True invId msg subMode (PQSupport False) withStore $ \db -> do liftIO $ createAcceptedMemberConnection db user connIds ucr groupMemberId subMode getGroupMemberById db user groupMemberId @@ -3205,7 +3214,7 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime deleteAt ts waitChatStartedAndActivated -- TODO PQ this is only used to set membership version range - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff case cType of CTDirect -> do (ct, CChatItem _ ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId @@ -3227,7 +3236,7 @@ expireChatItems :: forall m. ChatMonad m => User -> Int64 -> Bool -> m () expireChatItems user@User {userId} ttl sync = do currentTs <- liftIO getCurrentTime -- TODO PQ this is only used to set membership version range - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff let expirationDate = addUTCTime (-1 * fromIntegral ttl) currentTs -- this is to keep group messages created during last 12 hours even if they're expired according to item_ts createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs @@ -3275,7 +3284,7 @@ processAgentMessage _ connId DEL_CONN = toView $ CRAgentConnDeleted (AgentConnId connId) processAgentMessage corrId connId msg = do -- TODO PQ this is only used to set membership version range (?) - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff withStore' (`getUserByAConnId` AgentConnId connId) >>= \case Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CRChatError (Just user)) _ -> throwChatError $ CENoConnectionUser (AgentConnId connId) @@ -3315,7 +3324,7 @@ processAgentMsgSndFile _corrId aFileId msg = fileId <- getXFTPSndFileDBId db user $ AgentSndFileId aFileId getSndFileTransfer db user fileId -- TODO PQ this is only used to set membership version range - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff unless cancelled $ case msg of SFPROG sndProgress sndTotal -> do let status = CIFSSndTransfer {sndProgress, sndTotal} @@ -3373,7 +3382,7 @@ processAgentMsgSndFile _corrId aFileId msg = sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m () sendToMember (rfd, (conn, sft)) = void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> do - (sndMsg, msgDeliveryId, _) <- sendDirectMessage conn CR.PQEncOff msg' $ GroupId groupId + (sndMsg, msgDeliveryId, _) <- sendDirectMemberMessage conn msg' groupId pure (sndMsg, msgDeliveryId) _ -> pure () _ -> pure () -- TODO error? @@ -3435,7 +3444,7 @@ processAgentMsgRcvFile _corrId aFileId msg = fileId <- getXFTPRcvFileDBId db $ AgentRcvFileId aFileId getRcvFileTransfer db user fileId -- TODO PQ this is only used to set membership version range - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff unless (rcvFileCompleteOrCancelled ft) $ case msg of RFPROG rcvProgress rcvTotal -> do let status = CIFSRcvTransfer {rcvProgress, rcvTotal} @@ -3497,21 +3506,24 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = agentMsgConnStatus :: ACommand 'Agent e -> Maybe ConnStatus agentMsgConnStatus = \case CONF {} -> Just ConnRequested - INFO _ -> Just ConnSndReady + INFO {} -> Just ConnSndReady CON _ -> Just ConnReady _ -> Nothing processDirectMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> Maybe Contact -> m () processDirectMessage agentMsg connEntity conn@Connection {connId, peerChatVRange, viaUserContactLink, customUserProfileId, connectionCode} = \case Nothing -> case agentMsg of - CONF confId _ connInfo -> do + -- TODO PQ if connection was created with PQSupportOn and CONF has PQSupportOff, then disable it in connection (store in DB, update connection object, pass PQSupportOff) + -- if the opposite, ignore or log warning + CONF confId pqSupport _ connInfo -> do -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing False conn' <- saveConnInfo conn connInfo -- [async agent commands] no continuation needed, but command should be asynchronous for stability allowAgentConnectionAsync user conn' confId $ XInfo profileToSend - INFO connInfo -> do + -- TODO PQ if connection has pqSupport different from pqSupport in INFO log warning, ignore + INFO pqSupport connInfo -> do _conn' <- saveConnInfo conn connInfo pure () MSG meta _msgFlags msgBody -> do @@ -3552,15 +3564,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendXGrpMemInv hostConnId (Just directConnReq) xGrpMemIntroCont CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" MSG msgMeta _msgFlags msgBody -> do - let MsgMeta {pqEncryption = CR.PQEncryption pqRcvEnabled} = msgMeta - (ct', conn') <- updateContactPQRcv user ct conn pqRcvEnabled + let MsgMeta {pqEncryption} = msgMeta + (ct', conn') <- updateContactPQRcv user ct conn pqEncryption checkIntegrityCreateItem (CDDirectRcv ct') msgMeta cmdId <- createAckCmd conn' withAckMessage agentConnId cmdId msgMeta $ do (conn'', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveDirectRcvMSG conn' msgMeta cmdId msgBody let ct'' = ct' {activeConn = Just conn''} :: Contact assertDirectAllowed user MDRcv ct'' $ toCMEventTag event - updateChatLock "directMessage" event + updateChatLock "direct message" event case event of XMsgNew mc -> newContentMessage ct'' mc msg msgMeta XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct'' sharedMsgId fileDescr @@ -3589,7 +3601,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = RCVD msgMeta msgRcpt -> withAckMessage' agentConnId conn msgMeta $ directMsgReceived ct conn msgMeta msgRcpt - CONF confId _ connInfo -> do + -- TODO PQ this will happen with members and with contact cards - same as above + CONF confId pqSupport _ connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of @@ -3607,7 +3620,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = allowAgentConnectionAsync user conn' confId $ XInfo p void $ withStore' $ \db -> resetMemberContactFields db ct' _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info" - INFO connInfo -> do + INFO pqSupport connInfo -> do + -- TODO PQ log warning same above ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo _conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of @@ -3619,18 +3633,18 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = void $ processContactProfileUpdate ct profile False XOk -> pure () _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" - CON (CR.PQEncryption pqEnabled) -> + CON pqEnc -> withStore' (\db -> getViaGroupMember db vr user ct) >>= \case Nothing -> do - withStore' $ \db -> updateConnPQEnabledCON db connId pqEnabled - let conn' = conn {pqSndEnabled = Just pqEnabled, pqRcvEnabled = Just pqEnabled} :: Connection + withStore' $ \db -> updateConnPQEnabledCON db connId pqEnc + let conn' = conn {pqSndEnabled = Just pqEnc, pqRcvEnabled = Just pqEnc} :: Connection ct' = ct {activeConn = Just conn'} :: Contact -- [incognito] print incognito profile used for this contact incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) setContactNetworkStatus ct' NSConnected toView $ CRContactConnected user ct' (fmap fromLocalProfile incognitoProfile) when (directOrUsed ct') $ do - createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ E2EEInfo pqEnabled) Nothing + createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ E2EInfo pqEnc) Nothing createFeatureEnabledItems ct' when (contactConnInitiated conn') $ do let Connection {groupLinkId} = conn' @@ -3759,7 +3773,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing _ -> throwChatError $ CECommandError "unexpected cmdFunction" CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" - CONF confId _ connInfo -> do + CONF confId _pqSupport _ connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo conn' <- updatePeerChatVRange conn chatVRange case memberCategory m of @@ -3783,7 +3797,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = allowAgentConnectionAsync user conn' confId $ XGrpMemInfo membershipMemId membershipProfile | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" _ -> messageError "CONF from member must have x.grp.mem.info" - INFO connInfo -> do + INFO _pqSupport connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo _conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of @@ -3807,7 +3821,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case memberCategory m of GCHostMember -> do toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} - createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupE2EEInfo $ E2EEInfo {pqEnabled = False}) Nothing + createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupE2EEInfo $ E2EInfo {pqEnabled = PQEncOff}) Nothing createGroupFeatureItems gInfo m let GroupInfo {groupProfile = GroupProfile {description}} = gInfo memberConnectedChatItem gInfo m @@ -3829,7 +3843,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendXGrpLinkMem = do let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo profileToSend = profileToSendOnAccept user profileMode True - void $ sendDirectMessage conn CR.PQEncOff (XGrpLinkMem profileToSend) (GroupId groupId) + void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId sendIntroductions members = do intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m shuffledIntros <- liftIO $ shuffleIntros intros @@ -3855,7 +3869,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image processIntro intro@GroupMemberIntro {introId} = do - void $ sendDirectMessage conn CR.PQEncOff (memberIntro $ reMember intro) (GroupId groupId) + void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId withStore' $ \db -> updateIntroStatus db introId GMIntroSent sendHistory = when (isCompatibleRange (memberChatVRange' m) batchSendVRange) $ do @@ -3954,12 +3968,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = forM_ (invitedByGroupMemberId membership) $ \hostId -> do host <- withStore $ \db -> getGroupMember db user groupId hostId forM_ (memberConn host) $ \hostConn -> - void $ sendDirectMessage hostConn CR.PQEncOff (XGrpMemCon memberId) (GroupId groupId) + void $ sendDirectMemberMessage hostConn (XGrpMemCon memberId) groupId GCPostMember -> forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do im <- withStore $ \db -> getGroupMember db user groupId invitingMemberId forM_ (memberConn im) $ \imConn -> - void $ sendDirectMessage imConn CR.PQEncOff (XGrpMemCon memberId) (GroupId groupId) + void $ sendDirectMemberMessage imConn (XGrpMemCon memberId) groupId _ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected" MSG msgMeta _msgFlags msgBody -> do checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta @@ -4131,7 +4145,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case agentMsg of -- SMP CONF for SndFileConnection happens for direct file protocol -- when recipient of the file "joins" connection created by the sender - CONF confId _ connInfo -> do + CONF confId _pqSupport _ connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of @@ -4192,7 +4206,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case activeConn of Just gMemberConn -> do sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId - void $ sendDirectMessage gMemberConn CR.PQEncOff (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) $ GroupId groupId + void $ sendDirectMemberMessage gMemberConn (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) groupId _ -> throwChatError $ CECommandError "no GroupMember activeConn" _ -> throwChatError $ CECommandError "no grpMemberId" _ -> throwChatError $ CECommandError "unexpected cmdFunction" @@ -4200,7 +4214,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- SMP CONF for RcvFileConnection happens for group file protocol -- when sender of the file "joins" connection created by the recipient -- (sender doesn't create connections for all group members) - CONF confId _ connInfo -> do + CONF confId _pqSupport _ connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of @@ -4261,7 +4275,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> m () processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of - REQ invId _ connInfo -> do + REQ invId pqSupport _ connInfo -> do + -- TODO PQ this pqSupport needs to be combined with user's choice in toggle, then enable PQ support ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo case chatMsgEvent of XContact p xContactId_ -> profileContactRequest invId chatVRange p xContactId_ @@ -4289,8 +4304,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Nothing -> do -- [incognito] generate profile to send, create connection with incognito profile incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing - enablePQ <- readTVarIO =<< asks pqExperimentalEnabled - ct <- acceptContactRequestAsync user cReq incognitoProfile True enablePQ + pqSup <- chatReadVar pqExperimentalEnabled + -- TODO PQ combine pqSup with pqSupport in REQ + ct <- acceptContactRequestAsync user cReq incognitoProfile True pqSup toView $ CRAcceptingContactRequest user ct Just groupId -> do gInfo <- withStore $ \db -> getGroupInfo db vr user groupId @@ -4301,7 +4317,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CRAcceptingGroupJoinRequestMember user gInfo mem else do - ct <- acceptContactRequestAsync user cReq profileMode False False + -- TODO v5.7 remove old API (or v6.0?) + ct <- acceptContactRequestAsync user cReq profileMode False PQSupportOff toView $ CRAcceptingGroupJoinRequest user gInfo ct _ -> toView $ CRReceivedContactRequest user cReq @@ -4437,7 +4454,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) where sendProbe :: Probe -> m () - sendProbe probe = void $ sendDirectMessage conn CR.PQEncOff (XInfoProbe probe) (GroupId groupId) + sendProbe probe = void $ sendDirectMemberMessage conn (XInfoProbe probe) groupId sendProbeHashes :: [ContactOrMember] -> Probe -> Int64 -> m () sendProbeHashes cgms probe probeId = @@ -4451,7 +4468,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendProbeHash (COMGroupMember GroupMember {activeConn = Nothing}) = pure () sendProbeHash cgm@(COMGroupMember m@GroupMember {groupId, activeConn = Just conn}) = when (memberCurrent m) $ do - void $ sendDirectMessage conn CR.PQEncOff (XInfoProbeCheck probeHash) (GroupId groupId) + void $ sendDirectMemberMessage conn (XInfoProbeCheck probeHash) groupId withStore' $ \db -> createSentProbeHash db userId probeId cgm messageWarning :: Text -> m () @@ -4808,7 +4825,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- receiving via a separate connection Just fileConnReq -> do subMode <- chatReadVar subscriptionMode - dm <- directMessage XOk + dm <- encodeConnInfo XOk connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode withStore' $ \db -> createSndDirectFTConnection db user fileId connIds subMode -- receiving inline @@ -4905,7 +4922,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = subMode <- chatReadVar subscriptionMode -- receiving via a separate connection -- [async agent commands] no continuation needed, but command should be asynchronous for stability - dm <- directMessage XOk + dm <- encodeConnInfo XOk connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode withStore' $ \db -> createSndGroupFileTransferConnection db user fileId connIds m subMode (_, Just conn) -> do @@ -4939,7 +4956,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = if sameGroupLinkId groupLinkId groupLinkId' then do subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XGrpAcpt membershipMemId + dm <- encodeConnInfo $ XGrpAcpt membershipMemId connIds <- joinAgentConnectionAsync user True connRequest dm subMode withStore' $ \db -> do setViaGroupLinkHash db groupId connId @@ -5136,7 +5153,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case cgm2 of COMContact c2@Contact {profile = p2} | memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do - void $ sendDirectMessage conn CR.PQEncOff (XInfoProbeOk probe) (GroupId groupId) + void $ sendDirectMemberMessage conn (XInfoProbeOk probe) groupId COMContact <$$> associateMemberAndContact c2 m1 | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing @@ -5392,7 +5409,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do hostConn <- withStore $ \db -> getConnectionById db user hostConnId let msg = XGrpMemInv memberId IntroInvitation {groupConnReq, directConnReq} - void $ sendDirectMessage hostConn CR.PQEncOff msg (GroupId groupId) + void $ sendDirectMemberMessage hostConn msg groupId withStore' $ \db -> updateGroupMemberStatusById db userId groupMemberId GSMemIntroInvited xGrpMemInv :: GroupInfo -> GroupMember -> MemberId -> IntroInvitation -> m () @@ -5424,7 +5441,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = subMode <- chatReadVar subscriptionMode -- [incognito] send membership incognito profile, create direct connection as incognito let membershipProfile = redactedMemberProfile $ fromLocalProfile $ memberProfile membership - dm <- directMessage $ XGrpMemInfo membershipMemId membershipProfile + dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile -- [async agent commands] no continuation needed, but commands should be asynchronous for stability groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode @@ -5628,7 +5645,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = joinConn subMode = do -- [incognito] send membership incognito profile let p = userProfileToSend user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing False - dm <- directMessage $ XInfo p + dm <- encodeConnInfo $ XInfo p joinAgentConnectionAsync user True connReq dm subMode createItems mCt' m' = do createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing @@ -5747,42 +5764,33 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = toView $ CRChatItemStatusUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) chatItem) _ -> pure () -createContactPQSndItem :: ChatMonad m => User -> Contact -> Connection -> PQFlag -> m (Contact, Connection) +createContactPQSndItem :: ChatMonad m => User -> Contact -> Connection -> PQEncryption -> m (Contact, Connection) createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' = - -- TODO PQ refactor (?) check for pqSndEnabled change with updatePQSndEnabled in deliverMessagesB flip catchChatError (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of - (Nothing, False) -> pure (ct, conn) - (Nothing, True) -> createPQItem $ CISndDirectE2EEInfo (E2EEInfo pqSndEnabled') - (Just b, b') - | b' /= b -> createPQItem $ CISndConnEvent (SCEPQEnabled pqSndEnabled') - | otherwise -> pure (ct, conn) + (Just b, b') | b' /= b -> createPQItem $ CISndConnEvent (SCEPqEnabled pqSndEnabled') + (Nothing, PQEncOn) -> createPQItem $ CISndDirectE2EEInfo (E2EInfo pqSndEnabled') + _ -> pure (ct, conn) where createPQItem ciContent = do - let cpqe = contactPQEnabled ct - conn' = conn {pqSndEnabled = Just pqSndEnabled'} :: Connection + let conn' = conn {pqSndEnabled = Just pqSndEnabled'} :: Connection ct' = ct {activeConn = Just conn'} :: Contact - cpqe' = contactPQEnabled ct' - when (cpqe' /= cpqe) $ do + when (contactPQEnabled ct /= contactPQEnabled ct') $ do createInternalChatItem user (CDDirectSnd ct') ciContent Nothing toView $ CRContactPQEnabled user ct' pqSndEnabled' pure (ct', conn') -updateContactPQRcv :: ChatMonad m => User -> Contact -> Connection -> PQFlag -> m (Contact, Connection) +updateContactPQRcv :: ChatMonad m => User -> Contact -> Connection -> PQEncryption -> m (Contact, Connection) updateContactPQRcv user ct conn@Connection {connId, pqRcvEnabled} pqRcvEnabled' = flip catchChatError (const $ pure (ct, conn)) $ case (pqRcvEnabled, pqRcvEnabled') of - (Nothing, False) -> pure (ct, conn) - (Nothing, True) -> updatePQ $ CIRcvDirectE2EEInfo (E2EEInfo pqRcvEnabled') - (Just b, b') - | b' /= b -> updatePQ $ CIRcvConnEvent (RCEPQEnabled pqRcvEnabled') - | otherwise -> pure (ct, conn) + (Just b, b') | b' /= b -> updatePQ $ CIRcvConnEvent (RCEPqEnabled pqRcvEnabled') + (Nothing, PQEncOn) -> updatePQ $ CIRcvDirectE2EEInfo (E2EInfo pqRcvEnabled') + _ -> pure (ct, conn) where updatePQ ciContent = do withStore' $ \db -> updateConnPQRcvEnabled db connId pqRcvEnabled' - let cpqe = contactPQEnabled ct - conn' = conn {pqRcvEnabled = Just pqRcvEnabled'} :: Connection + let conn' = conn {pqRcvEnabled = Just pqRcvEnabled'} :: Connection ct' = ct {activeConn = Just conn'} :: Contact - cpqe' = contactPQEnabled ct' - when (cpqe' /= cpqe) $ do + when (contactPQEnabled ct /= contactPQEnabled ct') $ do createInternalChatItem user (CDDirectRcv ct') ciContent Nothing toView $ CRContactPQEnabled user ct' pqRcvEnabled' pure (ct', conn') @@ -5826,7 +5834,7 @@ sendDirectFileInline user ct ft sharedMsgId = do sendMemberFileInline :: ChatMonad m => GroupMember -> Connection -> FileTransferMeta -> SharedMsgId -> m () sendMemberFileInline m@GroupMember {groupId} conn ft sharedMsgId = do msgDeliveryId <- sendFileInline_ ft sharedMsgId $ \msg -> do - (sndMsg, msgDeliveryId, _) <- sendDirectMessage conn CR.PQEncOff msg $ GroupId groupId + (sndMsg, msgDeliveryId, _) <- sendDirectMemberMessage conn msg groupId pure (sndMsg, msgDeliveryId) withStore' $ \db -> updateSndGroupFTDelivery db m conn ft msgDeliveryId @@ -5854,7 +5862,7 @@ parseChatMessage conn s = do sendFileChunk :: ChatMonad m => User -> SndFileTransfer -> m () sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} = unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ do - vr <- chatVersionRange PQEncOff + vr <- chatVersionRange PQSupportOff withStore' (`createSndFileChunk` ft) >>= \case Just chunkNo -> sendFileChunkNo ft chunkNo Nothing -> do @@ -5869,7 +5877,7 @@ sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentCo sendFileChunkNo :: ChatMonad m => SndFileTransfer -> Integer -> m () sendFileChunkNo ft@SndFileTransfer {agentConnId = AgentConnId acId} chunkNo = do chunkBytes <- readFileChunk ft chunkNo - (msgId, _) <- withAgent $ \a -> sendMessage a acId CR.PQEncOff SMP.noMsgFlags $ smpEncode FileChunk {chunkNo, chunkBytes} + (msgId, _) <- withAgent $ \a -> sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunk {chunkNo, chunkBytes} withStore' $ \db -> updateSndFileChunkMsg db ft chunkNo msgId readFileChunk :: ChatMonad m => SndFileTransfer -> Integer -> m ByteString @@ -5964,6 +5972,7 @@ cancelSndFile user FileTransferMeta {fileId, xftpSndFile} fts sendCancel = do agentXFTPDeleteSndFileRemote user xsf fileId `catchChatError` (toView . CRChatError (Just user)) pure [] +-- TODO v6.0 remove cancelSndFileTransfer :: ChatMonad m => User -> SndFileTransfer -> Bool -> m (Maybe ConnId) cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel = if fileStatus == FSCancelled || fileStatus == FSComplete @@ -5977,8 +5986,8 @@ cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, age when sendCancel $ case fileInline of Just _ -> do (sharedMsgId, conn) <- withStore $ \db -> (,) <$> getSharedMsgIdByFileId db userId fileId <*> getConnectionById db user connId - void . sendDirectMessage conn CR.PQEncOff (BFileChunk sharedMsgId FileChunkCancel) $ ConnectionId connId - _ -> withAgent $ \a -> void . sendMessage a acId CR.PQEncOff SMP.noMsgFlags $ smpEncode FileChunkCancel + void $ sendDirectMessage_ conn PQSupportOff (BFileChunk sharedMsgId FileChunkCancel) (ConnectionId connId) + _ -> withAgent $ \a -> void . sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunkCancel pure fileConnId fileConnId = if isNothing fileInline then Just acId else Nothing @@ -6017,11 +6026,11 @@ deleteOrUpdateMemberRecord user@User {userId} member = sendDirectContactMessage :: (MsgEncodingI e, ChatMonad m) => User -> Contact -> ChatMsgEvent e -> m (SndMessage, Int64) sendDirectContactMessage user ct chatMsgEvent = do - conn@Connection {connId, enablePQ} <- liftEither $ contactSendConn_ ct - r <- sendDirectMessage conn (CR.PQEncryption enablePQ) chatMsgEvent (ConnectionId connId) - let (sndMessage, msgDeliveryId, CR.PQEncryption pqEnabled') = r + conn@Connection {connId, pqSupport} <- liftEither $ contactSendConn_ ct + r <- sendDirectMessage_ conn pqSupport chatMsgEvent (ConnectionId connId) + let (sndMessage, msgDeliveryId, pqEnc') = r -- TODO PQ use updated ct' and conn'? check downstream if it may affect something, maybe it's not necessary - (_ct', _conn') <- createContactPQSndItem user ct conn pqEnabled' + void $ createContactPQSndItem user ct conn pqEnc' -- (_ct', _conn') pure (sndMessage, msgDeliveryId) contactSendConn_ :: Contact -> Either ChatError Connection @@ -6035,38 +6044,44 @@ contactSendConn_ ct@Contact {activeConn} = case activeConn of where err = Left . ChatError -sendDirectMessage :: (MsgEncodingI e, ChatMonad m) => Connection -> CR.PQEncryption -> ChatMsgEvent e -> ConnOrGroupId -> m (SndMessage, Int64, CR.PQEncryption) -sendDirectMessage conn pqEnc chatMsgEvent connOrGroupId = do +-- unlike sendGroupMemberMessage, this function will not store message as pending +-- TODO v5.8 we could remove pending messages once all clients support forwarding +sendDirectMemberMessage :: (MsgEncodingI e, ChatMonad m) => Connection -> ChatMsgEvent e -> GroupId -> m (SndMessage, Int64, PQEncryption) +sendDirectMemberMessage conn chatMsgEvent groupId = sendDirectMessage_ conn PQSupportOff chatMsgEvent (GroupId groupId) + +sendDirectMessage_ :: (MsgEncodingI e, ChatMonad m) => Connection -> PQSupport -> ChatMsgEvent e -> ConnOrGroupId -> m (SndMessage, Int64, PQEncryption) +sendDirectMessage_ conn pqSup chatMsgEvent connOrGroupId = do when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) - msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId pqEnc - (msgDeliveryId, pqEnc') <- deliverMessage conn pqEnc (toCMEventTag chatMsgEvent) msgBody msgId + msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId pqSup + -- TODO move compressed body to SndMessage and compress in createSndMessage + (msgDeliveryId, pqEnc') <- deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId pure (msg, msgDeliveryId, pqEnc') -createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> PQEncryption -> m SndMessage -createSndMessage chatMsgEvent connOrGroupId pqEnc = - liftEither . runIdentity =<< createSndMessages (Identity (connOrGroupId, pqEnc, chatMsgEvent)) +createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> PQSupport -> m SndMessage +createSndMessage chatMsgEvent connOrGroupId pqSup = + liftEither . runIdentity =<< createSndMessages (Identity (connOrGroupId, pqSup, chatMsgEvent)) -createSndMessages :: forall e m t. (MsgEncodingI e, ChatMonad' m, Traversable t) => t (ConnOrGroupId, PQEncryption, ChatMsgEvent e) -> m (t (Either ChatError SndMessage)) +createSndMessages :: forall e m t. (MsgEncodingI e, ChatMonad' m, Traversable t) => t (ConnOrGroupId, PQSupport, ChatMsgEvent e) -> m (t (Either ChatError SndMessage)) createSndMessages idsEvents = do g <- asks random ChatConfig {chatVRange = vr} <- asks config withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents where - createMsg :: DB.Connection -> TVar ChaChaDRG -> (PQEncryption -> VersionRangeChat) -> (ConnOrGroupId, PQEncryption, ChatMsgEvent e) -> IO (Either ChatError SndMessage) - createMsg db g vr (connOrGroupId, pqEnc, evnt) = runExceptT $ do + createMsg :: DB.Connection -> TVar ChaChaDRG -> (PQSupport -> VersionRangeChat) -> (ConnOrGroupId, PQSupport, ChatMsgEvent e) -> IO (Either ChatError SndMessage) + createMsg db g vr (connOrGroupId, pqSup, evnt) = runExceptT $ do withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId evnt encodeMessage where encodeMessage sharedMsgId = - encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr pqEnc, msgId = Just sharedMsgId, chatMsgEvent = evnt} + encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr pqSup, msgId = Just sharedMsgId, chatMsgEvent = evnt} sendGroupMemberMessages :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> Connection -> NonEmpty (ChatMsgEvent e) -> GroupId -> m () sendGroupMemberMessages user conn events groupId = do when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) - let idsEvts = L.map (GroupId groupId,PQEncOff,) events + let idsEvts = L.map (GroupId groupId,PQSupportOff,) events (errs, msgs) <- partitionEithers . L.toList <$> createSndMessages idsEvts unless (null errs) $ toView $ CRChatErrors (Just user) errs forM_ (L.nonEmpty msgs) $ \msgs' -> do - -- TODO PQ based on version (?) + -- TODO v5.7 based on version (?) -- let shouldCompress = False -- batched <- if shouldCompress then batchSndMessagesBinary msgs' else pure $ batchSndMessagesJSON msgs' let batched = batchSndMessagesJSON msgs' @@ -6078,12 +6093,13 @@ sendGroupMemberMessages user conn events groupId = do processSndMessageBatch :: ChatMonad m => Connection -> MsgBatch -> m () processSndMessageBatch conn@Connection {connId} (MsgBatch batchBody sndMsgs) = do - (agentMsgId, _pqEnc) <- withAgent $ \a -> sendMessage a (aConnId conn) CR.PQEncOff MsgFlags {notification = True} batchBody + (agentMsgId, _pqEnc) <- withAgent $ \a -> sendMessage a (aConnId conn) PQEncOff MsgFlags {notification = True} batchBody let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId} void . withStoreBatch' $ \db -> map (\SndMessage {msgId} -> createSndMsgDelivery db sndMsgDelivery msgId) sndMsgs +-- TODO v5.7 update batching for groups batchSndMessagesJSON :: NonEmpty SndMessage -> [Either ChatError MsgBatch] -batchSndMessagesJSON = batchMessages (maxEncodedMsgLength PQEncOff) . L.toList +batchSndMessagesJSON = batchMessages maxRawMsgLength . L.toList -- batchSndMessagesBinary :: forall m. ChatMonad m => NonEmpty SndMessage -> m [Either ChatError MsgBatch] -- batchSndMessagesBinary msgs = do @@ -6097,15 +6113,15 @@ batchSndMessagesJSON = batchMessages (maxEncodedMsgLength PQEncOff) . L.toList -- SMP.TBError tbe SndMessage {msgId} -> Left . ChatError $ CEInternalError (show tbe <> " " <> show msgId) -- SMP.TBTransmission {} -> Left . ChatError $ CEInternalError "batchTransmissions_ didn't produce a batch" -directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString -directMessage = directMessagePQ PQEncOff maxConnInfoLength +encodeConnInfo :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString +encodeConnInfo = encodeConnInfoPQ PQSupportOff -- TODO PQ check size after compression (in compressedBatchMsgBody_ ?) -directMessagePQ :: (MsgEncodingI e, ChatMonad m) => CR.PQEncryption -> (CR.PQEncryption -> Int) -> ChatMsgEvent e -> m ByteString -directMessagePQ pqEnc maxMsgSize chatMsgEvent = do - chatVRange <- chatVersionRange pqEnc +encodeConnInfoPQ :: (MsgEncodingI e, ChatMonad m) => PQSupport -> ChatMsgEvent e -> m ByteString +encodeConnInfoPQ pqSup chatMsgEvent = do + chatVRange <- chatVersionRange pqSup let shouldCompress = maxVersion chatVRange >= compressedBatchingVersion - r = encodeChatMessage maxMsgSize ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} + r = encodeChatMessage maxConnInfoLength ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} case r of ECMEncoded encodedBody | shouldCompress -> compressedBatchMsgBody encodedBody @@ -6116,23 +6132,23 @@ directMessagePQ pqEnc maxMsgSize chatMsgEvent = do liftEitherError (ChatError . CEException . mappend "compressedBatchMsgBody: ") $ withCompressCtx (B.length msgBody) (`compressedBatchMsgBody_` msgBody) -deliverMessage :: ChatMonad m => Connection -> CR.PQEncryption -> CMEventTag e -> MsgBody -> MessageId -> m (Int64, CR.PQEncryption) -deliverMessage conn pqEnc cmEventTag msgBody msgId = do +deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m (Int64, PQEncryption) +deliverMessage conn cmEventTag msgBody msgId = do let msgFlags = MsgFlags {notification = hasNotification cmEventTag} - deliverMessage' conn pqEnc msgFlags msgBody msgId + deliverMessage' conn msgFlags msgBody msgId -deliverMessage' :: ChatMonad m => Connection -> CR.PQEncryption -> MsgFlags -> MsgBody -> MessageId -> m (Int64, CR.PQEncryption) -deliverMessage' conn pqEnc msgFlags msgBody msgId = - deliverMessages ((conn, pqEnc, msgFlags, msgBody, msgId) :| []) >>= \case +deliverMessage' :: ChatMonad m => Connection -> MsgFlags -> MsgBody -> MessageId -> m (Int64, PQEncryption) +deliverMessage' conn msgFlags msgBody msgId = + deliverMessages ((conn, msgFlags, msgBody, msgId) :| []) >>= \case r :| [] -> liftEither r rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs) -type MsgReq = (Connection, CR.PQEncryption, MsgFlags, MsgBody, MessageId) +type MsgReq = (Connection, MsgFlags, MsgBody, MessageId) -deliverMessages :: ChatMonad' m => NonEmpty MsgReq -> m (NonEmpty (Either ChatError (Int64, CR.PQEncryption))) +deliverMessages :: ChatMonad' m => NonEmpty MsgReq -> m (NonEmpty (Either ChatError (Int64, PQEncryption))) deliverMessages msgs = deliverMessagesB $ L.map Right msgs -deliverMessagesB :: ChatMonad' m => NonEmpty (Either ChatError MsgReq) -> m (NonEmpty (Either ChatError (Int64, CR.PQEncryption))) +deliverMessagesB :: ChatMonad' m => NonEmpty (Either ChatError MsgReq) -> m (NonEmpty (Either ChatError (Int64, PQEncryption))) deliverMessagesB msgReqs = do msgReqs' <- compressBodies sent <- L.zipWith prepareBatch msgReqs' <$> withAgent' (`sendMessagesB` L.map toAgent msgReqs') @@ -6141,28 +6157,28 @@ deliverMessagesB msgReqs = do where compressBodies = liftIO $ withCompressCtx maxRawMsgLength $ \cctx -> forM msgReqs $ \case - mr@(Right (conn, pqEnc, msgFlags, msgBody, msgId)) - | pqEnc == CR.PQEncOn -> do - bimap (ChatError . CEException) (\cBody -> (conn, pqEnc, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody - | otherwise -> pure mr + -- TODO PQ combine pqSupport and pqEncryption to one type: + -- data PQMode = PQDisabled | PQSupported PQEncryption + mr@(Right (conn@Connection {pqSupport, pqEncryption}, msgFlags, msgBody, msgId)) -> case pqSupport `CR.pqSupportOrEnc` pqEncryption of + PQSupportOn -> + bimap (ChatError . CEException) (\cBody -> (conn, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody + PQSupportOff -> pure mr skip -> pure skip toAgent = \case - Right (conn, pqEnc, msgFlags, msgBody, _msgId) -> Right (aConnId conn, pqEnc, msgFlags, msgBody) + Right (conn@Connection {pqEncryption}, msgFlags, msgBody, _msgId) -> Right (aConnId conn, pqEncryption, msgFlags, msgBody) Left _ce -> Left (AP.INTERNAL "ChatError, skip") -- as long as it is Left, the agent batchers should just step over it prepareBatch (Right req) (Right ar) = Right (req, ar) prepareBatch (Left ce) _ = Left ce -- restore original ChatError prepareBatch _ (Left ae) = Left $ ChatErrorAgent ae Nothing - createDelivery :: DB.Connection -> (MsgReq, (AgentMsgId, CR.PQEncryption)) -> IO (Either ChatError (Int64, CR.PQEncryption)) - createDelivery db ((Connection {connId}, _, _, _, msgId), (agentMsgId, pqEnc')) = + createDelivery :: DB.Connection -> (MsgReq, (AgentMsgId, PQEncryption)) -> IO (Either ChatError (Int64, PQEncryption)) + createDelivery db ((Connection {connId}, _, _, msgId), (agentMsgId, pqEnc')) = Right . (,pqEnc') <$> createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId}) msgId - updatePQSndEnabled :: DB.Connection -> (MsgReq, (AgentMsgId, CR.PQEncryption)) -> IO () - updatePQSndEnabled db ((Connection {connId, pqSndEnabled}, _, _, _, _), (_, CR.PQEncryption pqSndEnabled')) = + updatePQSndEnabled :: DB.Connection -> (MsgReq, (AgentMsgId, PQEncryption)) -> IO () + updatePQSndEnabled db ((Connection {connId, pqSndEnabled}, _, _, _), (_, pqSndEnabled')) = case (pqSndEnabled, pqSndEnabled') of - (Nothing, False) -> pure () - (Nothing, True) -> updatePQ - (Just b, b') - | b' /= b -> updatePQ - | otherwise -> pure () + (Just b, b') | b' /= b -> updatePQ + (Nothing, PQEncOn) -> updatePQ + _ -> pure () where updatePQ = updateConnPQSndEnabled db connId pqSndEnabled' @@ -6190,11 +6206,12 @@ sendGroupMessage user gInfo members chatMsgEvent = do sendGroupMessage' :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember]) sendGroupMessage' user GroupInfo {groupId} members chatMsgEvent = do - msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId) PQEncOff + msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId) PQSupportOff recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members) let msgFlags = MsgFlags {notification = hasNotification $ toCMEventTag chatMsgEvent} (toSend, pending) = foldr addMember ([], []) recipientMembers - msgReqs = map (\(_, conn) -> (conn, CR.PQEncOff, msgFlags, msgBody, msgId)) toSend + -- TODO PQ either somehow ensure that group members connections cannot have pqSupport/pqEncryption or pass Off's here + msgReqs = map (\(_, conn) -> (conn, msgFlags, msgBody, msgId)) toSend delivered <- maybe (pure []) (fmap L.toList . deliverMessages) $ L.nonEmpty msgReqs let errors = lefts delivered unless (null errors) $ toView $ CRChatErrors (Just user) errors @@ -6248,12 +6265,12 @@ memberSendAction chatMsgEvent members m@GroupMember {invitedByGroupMemberId} = c sendGroupMemberMessage :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> GroupMember -> ChatMsgEvent e -> Int64 -> Maybe Int64 -> m () -> m () sendGroupMemberMessage user m@GroupMember {groupMemberId} chatMsgEvent groupId introId_ postDeliver = do - msg <- createSndMessage chatMsgEvent (GroupId groupId) PQEncOff + msg <- createSndMessage chatMsgEvent (GroupId groupId) PQSupportOff messageMember msg `catchChatError` (\e -> toView (CRChatError (Just user) e)) where messageMember :: SndMessage -> m () messageMember SndMessage {msgId, msgBody} = forM_ (memberSendAction chatMsgEvent [m] m) $ \case - MSASend conn -> deliverMessage conn CR.PQEncOff (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver + MSASend conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_ sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m () @@ -6264,7 +6281,7 @@ sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn processPendingMessage pgm `catchChatError` (toView . CRChatError (Just user)) where processPendingMessage PendingGroupMessage {msgId, cmEventTag = ACMEventTag _ tag, msgBody, introId_} = do - void $ deliverMessage conn CR.PQEncOff tag msgBody msgId + void $ deliverMessage conn tag msgBody msgId withStore' $ \db -> deletePendingGroupMessage db groupMemberId msgId case tag of XGrpMemFwd_ -> case introId_ of @@ -6298,7 +6315,7 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do fm <- withStore $ \db -> getGroupMember db user groupId forwardedByGroupMemberId forM_ (memberConn fm) $ \fmConn -> - void $ sendDirectMessage fmConn CR.PQEncOff (XGrpMemCon amMemId) (GroupId groupId) + void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemId) groupId throwError e _ -> throwError e pure (am', conn', msg) @@ -6314,7 +6331,7 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {me am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db user groupId authorGroupMemberId if sameMemberId refMemberId am then forM_ (memberConn forwardingMember) $ \fmConn -> - void $ sendDirectMessage fmConn CR.PQEncOff (XGrpMemCon amMemberId) (GroupId groupId) + void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemberId) groupId else toView $ CRMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id" throwError e _ -> throwError e @@ -6410,27 +6427,27 @@ cancelCIFile user file_ = createAgentConnectionAsync :: forall m c. (ChatMonad m, ConnectionModeI c) => User -> CommandFunction -> Bool -> SConnectionMode c -> SubscriptionMode -> m (CommandId, ConnId) createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do cmdId <- withStore' $ \db -> createCommand db user Nothing cmdFunction - connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode CR.IKPQOff subMode + connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode IKPQOff subMode pure (cmdId, connId) joinAgentConnectionAsync :: ChatMonad m => User -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> m (CommandId, ConnId) joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn - connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo CR.PQEncOff subMode + connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo PQSupportOff subMode pure (cmdId, connId) allowAgentConnectionAsync :: (MsgEncodingI e, ChatMonad m) => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> m () -allowAgentConnectionAsync user conn@Connection {connId, enablePQ} confId msg = do +allowAgentConnectionAsync user conn@Connection {connId, pqSupport} confId msg = do cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn - dm <- directMessagePQ (CR.PQEncryption enablePQ) maxConnInfoLength msg + dm <- encodeConnInfoPQ pqSupport msg withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm withStore' $ \db -> updateConnectionStatus db conn ConnAccepted -agentAcceptContactAsync :: (MsgEncodingI e, ChatMonad m) => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> CR.PQEncryption -> m (CommandId, ConnId) -agentAcceptContactAsync user enableNtfs invId msg subMode pqEnc = do +agentAcceptContactAsync :: (MsgEncodingI e, ChatMonad m) => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> PQSupport -> m (CommandId, ConnId) +agentAcceptContactAsync user enableNtfs invId msg subMode pqSup = do cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact - dm <- directMessagePQ pqEnc maxConnInfoLength msg - connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm pqEnc subMode + dm <- encodeConnInfoPQ pqSup msg + connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm pqSup subMode pure (cmdId, connId) deleteAgentConnectionAsync :: ChatMonad m => User -> ConnId -> m () @@ -6664,10 +6681,10 @@ waitChatStartedAndActivated = do activated <- readTVar chatActivated unless (isJust started && activated) retry -chatVersionRange :: ChatMonad' m => CR.PQEncryption -> m VersionRangeChat -chatVersionRange pqEnc = do +chatVersionRange :: ChatMonad' m => PQSupport -> m VersionRangeChat +chatVersionRange pq = do ChatConfig {chatVRange} <- asks config - pure $ chatVRange pqEnc + pure $ chatVRange pq chatCommandP :: Parser ChatCommand chatCommandP = @@ -6711,7 +6728,7 @@ chatCommandP = "/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath), "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP), "/contact_merge " *> (SetContactMergeEnabled <$> onOffP), - "/_pq " *> (APISetPQEnabled <$> onOffP), + "/_pq " *> (APISetPQEnabled . PQSupport <$> onOffP), "/_pq allow " *> (APIAllowContactPQ <$> A.decimal), "/_db export " *> (APIExportArchive <$> jsonP), "/db export" $> ExportArchive, diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index a23d88a7b7..f46b0183c3 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -72,8 +72,8 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) import qualified Simplex.Messaging.Crypto.File as CF +import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..)) import Simplex.Messaging.Encoding.String -import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus) import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON) import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SMPMsgMeta (..), SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol) @@ -122,7 +122,7 @@ coreVersionInfo simplexmqCommit = data ChatConfig = ChatConfig { agentConfig :: AgentConfig, - chatVRange :: CR.PQEncryption -> VersionRangeChat, + chatVRange :: PQSupport -> VersionRangeChat, confirmMigrations :: MigrationConfirmation, defaultServers :: DefaultAgentServers, tbqSize :: Natural, @@ -207,7 +207,7 @@ data ChatController = ChatController tempDirectory :: TVar (Maybe FilePath), logFilePath :: Maybe FilePath, contactMergeEnabled :: TVar Bool, - pqExperimentalEnabled :: TVar PQFlag -- TODO remove in 5.7 + pqExperimentalEnabled :: TVar PQSupport -- TODO v5.7 remove } data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSRemote | HSSettings | HSDatabase @@ -244,7 +244,7 @@ data ChatCommand | SetRemoteHostsFolder FilePath | APISetEncryptLocalFiles Bool | SetContactMergeEnabled Bool - | APISetPQEnabled Bool + | APISetPQEnabled PQSupport | APIAllowContactPQ ContactId | APIExportArchive ArchiveConfig | ExportArchive @@ -701,7 +701,7 @@ data ChatResponse | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo} | CRRemoteCtrlStopped {rcsState :: RemoteCtrlSessionState, rcStopReason :: RemoteCtrlStopReason} | CRContactPQAllowed {user :: User, contact :: Contact} - | CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: Bool} + | CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption} | CRSQLResult {rows :: [Text]} | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]} | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks} diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs index dfe3d0d043..b44090290e 100644 --- a/src/Simplex/Chat/Messages/CIContent.hs +++ b/src/Simplex/Chat/Messages/CIContent.hs @@ -6,6 +6,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} @@ -29,6 +30,7 @@ import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Util import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..)) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOn, pattern PQEncOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON) import Simplex.Messaging.Util (safeDecodeUtf8, tshow, (<$?>)) @@ -139,10 +141,10 @@ data CIContent (d :: MsgDirection) where CISndModerated :: CIContent 'MDSnd CIRcvModerated :: CIContent 'MDRcv CIRcvBlocked :: CIContent 'MDRcv - CISndDirectE2EEInfo :: E2EEInfo -> CIContent 'MDSnd - CIRcvDirectE2EEInfo :: E2EEInfo -> CIContent 'MDRcv - CISndGroupE2EEInfo :: E2EEInfo -> CIContent 'MDSnd -- when new group is created - CIRcvGroupE2EEInfo :: E2EEInfo -> CIContent 'MDRcv -- when enabled with some member + CISndDirectE2EEInfo :: E2EInfo -> CIContent 'MDSnd + CIRcvDirectE2EEInfo :: E2EInfo -> CIContent 'MDRcv + CISndGroupE2EEInfo :: E2EInfo -> CIContent 'MDSnd -- when new group is created + CIRcvGroupE2EEInfo :: E2EInfo -> CIContent 'MDRcv -- when enabled with some member CIInvalidJSON :: Text -> CIContent d -- this is also used for logical database errors, e.g. SEBadChatItem -- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API @@ -151,9 +153,7 @@ data CIContent (d :: MsgDirection) where deriving instance Show (CIContent d) -data E2EEInfo = E2EEInfo - { pqEnabled :: Bool - } +data E2EInfo = E2EInfo {pqEnabled :: PQEncryption} deriving (Eq, Show) ciMsgContent :: CIContent d -> Maybe MsgContent @@ -262,22 +262,22 @@ ciContentToText = \case CISndModerated -> ciModeratedText CIRcvModerated -> ciModeratedText CIRcvBlocked -> "blocked" - CISndDirectE2EEInfo e2eeInfo -> directE2EEInfoToText e2eeInfo - CIRcvDirectE2EEInfo e2eeInfo -> directE2EEInfoToText e2eeInfo - CISndGroupE2EEInfo e2eeInfo -> groupE2EEInfoToText e2eeInfo - CIRcvGroupE2EEInfo e2eeInfo -> groupE2EEInfoToText e2eeInfo + CISndDirectE2EEInfo e2eeInfo -> directE2EInfoToText e2eeInfo + CIRcvDirectE2EEInfo e2eeInfo -> directE2EInfoToText e2eeInfo + CISndGroupE2EEInfo e2eeInfo -> groupE2EInfoToText e2eeInfo + CIRcvGroupE2EEInfo e2eeInfo -> groupE2EInfoToText e2eeInfo CIInvalidJSON _ -> "invalid content JSON" -directE2EEInfoToText :: E2EEInfo -> Text -directE2EEInfoToText E2EEInfo {pqEnabled} - | pqEnabled = "This conversation is protected by quantum resistant end-to-end encryption. It has perfect forward secrecy, repudiation and quantum resistant break-in recovery." - | otherwise = e2eeInfoNoPQText +directE2EInfoToText :: E2EInfo -> Text +directE2EInfoToText E2EInfo {pqEnabled} = case pqEnabled of + PQEncOn -> "This conversation is protected by quantum resistant end-to-end encryption. It has perfect forward secrecy, repudiation and quantum resistant break-in recovery." + PQEncOff -> e2eInfoNoPQText -groupE2EEInfoToText :: E2EEInfo -> Text -groupE2EEInfoToText _e2eeInfo = e2eeInfoNoPQText +groupE2EInfoToText :: E2EInfo -> Text +groupE2EInfoToText _e2eeInfo = e2eInfoNoPQText -e2eeInfoNoPQText :: Text -e2eeInfoNoPQText = +e2eInfoNoPQText :: Text +e2eInfoNoPQText = "This conversation is protected by end-to-end encryption with perfect forward secrecy, repudiation and break-in recovery." ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text @@ -323,9 +323,9 @@ rcvConnEventToText = \case SPCompleted -> "changed address for you" RCERatchetSync syncStatus -> ratchetSyncStatusToText syncStatus RCEVerificationCodeReset -> "security code changed" - RCEPQEnabled enabled - | enabled -> "post-quantum encryption enabled" - | otherwise -> "post-quantum encryption disabled" + RCEPqEnabled pqEnc -> case pqEnc of + PQEncOn -> "post-quantum encryption enabled" + PQEncOff -> "post-quantum encryption disabled" ratchetSyncStatusToText :: RatchetSyncState -> Text ratchetSyncStatusToText = \case @@ -343,9 +343,9 @@ sndConnEventToText = \case SPSecured -> "secured new address" <> forMember m <> "..." SPCompleted -> "you changed address" <> forMember m SCERatchetSync syncStatus m -> ratchetSyncStatusToText syncStatus <> forMember m - SCEPQEnabled enabled - | enabled -> "post-quantum encryption enabled" - | otherwise -> "post-quantum encryption disabled" + SCEPqEnabled pqEnc -> case pqEnc of + PQEncOn -> "post-quantum encryption enabled" + PQEncOff -> "post-quantum encryption disabled" where forMember member_ = maybe "" (\GroupMemberRef {profile = Profile {displayName}} -> " for " <> displayName) member_ @@ -416,10 +416,10 @@ data JSONCIContent | JCISndModerated | JCIRcvModerated | JCIRcvBlocked - | JCISndDirectE2EEInfo {e2eeInfo :: E2EEInfo} - | JCIRcvDirectE2EEInfo {e2eeInfo :: E2EEInfo} - | JCISndGroupE2EEInfo {e2eeInfo :: E2EEInfo} - | JCIRcvGroupE2EEInfo {e2eeInfo :: E2EEInfo} + | JCISndDirectE2EEInfo {e2eeInfo :: E2EInfo} + | JCIRcvDirectE2EEInfo {e2eeInfo :: E2EInfo} + | JCISndGroupE2EEInfo {e2eeInfo :: E2EInfo} + | JCIRcvGroupE2EEInfo {e2eeInfo :: E2EInfo} | JCIInvalidJSON {direction :: MsgDirection, json :: Text} jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent @@ -519,10 +519,10 @@ data DBJSONCIContent | DBJCISndModerated | DBJCIRcvModerated | DBJCIRcvBlocked - | DBJCISndDirectE2EEInfo {e2eeInfo :: E2EEInfo} - | DBJCIRcvDirectE2EEInfo {e2eeInfo :: E2EEInfo} - | DBJCISndGroupE2EEInfo {e2eeInfo :: E2EEInfo} - | DBJCIRcvGroupE2EEInfo {e2eeInfo :: E2EEInfo} + | DBJCISndDirectE2EEInfo {e2eeInfo :: E2EInfo} + | DBJCIRcvDirectE2EEInfo {e2eeInfo :: E2EInfo} + | DBJCISndGroupE2EEInfo {e2eeInfo :: E2EInfo} + | DBJCIRcvGroupE2EEInfo {e2eeInfo :: E2EInfo} | DBJCIInvalidJSON {direction :: MsgDirection, json :: Text} dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent @@ -616,7 +616,7 @@ ciCallInfoText status duration = case status of CISCallEnded -> "ended " <> durationText duration CISCallError -> "error" -$(JQ.deriveJSON defaultJSON ''E2EEInfo) +$(JQ.deriveJSON defaultJSON ''E2EInfo) $(JQ.deriveJSON (enumJSON $ dropPrefix "MDE") ''MsgDecryptError) diff --git a/src/Simplex/Chat/Messages/CIContent/Events.hs b/src/Simplex/Chat/Messages/CIContent/Events.hs index f8a877187a..7ce5f73cde 100644 --- a/src/Simplex/Chat/Messages/CIContent/Events.hs +++ b/src/Simplex/Chat/Messages/CIContent/Events.hs @@ -9,6 +9,7 @@ import qualified Data.Aeson.TH as J import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (RatchetSyncState (..), SwitchPhase (..)) import Simplex.Messaging.Parsers (dropPrefix, singleFieldJSON, sumTypeJSON) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption) data RcvGroupEvent = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting @@ -42,13 +43,13 @@ data RcvConnEvent = RCESwitchQueue {phase :: SwitchPhase} | RCERatchetSync {syncStatus :: RatchetSyncState} | RCEVerificationCodeReset - | RCEPQEnabled {enabled :: Bool} + | RCEPqEnabled {enabled :: PQEncryption} deriving (Show) data SndConnEvent = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef} | SCERatchetSync {syncStatus :: RatchetSyncState, member :: Maybe GroupMemberRef} - | SCEPQEnabled {enabled :: Bool} + | SCEPqEnabled {enabled :: PQEncryption} deriving (Show) data RcvDirectEvent diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index a4c3e0a4b5..aba09c4f0b 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -47,7 +47,7 @@ import Simplex.Chat.Call import Simplex.Chat.Types import Simplex.Chat.Types.Util import Simplex.Messaging.Compression (CompressCtx, compress, decompressBatch) -import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOn, pattern PQEncOff) +import Simplex.Messaging.Crypto.Ratchet (PQSupport (..), pattern PQSupportOn, pattern PQSupportOff) import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON) @@ -63,10 +63,11 @@ currentChatVersion = VersionChat 7 -- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above) -- TODO remove parameterization in 5.7 -supportedChatVRange :: PQEncryption -> VersionRangeChat +supportedChatVRange :: PQSupport -> VersionRangeChat supportedChatVRange pq = mkVersionRange (VersionChat 1) $ case pq of - PQEncOn -> compressedBatchingVersion - PQEncOff -> currentChatVersion + PQSupportOn -> compressedBatchingVersion + PQSupportOff -> currentChatVersion +{-# INLINE supportedChatVRange #-} -- version range that supports skipping establishing direct connections in a group groupNoDirectVRange :: VersionRangeChat @@ -522,24 +523,26 @@ $(JQ.deriveJSON defaultJSON ''QuotedMsg) maxRawMsgLength :: Int maxRawMsgLength = 15610 -maxEncodedMsgLength :: PQEncryption -> Int +maxEncodedMsgLength :: PQSupport -> Int maxEncodedMsgLength = \case - PQEncOn -> 13410 -- reduced by 2200 (original message should be compressed) - PQEncOff -> maxRawMsgLength + PQSupportOn -> 13410 -- reduced by 2200 (original message should be compressed) + PQSupportOff -> maxRawMsgLength +{-# INLINE maxEncodedMsgLength #-} -maxConnInfoLength :: PQEncryption -> Int +maxConnInfoLength :: PQSupport -> Int maxConnInfoLength = \case - PQEncOn -> 10902 -- reduced by 3700 - PQEncOff -> 14602 -- 15610 - delta in agent between MSG and INFO + PQSupportOn -> 10902 -- reduced by 3700 + PQSupportOff -> 14602 -- 15610 - delta in agent between MSG and INFO +{-# INLINE maxConnInfoLength #-} data EncodedChatMessage = ECMEncoded ByteString | ECMLarge -encodeChatMessage :: MsgEncodingI e => (PQEncryption -> Int) -> ChatMessage e -> EncodedChatMessage +encodeChatMessage :: MsgEncodingI e => (PQSupport -> Int) -> ChatMessage e -> EncodedChatMessage encodeChatMessage getMaxSize msg = do case chatToAppMessage msg of AMJson m -> do let body = LB.toStrict $ J.encode m - if B.length body > getMaxSize PQEncOff + if B.length body > getMaxSize PQSupportOff then ECMLarge else ECMEncoded body AMBinary m -> ECMEncoded $ strEncode m diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 4bfe87d5f1..a9e227b0e6 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -89,6 +89,7 @@ import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import Simplex.Messaging.Crypto.Ratchet (PQSupport) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Version @@ -124,14 +125,14 @@ deletePendingContactConnection db userId connId = |] (userId, connId, ConnContact) -createAddressContactConnection :: DB.Connection -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> PQFlag -> ExceptT StoreError IO Contact -createAddressContactConnection db user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode enablePQ = do - PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode enablePQ +createAddressContactConnection :: DB.Connection -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> PQSupport -> ExceptT StoreError IO Contact +createAddressContactConnection db user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode pqSup = do + PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode pqSup liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId) getContact db user contactId -createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> PQFlag -> IO PendingContactConnection -createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode enablePQ = do +createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> PQSupport -> IO PendingContactConnection +createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode pqSup = do createdAt <- getCurrentTime customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile let pccConnStatus = ConnJoined @@ -146,7 +147,7 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou |] ( (userId, acId, pccConnStatus, ConnContact, True, cReqHash, xContactId) :. (customUserProfileId, isJust groupLinkId, groupLinkId) - :. (createdAt, createdAt, subMode == SMOnlyCreate, enablePQ) + :. (createdAt, createdAt, subMode == SMOnlyCreate, pqSup) ) pccConnId <- insertedRowId db pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt} @@ -188,8 +189,8 @@ getContactByConnReqHash db user@User {userId} cReqHash = |] (userId, cReqHash, CSActive) -createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> PQFlag -> IO PendingContactConnection -createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode enablePQ = do +createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> PQSupport -> IO PendingContactConnection +createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode pqSup = do createdAt <- getCurrentTime customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile let contactConnInitiated = pccConnStatus == ConnNew @@ -202,7 +203,7 @@ createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile VALUES (?,?,?,?,?,?,?,?,?,?,?) |] ( (userId, acId, cReq, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId) - :. (createdAt, createdAt, subMode == SMOnlyCreate, enablePQ) + :. (createdAt, createdAt, subMode == SMOnlyCreate, pqSup) ) pccConnId <- insertedRowId db pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt} @@ -705,8 +706,8 @@ deleteContactRequest db User {userId} contactRequestId = do (userId, userId, contactRequestId, userId) DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId) -createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQFlag -> Bool -> IO Contact -createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode enablePQ contactUsed = do +createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO Contact +createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed = do DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) createdAt <- getCurrentTime customUserProfileId <- forM incognitoProfile $ \case @@ -718,7 +719,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences} "INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)" (userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId, contactUsed) contactId <- insertedRowId db - conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode enablePQ + conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode pqSup let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index a6985f08c2..6192f5eda4 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -114,6 +114,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF +import Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Protocol (SubscriptionMode (..)) import System.FilePath (takeFileName) @@ -427,10 +428,11 @@ lookupChatRefByFileId db User {userId} fileId = |] (userId, fileId) +-- TODO v6.0 remove createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection createSndFileConnection_ db userId fileId agentConnId subMode = do currentTs <- getCurrentTime - createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode False + createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff updateSndFileStatus :: DB.Connection -> SndFileTransfer -> FileStatus -> IO () updateSndFileStatus db SndFileTransfer {fileId, connId} status = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index c50ec4fbf7..7c1721908b 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -4,6 +4,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -141,6 +142,7 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>)) import Simplex.Messaging.Version @@ -184,7 +186,7 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} "INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" (userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs) userContactLinkId <- insertedRowId db - void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode False + void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff getGroupLinkConnection :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO Connection getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} = @@ -896,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 False + Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId (fromJVersionRange cReqChatVRange) Nothing (Just userContactLinkId) Nothing 0 createdAt subMode PQSupportOff setCommandConnId db user cmdId connId getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact @@ -1218,7 +1220,7 @@ createIntroReMember currentTs <- liftIO getCurrentTime newMember <- case directConnIds of Just (directCmdId, directAgentConnId) -> do - Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode False + Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff liftIO $ setCommandConnId db user directCmdId directConnId (localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId) @@ -1239,7 +1241,7 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode setCommandConnId db user groupCmdId groupConnId forM_ directConnIds $ \(directCmdId, directAgentConnId) -> do - Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode False + Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff setCommandConnId db user directCmdId directConnId contactId <- createMemberContact_ directConnId currentTs updateMember_ contactId currentTs @@ -1271,7 +1273,7 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange viaContact connLevel currentTs subMode = - createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode False + createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode PQSupportOff getViaGroupMember :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember)) getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = @@ -1932,7 +1934,8 @@ createMemberContact localAlias = "", createdAt = currentTs, connectionCode = Nothing, - enablePQ = False, + pqSupport = PQSupportOff, + pqEncryption = PQEncOff, pqSndEnabled = Nothing, pqRcvEnabled = Nothing, authErrCounter = 0 @@ -2063,7 +2066,8 @@ createMemberContactConn_ localAlias = "", createdAt = currentTs, connectionCode = Nothing, - enablePQ = False, + pqSupport = PQSupportOff, + pqEncryption = PQEncOff, pqSndEnabled = Nothing, pqRcvEnabled = Nothing, authErrCounter = 0 diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index c4611f4b9e..3d7db3cf0e 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -85,6 +85,7 @@ import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C +import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode) @@ -323,7 +324,7 @@ createUserContactLink db User {userId} agentConnId cReq subMode = "INSERT INTO user_contact_links (user_id, conn_req_contact, created_at, updated_at) VALUES (?,?,?,?)" (userId, cReq, currentTs, currentTs) userContactLinkId <- insertedRowId db - void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode False + void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff getUserAddressConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection] getUserAddressConnections db User {userId} = do diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 77fd56489f..1020cbeb14 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -4,6 +4,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} @@ -36,6 +37,8 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern PQEncOff, pattern PQSupportOff) +import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Util (allFinally) @@ -148,12 +151,13 @@ toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, file type EntityIdsRow = (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64) -type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Maybe PQFlag, Maybe PQFlag, Maybe PQFlag, Int, VersionChat, VersionChat) +-- TODO PQ nullable? +type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Int, VersionChat, VersionChat) -type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQFlag, Maybe PQFlag, Maybe PQFlag, Maybe Int, Maybe VersionChat, Maybe VersionChat) +type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe VersionChat, Maybe VersionChat) toConnection :: ConnectionRow -> Connection -toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, enablePQ_, pqSndEnabled, pqRcvEnabled, authErrCounter, minVer, maxVer)) = +toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqEncryption_, pqSndEnabled, pqRcvEnabled, authErrCounter, minVer, maxVer)) = Connection { connId, agentConnId = AgentConnId acId, @@ -170,7 +174,9 @@ toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroup localAlias, entityId = entityId_ connType, connectionCode = SecurityCode <$> code_ <*> verifiedAt_, - enablePQ = fromMaybe False enablePQ_, + -- TODO PQ add field + pqSupport = maybe PQSupportOff CR.pqEncToSupport pqEncryption_, + pqEncryption = fromMaybe PQEncOff pqEncryption_, pqSndEnabled, pqRcvEnabled, authErrCounter, @@ -189,11 +195,12 @@ toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, v Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, enablePQ_, pqSndEnabled_, pqRcvEnabled_, authErrCounter, minVer, maxVer)) toMaybeConnection _ = Nothing -createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQFlag -> IO Connection -createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode enablePQ = do +createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQSupport -> IO Connection +createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode pqSup = do viaLinkGroupId :: Maybe Int64 <- fmap join . forM viaUserContactLink $ \ucLinkId -> maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? AND group_id IS NOT NULL" (userId, ucLinkId) let viaGroupLink = isJust viaLinkGroupId + -- TODO PQ store pq_support DB.execute db [sql| @@ -205,7 +212,7 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange |] ( (userId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, customUserProfileId, ConnNew, connType) :. (ent ConnContact, ent ConnMember, ent ConnSndFile, ent ConnRcvFile, ent ConnUserContact, currentTs, currentTs) - :. (minV, maxV, subMode == SMOnlyCreate, enablePQ) + :. (minV, maxV, subMode == SMOnlyCreate, pqSup) ) connId <- insertedRowId db pure @@ -226,7 +233,8 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange localAlias = "", createdAt = currentTs, connectionCode = Nothing, - enablePQ, + pqSupport = pqSup, + pqEncryption = CR.pqSupportToEnc pqSup, pqSndEnabled = Nothing, pqRcvEnabled = Nothing, authErrCounter = 0 @@ -256,7 +264,8 @@ allowConnEnablePQ db connId = |] (Only connId) -updateConnPQSndEnabled :: DB.Connection -> Int64 -> PQFlag -> IO () +-- TODO PQ possibly combine all functions +updateConnPQSndEnabled :: DB.Connection -> Int64 -> PQEncryption -> IO () updateConnPQSndEnabled db connId pqSndEnabled = DB.execute db @@ -267,7 +276,7 @@ updateConnPQSndEnabled db connId pqSndEnabled = |] (pqSndEnabled, connId) -updateConnPQRcvEnabled :: DB.Connection -> Int64 -> PQFlag -> IO () +updateConnPQRcvEnabled :: DB.Connection -> Int64 -> PQEncryption -> IO () updateConnPQRcvEnabled db connId pqRcvEnabled = DB.execute db @@ -278,7 +287,7 @@ updateConnPQRcvEnabled db connId pqRcvEnabled = |] (pqRcvEnabled, connId) -updateConnPQEnabledCON :: DB.Connection -> Int64 -> PQFlag -> IO () +updateConnPQEnabledCON :: DB.Connection -> Int64 -> PQEncryption -> IO () updateConnPQEnabledCON db connId pqEnabled = DB.execute db diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 05b4bf46ed..adffb94ebf 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -49,6 +49,7 @@ import Simplex.Chat.Types.Util import Simplex.FileTransfer.Description (FileDigest) import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, RcvFileId, SAEntity (..), SndFileId, UserId) import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON) import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI) @@ -335,6 +336,8 @@ data UserContactRequest = UserContactRequest createdAt :: UTCTime, updatedAt :: UTCTime, xContactId :: Maybe XContactId + -- TODO PQ save pqSupport from REQ to database + -- pqSupport :: PQSupport } deriving (Eq, Show) @@ -1335,8 +1338,6 @@ type ConnReqInvitation = ConnectionRequestUri 'CMInvitation type ConnReqContact = ConnectionRequestUri 'CMContact -type PQFlag = Bool - data Connection = Connection { connId :: Int64, agentConnId :: AgentConnId, @@ -1353,9 +1354,10 @@ data Connection = Connection localAlias :: Text, entityId :: Maybe Int64, -- contact, group member, file ID or user contact ID connectionCode :: Maybe SecurityCode, - enablePQ :: PQFlag, - pqSndEnabled :: Maybe PQFlag, - pqRcvEnabled :: Maybe PQFlag, + pqSupport :: PQSupport, + pqEncryption :: PQEncryption, + pqSndEnabled :: Maybe PQEncryption, + pqRcvEnabled :: Maybe PQEncryption, authErrCounter :: Int, createdAt :: UTCTime } @@ -1391,8 +1393,8 @@ connIncognito :: Connection -> Bool connIncognito Connection {customUserProfileId} = isJust customUserProfileId connPQEnabled :: Connection -> Bool -connPQEnabled Connection {pqSndEnabled, pqRcvEnabled} = - pqSndEnabled == Just True && pqRcvEnabled == Just True +connPQEnabled Connection {pqSndEnabled = Just (PQEncryption s), pqRcvEnabled = Just (PQEncryption r)} = s && r +connPQEnabled _ = False data PendingContactConnection = PendingContactConnection { pccConnId :: Int64, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 7783ac804a..ed0095c531 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -56,6 +56,7 @@ import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) +import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON) @@ -340,7 +341,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} -> ["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName] CRRemoteCtrlStopped {} -> ["remote controller stopped"] - CRContactPQEnabled u c pqOn -> ttyUser u [ttyContact' c <> ": post-quantum encryption " <> (if pqOn then "enabled" else "disabled")] + CRContactPQEnabled u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": post-quantum encryption " <> (if pqOn then "enabled" else "disabled")] CRContactPQAllowed u c -> ttyUser u [ttyContact' c <> ": post-quantum encryption allowed"] CRSQLResult rows -> map plain rows CRSlowSQLQueries {chatQueries, agentQueries} -> diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index e5e33761c5..d5a56ec91a 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -41,8 +41,7 @@ import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..)) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultNetworkConfig) -import Simplex.Messaging.Crypto.Ratchet (pattern VersionE2E) -import qualified Simplex.Messaging.Crypto.Ratchet as CR +import Simplex.Messaging.Crypto.Ratchet (supportedE2EEncryptVRange, pattern PQSupportOff, pattern VersionE2E) import Simplex.Messaging.Server (runSMPServerBlocking) import Simplex.Messaging.Server.Env.STM import Simplex.Messaging.Transport @@ -142,8 +141,8 @@ testAgentCfgVPrev :: AgentConfig testAgentCfgVPrev = testAgentCfg { smpClientVRange = prevRange $ smpClientVRange testAgentCfg, - smpAgentVRange = \_ -> prevRange $ supportedSMPAgentVRange CR.PQEncOff, - e2eEncryptVRange = \_ -> prevRange $ CR.supportedE2EEncryptVRange CR.PQEncOff, + smpAgentVRange = \_ -> prevRange $ supportedSMPAgentVRange PQSupportOff, + e2eEncryptVRange = \_ -> prevRange $ supportedE2EEncryptVRange PQSupportOff, smpCfg = (smpCfg testAgentCfg) {serverVRange = prevRange $ serverVRange $ smpCfg testAgentCfg} } diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 3dc5500204..600a4bcc1f 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -25,7 +25,7 @@ import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Store (agentStoreFile, chatStoreFile) import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, pattern VersionChat) import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff) +import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff) import Simplex.Messaging.Util (safeDecodeUtf8) import Simplex.Messaging.Version import System.Directory (copyFile, doesDirectoryExist, doesFileExist) @@ -116,14 +116,14 @@ chatDirectTests = do it "should send delivery receipts depending on configuration" testConfigureDeliveryReceipts describe "negotiate connection peer chat protocol version range" $ do describe "peer version range correctly set for new connection via invitation" $ do - testInvVRange (supportedChatVRange PQEncOff) (supportedChatVRange PQEncOff) - testInvVRange (supportedChatVRange PQEncOff) vr11 - testInvVRange vr11 (supportedChatVRange PQEncOff) + testInvVRange (supportedChatVRange PQSupportOff) (supportedChatVRange PQSupportOff) + testInvVRange (supportedChatVRange PQSupportOff) vr11 + testInvVRange vr11 (supportedChatVRange PQSupportOff) testInvVRange vr11 vr11 describe "peer version range correctly set for new connection via contact request" $ do - testReqVRange (supportedChatVRange PQEncOff) (supportedChatVRange PQEncOff) - testReqVRange (supportedChatVRange PQEncOff) vr11 - testReqVRange vr11 (supportedChatVRange PQEncOff) + testReqVRange (supportedChatVRange PQSupportOff) (supportedChatVRange PQSupportOff) + testReqVRange (supportedChatVRange PQSupportOff) vr11 + testReqVRange vr11 (supportedChatVRange PQSupportOff) testReqVRange vr11 vr11 it "update peer version range on received messages" testUpdatePeerChatVRange describe "network statuses" $ do @@ -2700,7 +2700,7 @@ testUpdatePeerChatVRange tmp = contactInfoChatVRange alice vr11 bob ##> "/i alice" - contactInfoChatVRange bob (supportedChatVRange PQEncOff) + contactInfoChatVRange bob (supportedChatVRange PQSupportOff) withTestChat tmp "bob" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" @@ -2709,10 +2709,10 @@ testUpdatePeerChatVRange tmp = alice <# "bob> hello 1" alice ##> "/i bob" - contactInfoChatVRange alice (supportedChatVRange PQEncOff) + contactInfoChatVRange alice (supportedChatVRange PQSupportOff) bob ##> "/i alice" - contactInfoChatVRange bob (supportedChatVRange PQEncOff) + contactInfoChatVRange bob (supportedChatVRange PQSupportOff) withTestChatCfg tmp cfg11 "bob" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" @@ -2724,7 +2724,7 @@ testUpdatePeerChatVRange tmp = contactInfoChatVRange alice vr11 bob ##> "/i alice" - contactInfoChatVRange bob (supportedChatVRange PQEncOff) + contactInfoChatVRange bob (supportedChatVRange PQSupportOff) where cfg11 = testCfg {chatVRange = const vr11} :: ChatConfig diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 088bc45969..bf9b445925 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -17,7 +17,7 @@ import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Store (agentStoreFile, chatStoreFile) import Simplex.Chat.Types (GroupMemberRole (..), VersionRangeChat) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB -import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff) +import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff) import System.Directory (copyFile) import System.FilePath (()) import Test.Hspec hiding (it) @@ -149,19 +149,19 @@ chatGroupTests = do it "member was blocked before joining group" testBlockForAllBeforeJoining it "can't repeat block, unblock" testBlockForAllCantRepeat where - _0 = supportedChatVRange PQEncOff -- don't create direct connections + _0 = supportedChatVRange PQSupportOff -- don't create direct connections _1 = groupCreateDirectVRange -- having host configured with older version doesn't have effect in tests -- because host uses current code and sends version in MemberInfo testNoDirect vrMem2 vrMem3 noConns = it ( "host " - <> vRangeStr (supportedChatVRange PQEncOff) + <> vRangeStr (supportedChatVRange PQSupportOff) <> (", 2nd mem " <> vRangeStr vrMem2) <> (", 3rd mem " <> vRangeStr vrMem3) <> (if noConns then " : 2 3" else " : 2 <##> 3") ) - $ testNoGroupDirectConns (supportedChatVRange PQEncOff) vrMem2 vrMem3 noConns + $ testNoGroupDirectConns (supportedChatVRange PQSupportOff) vrMem2 vrMem3 noConns testGroup :: HasCallStack => FilePath -> IO () testGroup = diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 810cd58bfa..322a810d92 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -21,7 +21,7 @@ import Data.String import qualified Data.Text as T import Database.SQLite.Simple (Only (..)) import Simplex.Chat.Controller (ChatConfig (..), ChatController (..)) -import Simplex.Chat.Messages.CIContent (e2eeInfoNoPQText) +import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText) import Simplex.Chat.Protocol import Simplex.Chat.Store.NoteFolders (createNoteFolder) import Simplex.Chat.Store.Profiles (getUserContactProfiles) @@ -30,7 +30,7 @@ import Simplex.Chat.Types.Preferences import Simplex.FileTransfer.Client.Main (xftpClientCLI) import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow, withTransaction) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB -import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff) +import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Version import System.Directory (doesFileExist) @@ -204,7 +204,7 @@ chatFeatures'' = ] e2eeInfoNoPQStr :: String -e2eeInfoNoPQStr = T.unpack e2eeInfoNoPQText +e2eeInfoNoPQStr = T.unpack e2eInfoNoPQText lastChatFeature :: String lastChatFeature = snd $ last chatFeatures @@ -584,7 +584,7 @@ checkActionDeletesFile file action = do currentChatVRangeInfo :: String currentChatVRangeInfo = - "peer chat protocol version range: " <> vRangeStr (supportedChatVRange PQEncOff) + "peer chat protocol version range: " <> vRangeStr (supportedChatVRange PQSupportOff) vRangeStr :: VersionRange v -> String vRangeStr (VersionRange minVer maxVer) = "(" <> show minVer <> ", " <> show maxVer <> ")" diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index ece24132e8..082af825e5 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} module ProtocolTests where @@ -14,7 +15,6 @@ import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet -import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Protocol (supportedSMPClientVRange) import Simplex.Messaging.ServiceScheme import Simplex.Messaging.Version @@ -49,7 +49,7 @@ testDhPubKey :: C.PublicKeyX448 testDhPubKey = "MEIwBQYDK2VvAzkAmKuSYeQ/m0SixPDS8Wq8VBaTS1cW+Lp0n0h4Diu+kUpR+qXx4SDJ32YGEFoGFGSbGPry5Ychr6U=" testE2ERatchetParams :: RcvE2ERatchetParamsUri 'C.X448 -testE2ERatchetParams = E2ERatchetParamsUri (supportedE2EEncryptVRange CR.PQEncOn) testDhPubKey testDhPubKey Nothing +testE2ERatchetParams = E2ERatchetParamsUri (supportedE2EEncryptVRange PQSupportOn) testDhPubKey testDhPubKey Nothing testConnReq :: ConnectionRequestUri 'CMInvitation testConnReq = CRInvitationUri connReqData testE2ERatchetParams @@ -132,7 +132,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) it "x.msg.new chat message with chat version range" $ "{\"v\":\"1-7\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - ##==## ChatMessage (supportedChatVRange PQEncOff) (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) + ##==## ChatMessage (supportedChatVRange PQSupportOff) (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) it "x.msg.new quote" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" ##==## ChatMessage @@ -242,13 +242,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} it "x.grp.mem.new with member chat version range" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" - #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQEncOff, profile = testProfile} + #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQSupportOff, profile = testProfile} it "x.grp.mem.intro" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} Nothing it "x.grp.mem.intro with member chat version range" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" - #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQEncOff, profile = testProfile} Nothing + #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQSupportOff, profile = testProfile} Nothing it "x.grp.mem.intro with member restrictions" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberRestrictions\":{\"restriction\":\"blocked\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} (Just MemberRestrictions {restriction = MRSBlocked}) @@ -263,7 +263,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq} it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" - #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQEncOff, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing} + #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQSupportOff, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing} it "x.grp.mem.info" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XGrpMemInfo (MemberId "\1\2\3\4") testProfile