From 61a3eb32eed0723c9a501dfe033feeb5a9a037cb Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Wed, 6 Mar 2024 19:06:01 +0400 Subject: [PATCH] core (pq): global flag only affects new connections; api to allow PQ in old contacts (#3869) --- src/Simplex/Chat.hs | 39 ++++++++++++++++++-------------- src/Simplex/Chat/Controller.hs | 2 ++ src/Simplex/Chat/Store/Shared.hs | 11 +++++++++ src/Simplex/Chat/View.hs | 1 + 4 files changed, 36 insertions(+), 17 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index aa854094ee..d8089d48d2 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -601,6 +601,18 @@ processChatCommand' vr = \case APISetPQEnabled onOff -> do asks pqExperimentalEnabled >>= atomically . (`writeTVar` 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' + Nothing -> throwChatError $ CEContactNotActive ct APIExportArchive cfg -> checkChatStopped $ exportArchive cfg >> ok_ ExportArchive -> do ts <- liftIO getCurrentTime @@ -1294,9 +1306,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 -> do - enablePQ <- contactPQEnc conn - cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (aConnId conn) enablePQ force + Just conn@Connection {enablePQ} -> do + cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (aConnId conn) (CR.PQEncryption enablePQ) force createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCERatchetSync rss Nothing) Nothing pure $ CRContactRatchetSyncStarted user ct cStats Nothing -> throwChatError $ CEContactNotActive ct @@ -2201,8 +2212,7 @@ processChatCommand' vr = \case Nothing -> pure $ UserProfileUpdateSummary 0 0 [] Just changedCts -> do let idsEvts = L.map ctSndMsg changedCts - enablePQ <- readTVarIO =<< asks pqExperimentalEnabled - msgReqs_ <- L.zipWith (ctMsgReq enablePQ) changedCts <$> createSndMessages idsEvts + msgReqs_ <- L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts (errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_ unless (null errs) $ toView $ CRChatErrors (Just user) errs let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts @@ -2227,11 +2237,11 @@ processChatCommand' vr = \case ct' = updateMergedPreferences user' ct mergedProfile' = userProfileToSend user' Nothing (Just ct') False ctSndMsg :: ChangedProfileContact -> (ConnOrGroupId, PQEncryption, ChatMsgEvent 'Json) - ctSndMsg ChangedProfileContact {mergedProfile', conn = Connection {connId, enablePQ = enablePQConn}} = (ConnectionId connId, CR.PQEncryption enablePQConn, XInfo mergedProfile') - ctMsgReq :: PQFlag -> ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError MsgReq - ctMsgReq enablePQ ChangedProfileContact {conn = conn@Connection {enablePQ = enablePQConn}} = + ctSndMsg ChangedProfileContact {mergedProfile', conn = Connection {connId, enablePQ}} = (ConnectionId connId, CR.PQEncryption enablePQ, XInfo mergedProfile') + ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError MsgReq + ctMsgReq ChangedProfileContact {conn = conn@Connection {enablePQ}} = fmap $ \SndMessage {msgId, msgBody} -> - (conn, CR.PQEncryption $ enablePQ && enablePQConn, MsgFlags {notification = hasNotification XInfo_}, msgBody, msgId) + (conn, CR.PQEncryption enablePQ, 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' @@ -6007,9 +6017,8 @@ 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} <- liftEither $ contactSendConn_ ct - pqEnc <- contactPQEnc conn - r <- sendDirectMessage conn pqEnc chatMsgEvent (ConnectionId connId) + conn@Connection {connId, enablePQ} <- liftEither $ contactSendConn_ ct + r <- sendDirectMessage conn (CR.PQEncryption enablePQ) chatMsgEvent (ConnectionId connId) let (sndMessage, msgDeliveryId, CR.PQEncryption pqEnabled') = 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' @@ -6120,11 +6129,6 @@ deliverMessage' conn pqEnc msgFlags msgBody msgId = type MsgReq = (Connection, CR.PQEncryption, MsgFlags, MsgBody, MessageId) -contactPQEnc :: ChatMonad m => Connection -> m CR.PQEncryption -contactPQEnc Connection {enablePQ = enablePQConn} = do - enablePQ <- readTVarIO =<< asks pqExperimentalEnabled - pure $ CR.PQEncryption $ enablePQ && enablePQConn - deliverMessages :: ChatMonad' m => NonEmpty MsgReq -> m (NonEmpty (Either ChatError (Int64, CR.PQEncryption))) deliverMessages msgs = deliverMessagesB $ L.map Right msgs @@ -6708,6 +6712,7 @@ chatCommandP = "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP), "/contact_merge " *> (SetContactMergeEnabled <$> onOffP), "/_pq " *> (APISetPQEnabled <$> onOffP), + "/_pq allow " *> (APIAllowContactPQ <$> A.decimal), "/_db export " *> (APIExportArchive <$> jsonP), "/db export" $> ExportArchive, "/_db import " *> (APIImportArchive <$> jsonP), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 935e6cb079..a23d88a7b7 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -245,6 +245,7 @@ data ChatCommand | APISetEncryptLocalFiles Bool | SetContactMergeEnabled Bool | APISetPQEnabled Bool + | APIAllowContactPQ ContactId | APIExportArchive ArchiveConfig | ExportArchive | APIImportArchive ArchiveConfig @@ -699,6 +700,7 @@ data ChatResponse | CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text} | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo} | CRRemoteCtrlStopped {rcsState :: RemoteCtrlSessionState, rcStopReason :: RemoteCtrlStopReason} + | CRContactPQAllowed {user :: User, contact :: Contact} | CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: Bool} | CRSQLResult {rows :: [Text]} | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]} diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index e961c4bcd0..77fd56489f 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -245,6 +245,17 @@ createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, imag (displayName, fullName, image, userId, Just True, createdAt, createdAt) insertedRowId db +allowConnEnablePQ :: DB.Connection -> Int64 -> IO () +allowConnEnablePQ db connId = + DB.execute + db + [sql| + UPDATE connections + SET enable_pq = 1 + WHERE connection_id = ? + |] + (Only connId) + updateConnPQSndEnabled :: DB.Connection -> Int64 -> PQFlag -> IO () updateConnPQSndEnabled db connId pqSndEnabled = DB.execute diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 44bbc007bf..7783ac804a 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -341,6 +341,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe ["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")] + CRContactPQAllowed u c -> ttyUser u [ttyContact' c <> ": post-quantum encryption allowed"] CRSQLResult rows -> map plain rows CRSlowSQLQueries {chatQueries, agentQueries} -> let viewQuery SlowSQLQuery {query, queryStats = SlowQueryStats {count, timeMax, timeAvg}} =