From 4ffb6a348a06cd87ec7d456bca14e155c1b6310d Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Wed, 6 Mar 2024 21:28:03 +0000 Subject: [PATCH] pqdr: use different newtypes for supporting and enabling PQ encryption in connections (#1031) * pqdr: use different newtypes for supporting and enabling PQ encryption in connections * rename field, fix test * refactor --- src/Simplex/Messaging/Agent.hs | 167 +++++++++--------- src/Simplex/Messaging/Agent/Env/SQLite.hs | 6 +- src/Simplex/Messaging/Agent/Protocol.hs | 36 ++-- src/Simplex/Messaging/Agent/Store.hs | 4 +- src/Simplex/Messaging/Agent/Store/SQLite.hs | 34 ++-- .../Migrations/M20240225_ratchet_kem.hs | 4 +- .../Store/SQLite/Migrations/agent_schema.sql | 2 +- src/Simplex/Messaging/Crypto/Ratchet.hs | 116 ++++++++---- tests/AgentTests.hs | 62 +++---- tests/AgentTests/ConnectionRequestTests.hs | 4 +- tests/AgentTests/DoubleRatchetTests.hs | 45 ++--- tests/AgentTests/FunctionalAPITests.hs | 113 ++++++------ tests/AgentTests/SQLiteTests.hs | 6 +- 13 files changed, 324 insertions(+), 275 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index d0a232131..204647ef6 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -160,7 +160,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import Simplex.Messaging.Client (ProtocolClient (..), ServerTransmission) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs) -import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOn, pattern PQEncOff) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport, pattern PQEncOn, pattern PQEncOff, pattern PQSupportOn, pattern PQSupportOff) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String @@ -225,7 +225,7 @@ createConnectionAsync :: forall m c. (AgentErrorMonad m, ConnectionModeI c) => A createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAsync c userId aCorrId enableNtfs -- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id -joinConnectionAsync :: AgentErrorMonad m => AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQEncryption -> SubscriptionMode -> m ConnId +joinConnectionAsync :: AgentErrorMonad m => AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> m ConnId joinConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId enableNtfs -- | Allow connection to continue after CONF notification (LET command), no synchronous response @@ -233,7 +233,7 @@ allowConnectionAsync :: AgentErrorMonad m => AgentClient -> ACorrId -> ConnId -> allowConnectionAsync c = withAgentEnv c .:: allowConnectionAsync' c -- | Accept contact after REQ notification (ACPT command) asynchronously, synchronous response is new connection id -acceptContactAsync :: AgentErrorMonad m => AgentClient -> ACorrId -> Bool -> ConfirmationId -> ConnInfo -> PQEncryption -> SubscriptionMode -> m ConnId +acceptContactAsync :: AgentErrorMonad m => AgentClient -> ACorrId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> m ConnId acceptContactAsync c aCorrId enableNtfs = withAgentEnv c .:: acceptContactAsync' c aCorrId enableNtfs -- | Acknowledge message (ACK command) asynchronously, no synchronous response @@ -257,7 +257,7 @@ createConnection :: AgentErrorMonad m => AgentClient -> UserId -> Bool -> SConne createConnection c userId enableNtfs = withAgentEnv c .:: newConn c userId "" enableNtfs -- | Join SMP agent connection (JOIN command) -joinConnection :: AgentErrorMonad m => AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQEncryption -> SubscriptionMode -> m ConnId +joinConnection :: AgentErrorMonad m => AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> m ConnId joinConnection c userId enableNtfs = withAgentEnv c .:: joinConn c userId "" enableNtfs -- | Allow connection to continue after CONF notification (LET command) @@ -265,7 +265,7 @@ allowConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId allowConnection c = withAgentEnv c .:. allowConnection' c -- | Accept contact after REQ notification (ACPT command) -acceptContact :: AgentErrorMonad m => AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQEncryption -> SubscriptionMode -> m ConnId +acceptContact :: AgentErrorMonad m => AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> m ConnId acceptContact c enableNtfs = withAgentEnv c .:: acceptContact' c "" enableNtfs -- | Reject contact (RJCT command) @@ -319,7 +319,7 @@ abortConnectionSwitch :: AgentErrorMonad m => AgentClient -> ConnId -> m Connect abortConnectionSwitch c = withAgentEnv c . abortConnectionSwitch' c -- | Re-synchronize connection ratchet keys -synchronizeRatchet :: AgentErrorMonad m => AgentClient -> ConnId -> PQEncryption -> Bool -> m ConnectionStats +synchronizeRatchet :: AgentErrorMonad m => AgentClient -> ConnId -> PQSupport -> Bool -> m ConnectionStats synchronizeRatchet c = withAgentEnv c .:. synchronizeRatchet' c -- | Suspend SMP agent connection (OFF command) @@ -558,23 +558,23 @@ newConnAsync c userId corrId enableNtfs cMode pqInitKeys subMode = do enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn $ NEW enableNtfs (ACM cMode) pqInitKeys subMode pure connId -newConnNoQueues :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> PQEncryption -> m ConnId -newConnNoQueues c userId connId enableNtfs cMode pqEncryption = do +newConnNoQueues :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> PQSupport -> m ConnId +newConnNoQueues c userId connId enableNtfs cMode pqSupport = do g <- asks random - connAgentVersion <- asks $ maxVersion . ($ pqEncryption) . smpAgentVRange . config - let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqEncryption} + connAgentVersion <- asks $ maxVersion . ($ pqSupport) . smpAgentVRange . config + let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} withStore c $ \db -> createNewConn db g cData cMode -joinConnAsync :: AgentMonad m => AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQEncryption -> SubscriptionMode -> m ConnId -joinConnAsync c userId corrId enableNtfs cReqUri@(CRInvitationUri ConnReqUriData {crAgentVRange} _) cInfo pqEncryption subMode = do +joinConnAsync :: AgentMonad m => AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> m ConnId +joinConnAsync c userId corrId enableNtfs cReqUri@(CRInvitationUri ConnReqUriData {crAgentVRange} _) cInfo pqSupport subMode = do withInvLock c (strEncode cReqUri) "joinConnAsync" $ do - aVRange <- asks $ ($ pqEncryption) . smpAgentVRange . config + aVRange <- asks $ ($ pqSupport) . smpAgentVRange . config case crAgentVRange `compatibleVersion` aVRange of Just (Compatible connAgentVersion) -> do g <- asks random - let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqEncryption} + let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} connId <- withStore c $ \db -> createNewConn db g cData SCMInvitation - enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqEncryption subMode cInfo + enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo pure connId _ -> throwError $ AGENT A_VERSION joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption = @@ -587,13 +587,13 @@ allowConnectionAsync' c corrId connId confId ownConnInfo = enqueueCommand c corrId connId (Just server) $ AClientCommand $ APC SAEConn $ LET confId ownConnInfo _ -> throwError $ CMD PROHIBITED -acceptContactAsync' :: AgentMonad m => AgentClient -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQEncryption -> SubscriptionMode -> m ConnId -acceptContactAsync' c corrId enableNtfs invId ownConnInfo pqEnc subMode = do +acceptContactAsync' :: AgentMonad m => AgentClient -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> m ConnId +acceptContactAsync' c corrId enableNtfs invId ownConnInfo pqSupport subMode = do Invitation {contactConnId, connReq} <- withStore c (`getInvitation` invId) withStore c (`getConn` contactConnId) >>= \case SomeConn _ (ContactConnection ConnData {userId} _) -> do withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqEnc subMode `catchAgentError` \err -> do + joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do withStore' c (`unacceptInvitation` invId) throwError err _ -> throwError $ CMD PROHIBITED @@ -681,45 +681,45 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem pure (connId, CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVRange) -joinConn :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQEncryption -> SubscriptionMode -> m ConnId -joinConn c userId connId enableNtfs cReq cInfo pqEnc subMode = do +joinConn :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> m ConnId +joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do srv <- case cReq of CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> getNextServer c userId [qServer q] _ -> getSMPServer c userId - joinConnSrv c userId connId enableNtfs cReq cInfo pqEnc subMode srv + joinConnSrv c userId connId enableNtfs cReq cInfo pqSupport subMode srv -startJoinInvitation :: AgentMonad m => UserId -> ConnId -> Bool -> ConnectionRequestUri 'CMInvitation -> PQEncryption -> m (Compatible VersionSMPA, ConnData, NewSndQueue, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448) -startJoinInvitation userId connId enableNtfs (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) pqEncryption = do +startJoinInvitation :: AgentMonad m => UserId -> ConnId -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> m (Compatible VersionSMPA, ConnData, NewSndQueue, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448) +startJoinInvitation userId connId enableNtfs (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) pqSupport = do AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config - let e2eVRange = e2eEncryptVRange pqEncryption + let e2eVRange = e2eEncryptVRange pqSupport case ( qUri `compatibleVersion` smpClientVRange, e2eRcvParamsUri `compatibleVersion` e2eVRange, - crAgentVRange `compatibleVersion` smpAgentVRange pqEncryption + crAgentVRange `compatibleVersion` smpAgentVRange pqSupport ) of (Just qInfo, Just (Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_)), Just aVersion@(Compatible connAgentVersion)) -> do g <- asks random - (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ pqEncryption kem_) + (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ kem_ pqSupport) (_, rcDHRs) <- atomically $ C.generateKeyPair g rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams let rcVs = CR.RVersions {current = v, maxSupported = maxVersion e2eVRange} rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams q <- newSndQueue userId "" qInfo - let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqEncryption} + let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} pure (aVersion, cData, q, rc, e2eSndParams) _ -> throwError $ AGENT A_VERSION -joinConnSrv :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQEncryption -> SubscriptionMode -> SMPServerWithAuth -> m ConnId -joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqEnc subMode srv = +joinConnSrv :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> m ConnId +joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do - (aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqEnc + (aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSupport g <- asks random (connId', sq) <- withStore c $ \db -> runExceptT $ do r@(connId', _) <- ExceptT $ createSndConn db g cData q liftIO $ createRatchet db connId' rc pure r let cData' = (cData :: ConnData) {connId = connId'} - tryError (confirmQueue aVersion c cData' sq srv cInfo (Just e2eSndParams) pqEnc subMode) >>= \case + tryError (confirmQueue aVersion c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case Right _ -> pure connId' Left e -> do -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md @@ -737,14 +737,14 @@ joinConnSrv c userId connId enableNtfs (CRContactUri ConnReqUriData {crAgentVRan pure connId' _ -> throwError $ AGENT A_VERSION -joinConnSrvAsync :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQEncryption -> SubscriptionMode -> SMPServerWithAuth -> m () -joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqEnc subMode srv = do - (_aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqEnc +joinConnSrvAsync :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> m () +joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do + (_aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSupport q' <- withStore c $ \db -> runExceptT $ do liftIO $ createRatchet db connId rc ExceptT $ updateNewConnSnd db connId q - confirmQueueAsync c cData q' srv cInfo (Just e2eSndParams) pqEnc subMode -joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqEnc _srv = do + confirmQueueAsync c cData q' srv cInfo (Just e2eSndParams) subMode +joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do throwError $ CMD PROHIBITED createReplyQueue :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> m SMPQueueInfo @@ -775,13 +775,13 @@ allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConne _ -> throwError $ CMD PROHIBITED -- | Accept contact (ACPT command) in Reader monad -acceptContact' :: AgentMonad m => AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQEncryption -> SubscriptionMode -> m ConnId -acceptContact' c connId enableNtfs invId ownConnInfo pqEnc subMode = withConnLock c connId "acceptContact" $ do +acceptContact' :: AgentMonad m => AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> m ConnId +acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do Invitation {contactConnId, connReq} <- withStore c (`getInvitation` invId) withStore c (`getConn` contactConnId) >>= \case SomeConn _ (ContactConnection ConnData {userId} _) -> do withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConn c userId connId enableNtfs connReq ownConnInfo pqEnc subMode `catchAgentError` \err -> do + joinConn c userId connId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do withStore' c (`unacceptInvitation` invId) throwError err _ -> throwError $ CMD PROHIBITED @@ -927,7 +927,7 @@ sendMessagesB' :: forall m t. (AgentMonad' m, Traversable t) => AgentClient -> t sendMessagesB' c reqs = withConnLocks c connIds "sendMessages" $ do reqs' <- withStoreBatch c (\db -> fmap (bindRight $ \req@(connId, _, _, _) -> bimap storeError (req,) <$> getConn db connId) reqs) let (toEnable, reqs'') = mapAccumL prepareConn [] reqs' - void $ withStoreBatch' c $ \db -> map (enableConnPQEncryption db) toEnable + void $ withStoreBatch' c $ \db -> map (\connId -> setConnPQSupport db connId PQSupportOn) toEnable enqueueMessagesB c reqs'' where prepareConn :: [ConnId] -> Either AgentErrorType (MsgReq, SomeConn) -> ([ConnId], Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage)) @@ -938,12 +938,12 @@ sendMessagesB' c reqs = withConnLocks c connIds "sendMessages" $ do _ -> (acc, Left $ CONN SIMPLEX) where prepareMsg :: ConnData -> NonEmpty SndQueue -> ([ConnId], Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage)) - prepareMsg cData@ConnData {connId, pqEncryption} sqs + prepareMsg cData@ConnData {connId, pqSupport} sqs | ratchetSyncSendProhibited cData = (acc, Left $ CMD PROHIBITED) -- connection is only updated if PQ encryption was disabled, and now it has to be enabled. -- support for PQ encryption (small message envelopes) will not be disabled when message is sent. - | pqEnc == PQEncOn && pqEncryption == PQEncOff = - let cData' = cData {pqEncryption = pqEnc} :: ConnData + | pqEnc == PQEncOn && pqSupport == PQSupportOff = + let cData' = cData {pqSupport = PQSupportOn} :: ConnData in (connId : acc, Right (cData', sqs, Just pqEnc, msgFlags, A_MSG msg)) | otherwise = (acc, Right (cData, sqs, Just pqEnc, msgFlags, A_MSG msg)) connIds = map (\(connId, _, _, _) -> connId) $ rights $ toList reqs @@ -1127,8 +1127,8 @@ enqueueMessageB c reqs = do let sqs' = filter isActiveSndQ sqs pure $ Right ((msgId, pqSecr), if null sqs' then Nothing else Just (cData, sqs', msgId)) where - storeSentMsg :: DB.Connection -> (PQEncryption -> VersionRangeSMPA) -> (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage) -> IO (Either AgentErrorType ((ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage), InternalId, PQEncryption)) - storeSentMsg db getAVRange req@(cData@ConnData {connId, pqEncryption}, sq :| _, pqEnc_, msgFlags, aMessage) = fmap (first storeError) $ runExceptT $ do + storeSentMsg :: DB.Connection -> (PQSupport -> VersionRangeSMPA) -> (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage) -> IO (Either AgentErrorType ((ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage), InternalId, PQEncryption)) + storeSentMsg db getAVRange req@(cData@ConnData {connId, pqSupport}, sq :| _, pqEnc_, msgFlags, aMessage) = fmap (first storeError) $ runExceptT $ do internalTs <- liftIO getCurrentTime (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash @@ -1137,7 +1137,7 @@ enqueueMessageB c reqs = do internalHash = C.sha256Hash agentMsgStr (encAgentMessage, pqEnc) <- agentRatchetEncrypt db cData agentMsgStr e2eEncUserMsgLength pqEnc_ -- agent version range is determined by the connection suppport of PQ encryption, that is may be enabled when message is sent - let agentVersion = maxVersion $ getAVRange pqEncryption + let agentVersion = maxVersion $ getAVRange pqSupport msgBody = smpEncode $ AgentMsgEnvelope {agentVersion, encAgentMessage} msgType = agentMessageType agentMsg msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody, pqEncryption = pqEnc, internalHash, prevMsgHash} @@ -1414,20 +1414,17 @@ abortConnectionSwitch' c connId = _ -> throwError $ CMD PROHIBITED _ -> throwError $ CMD PROHIBITED -synchronizeRatchet' :: AgentMonad m => AgentClient -> ConnId -> PQEncryption -> Bool -> m ConnectionStats -synchronizeRatchet' c connId pqEnc force = withConnLock c connId "synchronizeRatchet" $ do +synchronizeRatchet' :: AgentMonad m => AgentClient -> ConnId -> PQSupport -> Bool -> m ConnectionStats +synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchronizeRatchet" $ do withStore c (`getConn` connId) >>= \case - SomeConn _ (DuplexConnection cData@ConnData {pqEncryption} rqs sqs) + SomeConn _ (DuplexConnection cData@ConnData {pqSupport} rqs sqs) | ratchetSyncAllowed cData || force -> do -- check queues are not switching? - pqEnc' <- - if pqEnc == PQEncOn && pqEncryption == PQEncOff - then PQEncOn <$ withStore' c (`enableConnPQEncryption` connId) - else pure pqEncryption - let cData' = cData {pqEncryption = pqEnc'} :: ConnData + when (pqSupport' /= pqSupport) $ withStore' c $ \db -> setConnPQSupport db connId pqSupport' + let cData' = cData {pqSupport = pqSupport'} :: ConnData AgentConfig {e2eEncryptVRange} <- asks config g <- asks random - (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion $ e2eEncryptVRange pqEnc') pqEnc' + (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion $ e2eEncryptVRange pqSupport') pqSupport' enqueueRatchetKeyMsgs c cData' sqs e2eParams withStore' c $ \db -> do setConnRatchetSync db connId RSStarted @@ -2084,8 +2081,8 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v, _ -> prohibited >> ack _ -> prohibited >> ack updateConnVersion :: Connection c -> ConnData -> VersionSMPA -> m (Connection c) - updateConnVersion conn' cData'@ConnData {pqEncryption} msgAgentVersion = do - aVRange <- asks $ ($ pqEncryption) . smpAgentVRange . config + updateConnVersion conn' cData'@ConnData {pqSupport} msgAgentVersion = do + aVRange <- asks $ ($ pqSupport) . smpAgentVRange . config let msgAVRange = fromMaybe (versionToRange msgAgentVersion) $ safeVersionRange (minVersion aVRange) msgAgentVersion case msgAVRange `compatibleVersion` aVRange of Just (Compatible av) @@ -2146,14 +2143,13 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v, parseMessage :: Encoding a => ByteString -> m a parseMessage = liftEither . parse smpP (AGENT A_MESSAGE) - -- TODO PQ make sure pqEncryption in conn' is set correctly smpConfirmation :: SMP.MsgId -> Connection c -> C.APublicAuthKey -> C.PublicKeyX25519 -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> ByteString -> VersionSMPC -> VersionSMPA -> m () smpConfirmation srvMsgId conn' senderKey e2ePubKey e2eEncryption encConnInfo smpClientVersion agentVersion = do logServer "<--" c srv rId $ "MSG :" <> logSecret srvMsgId AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config - let ConnData {pqEncryption} = toConnData conn' - aVRange = smpAgentVRange pqEncryption - e2eVRange = e2eEncryptVRange pqEncryption + let ConnData {pqSupport} = toConnData conn' + aVRange = smpAgentVRange pqSupport + e2eVRange = e2eEncryptVRange pqSupport unless (agentVersion `isCompatible` aVRange && smpClientVersion `isCompatible` smpClientVRange) (throwError $ AGENT A_VERSION) @@ -2166,7 +2162,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v, rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 rcDHRs pKem e2eSndParams -- TODO PQ combine isCompatible check and construction in one call let rcVs = CR.RVersions {current = e2eVersion, maxSupported = maxVersion e2eVRange} - rc = CR.initRcvRatchet rcVs rcDHRs rcParams pqEncryption + rc = CR.initRcvRatchet rcVs rcDHRs rcParams pqSupport g <- asks random (agentMsgBody_, rc', skipped) <- liftError cryptoError $ CR.rcDecrypt g rc M.empty encConnInfo case (agentMsgBody_, skipped) of @@ -2354,10 +2350,10 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v, -- TODO PQ make sure pqEncryption is set correctly here newRatchetKey :: CR.RcvE2ERatchetParams 'C.X448 -> Connection 'CDuplex -> m () - newRatchetKey e2eOtherPartyParams@(CR.E2ERatchetParams e2eVersion k1Rcv k2Rcv _) conn'@(DuplexConnection cData'@ConnData {lastExternalSndId, pqEncryption} _ sqs) = + newRatchetKey e2eOtherPartyParams@(CR.E2ERatchetParams e2eVersion k1Rcv k2Rcv _) conn'@(DuplexConnection cData'@ConnData {lastExternalSndId, pqSupport} _ sqs) = unlessM ratchetExists $ do AgentConfig {e2eEncryptVRange} <- asks config - let connE2EVRange = e2eEncryptVRange pqEncryption + let connE2EVRange = e2eEncryptVRange pqSupport unless (e2eVersion `isCompatible` connE2EVRange) (throwError $ AGENT A_VERSION) keys <- getSendRatchetKeys -- TODO PQ combine with `isCompatible` check above @@ -2388,7 +2384,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v, where sendReplyKey = do g <- asks random - (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g e2eVersion pqEncryption + (pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g e2eVersion pqSupport enqueueRatchetKeyMsgs c cData' sqs e2eParams pure (pk1, pk2, pKem) notifyRatchetSyncError = do @@ -2411,7 +2407,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), _v, initRatchet rcVs (pk1, pk2, pKem) | rkHash (C.publicKey pk1) (C.publicKey pk2) <= rkHashRcv = do rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eOtherPartyParams - recreateRatchet $ CR.initRcvRatchet rcVs pk2 rcParams pqEncryption + recreateRatchet $ CR.initRcvRatchet rcVs pk2 rcParams pqSupport | otherwise = do (_, rcDHRs) <- atomically . C.generateKeyPair =<< asks random rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 (CR.APRKP CR.SRKSProposed <$> pKem) e2eOtherPartyParams @@ -2443,22 +2439,22 @@ switchStatusError q expected actual = <> (", actual=" <> show actual) connectReplyQueues :: AgentMonad m => AgentClient -> ConnData -> ConnInfo -> NonEmpty SMPQueueInfo -> m () -connectReplyQueues c cData@ConnData {userId, connId, pqEncryption} ownConnInfo (qInfo :| _) = do +connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo (qInfo :| _) = do clientVRange <- asks $ smpClientVRange . config case qInfo `proveCompatible` clientVRange of Nothing -> throwError $ AGENT A_VERSION Just qInfo' -> do sq <- newSndQueue userId connId qInfo' sq' <- withStore c $ \db -> upgradeRcvConnToDuplex db connId sq - enqueueConfirmation c cData sq' ownConnInfo Nothing pqEncryption + enqueueConfirmation c cData sq' ownConnInfo Nothing -confirmQueueAsync :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> PQEncryption -> SubscriptionMode -> m () -confirmQueueAsync c cData sq srv connInfo e2eEncryption_ pqEnc subMode = do - storeConfirmation c cData sq e2eEncryption_ pqEnc =<< mkAgentConfirmation c cData sq srv connInfo subMode +confirmQueueAsync :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> m () +confirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do + storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode submitPendingMsg c cData sq -confirmQueue :: forall m. AgentMonad m => Compatible VersionSMPA -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> PQEncryption -> SubscriptionMode -> m () -confirmQueue (Compatible agentVersion) c cData@ConnData {connId} sq srv connInfo e2eEncryption_ pqEnc subMode = do +confirmQueue :: forall m. AgentMonad m => Compatible VersionSMPA -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> m () +confirmQueue (Compatible agentVersion) c cData@ConnData {connId, pqSupport} sq srv connInfo e2eEncryption_ subMode = do msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode sendConfirmation c sq msg withStore' c $ \db -> setSndQueueStatus db sq Confirmed @@ -2466,6 +2462,7 @@ confirmQueue (Compatible agentVersion) c cData@ConnData {connId} sq srv connInfo mkConfirmation :: AgentMessage -> m MsgBody mkConfirmation aMessage = withStore c $ \db -> runExceptT $ do void . liftIO $ updateSndIds db connId + let pqEnc = CR.pqSupportToEnc pqSupport (encConnInfo, _) <- agentRatchetEncrypt db cData (smpEncode aMessage) e2eEncConnInfoLength (Just pqEnc) pure . smpEncode $ AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} @@ -2474,17 +2471,18 @@ mkAgentConfirmation c cData sq srv connInfo subMode = do qInfo <- createReplyQueue c cData sq subMode srv pure $ AgentConnInfoReply (qInfo :| []) connInfo -enqueueConfirmation :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> PQEncryption -> m () -enqueueConfirmation c cData sq connInfo e2eEncryption_ pqEnc = do - storeConfirmation c cData sq e2eEncryption_ pqEnc $ AgentConnInfo connInfo +enqueueConfirmation :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> m () +enqueueConfirmation c cData sq connInfo e2eEncryption_ = do + storeConfirmation c cData sq e2eEncryption_ $ AgentConnInfo connInfo submitPendingMsg c cData sq -storeConfirmation :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> PQEncryption -> AgentMessage -> m () -storeConfirmation c cData@ConnData {connId, connAgentVersion = v} sq e2eEncryption_ pqEnc agentMsg = withStore c $ \db -> runExceptT $ do +storeConfirmation :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AgentMessage -> m () +storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq e2eEncryption_ agentMsg = withStore c $ \db -> runExceptT $ do internalTs <- liftIO getCurrentTime (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId let agentMsgStr = smpEncode agentMsg internalHash = C.sha256Hash agentMsgStr + pqEnc = CR.pqSupportToEnc pqSupport (encConnInfo, pqEncryption) <- agentRatchetEncrypt db cData agentMsgStr e2eEncConnInfoLength (Just pqEnc) let msgBody = smpEncode $ AgentConfirmation {agentVersion = v, e2eEncryption_, encConnInfo} msgType = agentMessageType agentMsg @@ -2498,8 +2496,8 @@ enqueueRatchetKeyMsgs c cData (sq :| sqs) e2eEncryption = do mapM_ (enqueueSavedMessage c cData msgId) $ filter isActiveSndQ sqs enqueueRatchetKey :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> CR.RcvE2ERatchetParams 'C.X448 -> m AgentMsgId -enqueueRatchetKey c cData@ConnData {connId, pqEncryption} sq e2eEncryption = do - aVRange <- asks $ ($ pqEncryption) . smpAgentVRange . config +enqueueRatchetKey c cData@ConnData {connId, pqSupport} sq e2eEncryption = do + aVRange <- asks $ ($ pqSupport) . smpAgentVRange . config msgId <- storeRatchetKey $ maxVersion aVRange submitPendingMsg c cData sq pure $ unId msgId @@ -2513,16 +2511,17 @@ enqueueRatchetKey c cData@ConnData {connId, pqEncryption} sq e2eEncryption = do internalHash = C.sha256Hash agentMsgStr let msgBody = smpEncode $ AgentRatchetKey {agentVersion, e2eEncryption, info = agentMsgStr} msgType = agentMessageType agentMsg - msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash} + -- this message is e2e encrypted with queue key, not with double ratchet + msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption = PQEncOff, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash} liftIO $ createSndMsg db connId msgData liftIO $ createSndMsgDelivery db connId sq internalId pure internalId -- encoded AgentMessage -> encoded EncAgentMessage -agentRatchetEncrypt :: DB.Connection -> ConnData -> ByteString -> (PQEncryption -> Int) -> Maybe PQEncryption -> ExceptT StoreError IO (ByteString, PQEncryption) -agentRatchetEncrypt db ConnData {connId, pqEncryption} msg getPaddedLen pqEnc_ = do +agentRatchetEncrypt :: DB.Connection -> ConnData -> ByteString -> (PQSupport -> Int) -> Maybe PQEncryption -> ExceptT StoreError IO (ByteString, PQEncryption) +agentRatchetEncrypt db ConnData {connId, pqSupport} msg getPaddedLen pqEnc_ = do rc <- ExceptT $ getRatchet db connId - let paddedLen = getPaddedLen pqEncryption + let paddedLen = getPaddedLen pqSupport (encMsg, rc') <- liftE (SEAgentError . cryptoError) $ CR.rcEncrypt rc paddedLen msg pqEnc_ liftIO $ updateRatchet db connId rc' CR.SMDNoChange pure (encMsg, CR.rcSndKEM rc') diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index a292e5db6..20a378a45 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -56,7 +56,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import Simplex.Messaging.Client import Simplex.Messaging.Client.Agent () import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (PQEncryption, VersionRangeE2E, supportedE2EEncryptVRange) +import Simplex.Messaging.Crypto.Ratchet (PQSupport, VersionRangeE2E, supportedE2EEncryptVRange) import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig) import Simplex.Messaging.Notifications.Transport (NTFVersion) import Simplex.Messaging.Notifications.Types @@ -116,8 +116,8 @@ data AgentConfig = AgentConfig caCertificateFile :: FilePath, privateKeyFile :: FilePath, certificateFile :: FilePath, - e2eEncryptVRange :: PQEncryption -> VersionRangeE2E, - smpAgentVRange :: PQEncryption -> VersionRangeSMPA, + e2eEncryptVRange :: PQSupport -> VersionRangeE2E, + smpAgentVRange :: PQSupport -> VersionRangeSMPA, smpClientVRange :: VersionRangeSMPC } diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index d3008e790..02aa5e260 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -192,7 +192,9 @@ import Simplex.Messaging.Crypto.Ratchet ( InitialKeys (..), PQEncryption (..), pattern PQEncOff, - pattern PQEncOn, + PQSupport, + pattern PQSupportOn, + pattern PQSupportOff, RcvE2ERatchetParams, RcvE2ERatchetParamsUri, SndE2ERatchetParams @@ -272,27 +274,27 @@ pqdrSMPAgentVersion = VersionSMPA 5 currentSMPAgentVersion :: VersionSMPA currentSMPAgentVersion = VersionSMPA 4 --- TODO v5.7 remove dependency of version range on whether PQ encryption is used -supportedSMPAgentVRange :: PQEncryption -> VersionRangeSMPA +-- TODO v5.7 remove dependency of version range on whether PQ support is needed +supportedSMPAgentVRange :: PQSupport -> VersionRangeSMPA supportedSMPAgentVRange pq = mkVersionRange duplexHandshakeSMPAgentVersion $ case pq of - PQEncOn -> pqdrSMPAgentVersion - PQEncOff -> currentSMPAgentVersion + PQSupportOn -> pqdrSMPAgentVersion + PQSupportOff -> currentSMPAgentVersion -- it is shorter to allow all handshake headers, -- including E2E (double-ratchet) parameters and -- signing key of the sender for the server -e2eEncConnInfoLength :: PQEncryption -> Int +e2eEncConnInfoLength :: PQSupport -> Int e2eEncConnInfoLength = \case -- reduced by 3700 (roughly the increase of message ratchet header size + key and ciphertext in reply link) - PQEncOn -> 11148 - PQEncOff -> 14848 + PQSupportOn -> 11148 + PQSupportOff -> 14848 -e2eEncUserMsgLength :: PQEncryption -> Int +e2eEncUserMsgLength :: PQSupport -> Int e2eEncUserMsgLength = \case -- reduced by 2200 (roughly the increase of message ratchet header size) - PQEncOn -> 13656 - PQEncOff -> 15856 + PQSupportOn -> 13656 + PQSupportOff -> 15856 -- | Raw (unparsed) SMP agent protocol transmission. type ARawTransmission = (ByteString, ByteString, ByteString) @@ -371,11 +373,11 @@ type ConnInfo = ByteString data ACommand (p :: AParty) (e :: AEntity) where NEW :: Bool -> AConnectionMode -> InitialKeys -> SubscriptionMode -> ACommand Client AEConn -- response INV INV :: AConnectionRequestUri -> ACommand Agent AEConn - JOIN :: Bool -> AConnectionRequestUri -> PQEncryption -> SubscriptionMode -> ConnInfo -> ACommand Client AEConn -- response OK + JOIN :: Bool -> AConnectionRequestUri -> PQSupport -> SubscriptionMode -> ConnInfo -> ACommand Client AEConn -- response OK CONF :: ConfirmationId -> [SMPServer] -> ConnInfo -> ACommand Agent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake LET :: ConfirmationId -> ConnInfo -> ACommand Client AEConn -- ConnInfo is from client REQ :: InvitationId -> NonEmpty SMPServer -> ConnInfo -> ACommand Agent AEConn -- ConnInfo is from sender - ACPT :: InvitationId -> PQEncryption -> ConnInfo -> ACommand Client AEConn -- ConnInfo is from client + ACPT :: InvitationId -> PQSupport -> ConnInfo -> ACommand Client AEConn -- ConnInfo is from client RJCT :: InvitationId -> ACommand Client AEConn INFO :: ConnInfo -> ACommand Agent AEConn CON :: PQEncryption -> ACommand Agent AEConn -- notification that connection is established @@ -1732,9 +1734,9 @@ commandP binaryP = ACmdTag SClient e cmd -> ACmd SClient e <$> case cmd of NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe)) - JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqEncP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) + JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP) - ACPT_ -> s (ACPT <$> A.takeTill (== ' ') <* A.space <*> pqEncP <*> binaryP) + ACPT_ -> s (ACPT <$> A.takeTill (== ' ') <* A.space <*> pqSupP <*> binaryP) RJCT_ -> s (RJCT <$> A.takeByteString) SUB_ -> pure SUB SEND_ -> s (SEND <$> pqEncP <*> smpP <* A.space <*> binaryP) @@ -1781,7 +1783,9 @@ commandP binaryP = s :: Parser a -> Parser a s p = A.space *> p pqIKP :: Parser InitialKeys - pqIKP = strP_ <|> pure (IKNoPQ PQEncOff) + pqIKP = strP_ <|> pure (IKNoPQ PQSupportOff) + pqSupP :: Parser PQSupport + pqSupP = strP_ <|> pure PQSupportOff pqEncP :: Parser PQEncryption pqEncP = strP_ <|> pure PQEncOff connections :: Parser [ConnId] diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 971b38905..ce76d5c89 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -30,7 +30,7 @@ import Data.Type.Equality import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.RetryInterval (RI2State) import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (RatchetX448, PQEncryption) +import Simplex.Messaging.Crypto.Ratchet (RatchetX448, PQEncryption, PQSupport) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol ( MsgBody, @@ -309,7 +309,7 @@ data ConnData = ConnData lastExternalSndId :: PrevExternalSndId, deleted :: Bool, ratchetSyncState :: RatchetSyncState, - pqEncryption :: PQEncryption + pqSupport :: PQSupport } deriving (Eq, Show) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index f04bc7904..33051d234 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -58,7 +58,7 @@ module Simplex.Messaging.Agent.Store.SQLite getConnData, setConnDeleted, setConnAgentVersion, - enableConnPQEncryption, + setConnPQSupport, getDeletedConnIds, getDeletedWaitingDeliveryConnIds, setConnRatchetSync, @@ -268,7 +268,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations (DownMigration (..), MTRE import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) -import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys) +import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys, PQEncryption (..), PQSupport (..)) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String @@ -576,14 +576,14 @@ createSndConn db gVar cData q@SndQueue {server} = insertSndQueue_ db connId q serverKeyHash_ createConnRecord :: DB.Connection -> ConnId -> ConnData -> SConnectionMode c -> IO () -createConnRecord db connId ConnData {userId, connAgentVersion, enableNtfs, pqEncryption} cMode = +createConnRecord db connId ConnData {userId, connAgentVersion, enableNtfs, pqSupport} cMode = DB.execute db [sql| INSERT INTO connections - (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, pq_encryption, duplex_handshake) VALUES (?,?,?,?,?,?,?) + (user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, pq_support, duplex_handshake) VALUES (?,?,?,?,?,?,?) |] - (userId, connId, cMode, connAgentVersion, enableNtfs, pqEncryption, True) + (userId, connId, cMode, connAgentVersion, enableNtfs, pqSupport, True) checkConfirmedSndQueueExists_ :: DB.Connection -> NewSndQueue -> IO Bool checkConfirmedSndQueueExists_ db SndQueue {server, sndId} = do @@ -1032,7 +1032,7 @@ getPendingQueueMsg db connId SndQueue {dbQueueId} = |] (connId, msgId) err = SEInternal $ "msg delivery " <> bshow msgId <> " returned []" - pendingMsgData :: (AgentMessageType, Maybe MsgFlags, MsgBody, CR.PQEncryption, InternalTs, Maybe Int64, Maybe Int64) -> PendingMsgData + pendingMsgData :: (AgentMessageType, Maybe MsgFlags, MsgBody, PQEncryption, InternalTs, Maybe Int64, Maybe Int64) -> PendingMsgData pendingMsgData (msgType, msgFlags_, msgBody, pqEncryption, internalTs, riSlow_, riFast_) = let msgFlags = fromMaybe SMP.noMsgFlags msgFlags_ msgRetryState = RI2State <$> riSlow_ <*> riFast_ @@ -1130,7 +1130,7 @@ getLastMsg db connId msgId = |] (connId, msgId) -toRcvMsg :: (Int64, InternalTs, BrokerId, BrokerTs) :. (AgentMsgId, MsgIntegrity, MsgHash, AgentMessageType, MsgBody, CR.PQEncryption, Maybe AgentMsgId, Maybe MsgReceiptStatus, Bool) -> RcvMsg +toRcvMsg :: (Int64, InternalTs, BrokerId, BrokerTs) :. (AgentMsgId, MsgIntegrity, MsgHash, AgentMessageType, MsgBody, PQEncryption, Maybe AgentMsgId, Maybe MsgReceiptStatus, Bool) -> RcvMsg toRcvMsg ((agentMsgId, internalTs, brokerId, brokerTs) :. (sndMsgId, integrity, internalHash, msgType, msgBody, pqEncryption, rcptInternalId_, rcptStatus_, userAck)) = let msgMeta = MsgMeta {recipient = (agentMsgId, internalTs), broker = (brokerId, brokerTs), sndMsgId, integrity, pqEncryption} msgReceipt = MsgReceipt <$> rcptInternalId_ <*> rcptStatus_ @@ -1776,9 +1776,13 @@ instance ToField (Version v) where toField (Version v) = toField v instance FromField (Version v) where fromField f = Version <$> fromField f -instance ToField CR.PQEncryption where toField (CR.PQEncryption pqEnc) = toField pqEnc +instance ToField PQEncryption where toField (PQEncryption pqEnc) = toField pqEnc -instance FromField CR.PQEncryption where fromField f = CR.PQEncryption <$> fromField f +instance FromField PQEncryption where fromField f = PQEncryption <$> fromField f + +instance ToField PQSupport where toField (PQSupport pqEnc) = toField pqEnc + +instance FromField PQSupport where fromField f = PQSupport <$> fromField f listToEither :: e -> [a] -> Either e a listToEither _ (x : _) = Right x @@ -1931,14 +1935,14 @@ getConnData db connId' = [sql| SELECT user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, - last_external_snd_msg_id, deleted, ratchet_sync_state, pq_encryption + last_external_snd_msg_id, deleted, ratchet_sync_state, pq_support FROM connections WHERE conn_id = ? |] (Only connId') where - cData (userId, connId, cMode, connAgentVersion, enableNtfs_, lastExternalSndId, deleted, ratchetSyncState, pqEncryption) = - (ConnData {userId, connId, connAgentVersion, enableNtfs = fromMaybe True enableNtfs_, lastExternalSndId, deleted, ratchetSyncState, pqEncryption}, cMode) + cData (userId, connId, cMode, connAgentVersion, enableNtfs_, lastExternalSndId, deleted, ratchetSyncState, pqSupport) = + (ConnData {userId, connId, connAgentVersion, enableNtfs = fromMaybe True enableNtfs_, lastExternalSndId, deleted, ratchetSyncState, pqSupport}, cMode) setConnDeleted :: DB.Connection -> Bool -> ConnId -> IO () setConnDeleted db waitDelivery connId @@ -1952,9 +1956,9 @@ setConnAgentVersion :: DB.Connection -> ConnId -> VersionSMPA -> IO () setConnAgentVersion db connId aVersion = DB.execute db "UPDATE connections SET smp_agent_version = ? WHERE conn_id = ?" (aVersion, connId) -enableConnPQEncryption :: DB.Connection -> ConnId -> IO () -enableConnPQEncryption db connId = - DB.execute db "UPDATE connections SET pq_encryption = ? WHERE conn_id = ?" (CR.PQEncOn, connId) +setConnPQSupport :: DB.Connection -> ConnId -> PQSupport -> IO () +setConnPQSupport db connId pqSupport = + DB.execute db "UPDATE connections SET pq_support = ? WHERE conn_id = ?" (pqSupport, connId) getDeletedConnIds :: DB.Connection -> IO [ConnId] getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connections WHERE deleted = ?" (Only True) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240225_ratchet_kem.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240225_ratchet_kem.hs index 07ba0f135..1e8a8db4d 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240225_ratchet_kem.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20240225_ratchet_kem.hs @@ -9,7 +9,7 @@ m20240225_ratchet_kem :: Query m20240225_ratchet_kem = [sql| ALTER TABLE ratchets ADD COLUMN pq_priv_kem BLOB; -ALTER TABLE connections ADD COLUMN pq_encryption INTEGER NOT NULL DEFAULT 0; +ALTER TABLE connections ADD COLUMN pq_support INTEGER NOT NULL DEFAULT 0; ALTER TABLE messages ADD COLUMN pq_encryption INTEGER NOT NULL DEFAULT 0; |] @@ -17,6 +17,6 @@ down_m20240225_ratchet_kem :: Query down_m20240225_ratchet_kem = [sql| ALTER TABLE ratchets DROP COLUMN pq_priv_kem; -ALTER TABLE connections DROP COLUMN pq_encryption; +ALTER TABLE connections DROP COLUMN pq_support; ALTER TABLE messages DROP COLUMN pq_encryption; |] diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index 850199cbb..0818be904 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -28,7 +28,7 @@ CREATE TABLE connections( REFERENCES users ON DELETE CASCADE, ratchet_sync_state TEXT NOT NULL DEFAULT 'ok', deleted_at_wait_delivery TEXT, - pq_encryption INTEGER NOT NULL DEFAULT 0 + pq_support INTEGER NOT NULL DEFAULT 0 ) WITHOUT ROWID; CREATE TABLE rcv_queues( host TEXT NOT NULL, diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs index b0292f9b5..38ada0f01 100644 --- a/src/Simplex/Messaging/Crypto/Ratchet.hs +++ b/src/Simplex/Messaging/Crypto/Ratchet.hs @@ -28,6 +28,9 @@ module Simplex.Messaging.Crypto.Ratchet PQEncryption (..), pattern PQEncOn, pattern PQEncOff, + PQSupport (..), + pattern PQSupportOn, + pattern PQSupportOff, AUseKEM (..), RatchetKEMState (..), SRatchetKEMState (..), @@ -53,6 +56,8 @@ module Simplex.Messaging.Crypto.Ratchet connPQEncryption, joinContactInitialKeys, replyKEM_, + pqSupportToEnc, + pqEncToSupport, pqX3dhSnd, pqX3dhRcv, initSndRatchet, @@ -143,11 +148,11 @@ currentE2EEncryptVersion :: VersionE2E currentE2EEncryptVersion = VersionE2E 2 -- TODO v5.7 remove dependency of version range on whether PQ encryption is used -supportedE2EEncryptVRange :: PQEncryption -> VersionRangeE2E +supportedE2EEncryptVRange :: PQSupport -> VersionRangeE2E supportedE2EEncryptVRange pq = mkVersionRange kdfX3DHE2EEncryptVersion $ case pq of - PQEncOn -> pqRatchetE2EEncryptVersion - PQEncOff -> currentE2EEncryptVersion + PQSupportOn -> pqRatchetE2EEncryptVersion + PQSupportOff -> currentE2EEncryptVersion data RatchetKEMState = RKSProposed -- only KEM encapsulation key @@ -385,14 +390,13 @@ generateE2EParams g v useKEM_ = do _ -> pure Nothing -- used by party initiating connection, Bob in double-ratchet spec -generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> PQEncryption -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams 'RKSProposed), E2ERatchetParams 'RKSProposed a) +generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> PQSupport -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams 'RKSProposed), E2ERatchetParams 'RKSProposed a) generateRcvE2EParams g v = generateE2EParams g v . proposeKEM_ where - proposeKEM_ :: PQEncryption -> Maybe (UseKEM 'RKSProposed) + proposeKEM_ :: PQSupport -> Maybe (UseKEM 'RKSProposed) proposeKEM_ = \case - PQEncOn -> Just ProposeKEM - PQEncOff -> Nothing - + PQSupportOn -> Just ProposeKEM + PQSupportOff -> Nothing -- used by party accepting connection, Alice in double-ratchet spec generateSndE2EParams :: forall a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe AUseKEM -> IO (PrivateKey a, PrivateKey a, Maybe APrivRKEMParams, AE2ERatchetParams a) @@ -466,7 +470,7 @@ data Ratchet a = Ratchet rcAD :: Str, rcDHRs :: PrivateKey a, rcKEM :: Maybe RatchetKEM, - rcSupportKEM :: PQEncryption, -- defines header size, can only be enabled once + rcSupportKEM :: PQSupport, -- defines header size, can only be enabled once rcEnableKEM :: PQEncryption, -- will enable KEM on the next ratchet step rcSndKEM :: PQEncryption, -- used KEM hybrid secret for sending ratchet rcRcvKEM :: PQEncryption, -- used KEM hybrid secret for receiving ratchet @@ -597,14 +601,14 @@ initSndRatchet :: initSndRatchet rcVersion rcDHRr rcDHRs (RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) = do -- state.RK, state.CKs, state.NHKs = KDF_RK_HE(SK, DH(state.DHRs, state.DHRr) || state.PQRss) let (rcRK, rcCKs, rcNHKs) = rootKdf ratchetKey rcDHRr rcDHRs (rcPQRss <$> kemAccepted) - pqEnc = PQEncryption $ isJust rcPQRs_ + pqOn = isJust rcPQRs_ in Ratchet { rcVersion, rcAD = assocData, rcDHRs, rcKEM = (`RatchetKEM` kemAccepted) <$> rcPQRs_, - rcSupportKEM = pqEnc, - rcEnableKEM = pqEnc, + rcSupportKEM = PQSupport pqOn, + rcEnableKEM = PQEncryption pqOn, rcSndKEM = PQEncryption $ isJust kemAccepted, rcRcvKEM = PQEncOff, rcRK, @@ -624,8 +628,8 @@ initSndRatchet rcVersion rcDHRr rcDHRs (RatchetInitParams {assocData, ratchetKey -- Please note that the public part of rcDHRs was sent to the sender -- as part of the connection request and random salt was received from the sender. initRcvRatchet :: - forall a. (AlgorithmI a, DhAlgorithm a) => RatchetVersions -> PrivateKey a -> (RatchetInitParams, Maybe KEMKeyPair) -> PQEncryption -> Ratchet a -initRcvRatchet rcVersion rcDHRs (RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) pqEnc = + forall a. (AlgorithmI a, DhAlgorithm a) => RatchetVersions -> PrivateKey a -> (RatchetInitParams, Maybe KEMKeyPair) -> PQSupport -> Ratchet a +initRcvRatchet rcVersion rcDHRs (RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) pqSupport = Ratchet { rcVersion, rcAD = assocData, @@ -636,8 +640,8 @@ initRcvRatchet rcVersion rcDHRs (RatchetInitParams {assocData, ratchetKey, sndHK -- state.PQRss = None -- state.PQRct = None rcKEM = (`RatchetKEM` kemAccepted) <$> rcPQRs_, - rcSupportKEM = pqEnc, - rcEnableKEM = pqEnc, + rcSupportKEM = pqSupport, + rcEnableKEM = pqSupportToEnc pqSupport, rcSndKEM = PQEncOff, rcRcvKEM = PQEncOff, rcRK = ratchetKey, @@ -666,14 +670,14 @@ data MsgHeader a = MsgHeader -- 69 = 2 (original size) + 2 + 1+56 (Curve448) + 4 + 4 -- TODO PQ this must be version-dependent -- TODO this is the exact size, some reserve should be added -paddedHeaderLen :: PQEncryption -> Int +paddedHeaderLen :: PQSupport -> Int paddedHeaderLen = \case - PQEncOn -> 2288 - PQEncOff -> 88 + PQSupportOn -> 2288 + PQSupportOff -> 88 -- only used in tests to validate correct padding -- (2 bytes - version size, 1 byte - header size, not to have it fixed or version-dependent) -fullHeaderLen :: PQEncryption -> Int +fullHeaderLen :: PQSupport -> Int fullHeaderLen pq = 2 + 1 + paddedHeaderLen pq + authTagSize + ivSize @AES256 -- pass the current version, as MsgHeader only includes the max supported version that can be different from the current @@ -759,12 +763,40 @@ instance FromJSON PQEncryption where parseJSON v = PQEncryption <$> parseJSON v omittedField = Just PQEncOff -replyKEM_ :: PQEncryption -> Maybe (RKEMParams 'RKSProposed) -> Maybe AUseKEM -replyKEM_ pqEnc kem_ = case pqEnc of - PQEncOn -> Just $ case kem_ of +newtype PQSupport = PQSupport {supportPQ :: Bool} + deriving (Eq, Show) + +pattern PQSupportOn :: PQSupport +pattern PQSupportOn = PQSupport True + +pattern PQSupportOff :: PQSupport +pattern PQSupportOff = PQSupport False + +{-# COMPLETE PQSupportOn, PQSupportOff #-} + +instance ToJSON PQSupport where + toEncoding (PQSupport pq) = toEncoding pq + toJSON (PQSupport pq) = toJSON pq + +instance FromJSON PQSupport where + parseJSON v = PQSupport <$> parseJSON v + omittedField = Just PQSupportOff + +pqSupportToEnc :: PQSupport -> PQEncryption +pqSupportToEnc (PQSupport pq) = PQEncryption pq + +pqEncToSupport :: PQEncryption -> PQSupport +pqEncToSupport (PQEncryption pq) = PQSupport pq + +supportOrEnc :: PQSupport -> PQEncryption -> PQSupport +supportOrEnc (PQSupport sup) (PQEncryption enc) = PQSupport $ sup || enc + +replyKEM_ :: Maybe (RKEMParams 'RKSProposed) -> PQSupport -> Maybe AUseKEM +replyKEM_ kem_ = \case + PQSupportOn -> Just $ case kem_ of Just (RKParamsProposed k) -> AUseKEM SRKSAccepted $ AcceptKEM k Nothing -> AUseKEM SRKSProposed ProposeKEM - PQEncOff -> Nothing + PQSupportOff -> Nothing instance StrEncoding PQEncryption where strEncode pqMode @@ -778,14 +810,20 @@ instance StrEncoding PQEncryption where where pq = pure . PQEncryption -data InitialKeys = IKUsePQ | IKNoPQ PQEncryption +instance StrEncoding PQSupport where + strEncode = strEncode . pqSupportToEnc + {-# INLINE strEncode #-} + strP = pqEncToSupport <$> strP + {-# INLINE strP #-} + +data InitialKeys = IKUsePQ | IKNoPQ PQSupport deriving (Eq, Show) pattern IKPQOn :: InitialKeys -pattern IKPQOn = IKNoPQ PQEncOn +pattern IKPQOn = IKNoPQ PQSupportOn pattern IKPQOff :: InitialKeys -pattern IKPQOff = IKNoPQ PQEncOff +pattern IKPQOff = IKNoPQ PQSupportOff instance StrEncoding InitialKeys where strEncode = \case @@ -794,22 +832,22 @@ instance StrEncoding InitialKeys where strP = IKNoPQ <$> strP <|> "pq=invitation" $> IKUsePQ -- determines whether PQ key should be included in invitation link -initialPQEncryption :: InitialKeys -> PQEncryption +initialPQEncryption :: InitialKeys -> PQSupport initialPQEncryption = \case - IKUsePQ -> PQEncOn - IKNoPQ _ -> PQEncOff -- default + IKUsePQ -> PQSupportOn + IKNoPQ _ -> PQSupportOff -- default -- determines whether PQ encryption should be used in connection -connPQEncryption :: InitialKeys -> PQEncryption +connPQEncryption :: InitialKeys -> PQSupport connPQEncryption = \case - IKUsePQ -> PQEncOn + IKUsePQ -> PQSupportOn IKNoPQ pq -> pq -- default for creating connection is IKNoPQ PQEncOn -- determines whether PQ key should be included in invitation link sent to contact address -joinContactInitialKeys :: PQEncryption -> InitialKeys +joinContactInitialKeys :: PQSupport -> InitialKeys joinContactInitialKeys = \case - PQEncOn -> IKUsePQ -- default - PQEncOff -> IKNoPQ PQEncOff + PQSupportOn -> IKUsePQ -- default + PQSupportOff -> IKNoPQ PQSupportOff rcEncrypt :: AlgorithmI a => Ratchet a -> Int -> ByteString -> Maybe PQEncryption -> ExceptT CryptoError IO (ByteString, Ratchet a) rcEncrypt Ratchet {rcSnd = Nothing} _ _ _ = throwE CERatchetState @@ -820,7 +858,7 @@ rcEncrypt rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, rcKEM, -- PQ encryption can be enabled or disabled rcEnableKEM' = fromMaybe rcEnableKEM pqEnc_ -- support for PQ encryption (and therefore large headers/small envelopes) can only be enabled, it cannot be disabled - rcSupportKEM' = PQEncryption $ enablePQ rcSupportKEM || enablePQ rcEnableKEM' + rcSupportKEM' = rcSupportKEM `supportOrEnc` rcEnableKEM' -- enc_header = HENCRYPT(state.HKs, header) (ehAuthTag, ehBody) <- encryptAEAD rcHKs ehIV (paddedHeaderLen rcSupportKEM') rcAD (msgHeader v) -- return enc_header, ENCRYPT(mk, plaintext, CONCAT(AD, enc_header)) @@ -949,13 +987,13 @@ rcDecrypt g rc@Ratchet {rcRcv, rcAD = Str rcAD, rcVersion} rcMKSkipped msg' = do (rcRK'', rcCKs', rcNHKs') = rootKdf rcRK' msgDHRs rcDHRs' kemSS' sndKEM = isJust kemSS' rcvKEM = isJust kemSS - enableKEM = sndKEM || rcvKEM || isJust rcKEM' + rcEnableKEM' = PQEncryption $ sndKEM || rcvKEM || isJust rcKEM' pure rc' { rcDHRs = rcDHRs', rcKEM = rcKEM', - rcSupportKEM = PQEncryption $ enablePQ rcSupportKEM || enableKEM, - rcEnableKEM = PQEncryption enableKEM, + rcSupportKEM = rcSupportKEM `supportOrEnc` rcEnableKEM', + rcEnableKEM = rcEnableKEM', rcSndKEM = PQEncryption sndKEM, rcRcvKEM = PQEncryption rcvKEM, rcRK = rcRK'', diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 6ff9db523..bb91725f8 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -29,7 +29,7 @@ import SMPAgentClient import SMPClient (testKeyHash, testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServerStoreLogOn) import Simplex.Messaging.Agent.Protocol hiding (MID) import qualified Simplex.Messaging.Agent.Protocol as A -import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), pattern IKPQOn, pattern IKPQOff, pattern PQEncOn, pattern PQEncOff) +import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOn, pattern IKPQOff, pattern PQEncOn, pattern PQSupportOn, pattern PQSupportOff) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (ErrorType (..)) @@ -173,7 +173,7 @@ type PQMatrix2 c = HasCallStack => TProxy c -> (HasCallStack => (c -> c -> IO ()) -> Expectation) -> - (HasCallStack => (c, InitialKeys) -> (c, PQEncryption) -> IO ()) -> + (HasCallStack => (c, InitialKeys) -> (c, PQSupport) -> IO ()) -> Spec pqMatrix2 :: PQMatrix2 c @@ -184,34 +184,34 @@ pqMatrix2NoInv = pqMatrix2_ False pqMatrix2_ :: Bool -> PQMatrix2 c pqMatrix2_ pqInv _ smpTest test = do - it "dh/dh handshake" $ smpTest $ \a b -> test (a, IKPQOff) (b, PQEncOff) - it "dh/pq handshake" $ smpTest $ \a b -> test (a, IKPQOff) (b, PQEncOn) - it "pq/dh handshake" $ smpTest $ \a b -> test (a, IKPQOn) (b, PQEncOff) - it "pq/pq handshake" $ smpTest $ \a b -> test (a, IKPQOn) (b, PQEncOn) + it "dh/dh handshake" $ smpTest $ \a b -> test (a, IKPQOff) (b, PQSupportOff) + it "dh/pq handshake" $ smpTest $ \a b -> test (a, IKPQOff) (b, PQSupportOn) + it "pq/dh handshake" $ smpTest $ \a b -> test (a, IKPQOn) (b, PQSupportOff) + it "pq/pq handshake" $ smpTest $ \a b -> test (a, IKPQOn) (b, PQSupportOn) when pqInv $ do - it "pq-inv/dh handshake" $ smpTest $ \a b -> test (a, IKUsePQ) (b, PQEncOff) - it "pq-inv/pq handshake" $ smpTest $ \a b -> test (a, IKUsePQ) (b, PQEncOn) + it "pq-inv/dh handshake" $ smpTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOff) + it "pq-inv/pq handshake" $ smpTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOn) pqMatrix3 :: HasCallStack => TProxy c -> (HasCallStack => (c -> c -> c -> IO ()) -> Expectation) -> - (HasCallStack => (c, InitialKeys) -> (c, PQEncryption) -> (c, PQEncryption) -> IO ()) -> + (HasCallStack => (c, InitialKeys) -> (c, PQSupport) -> (c, PQSupport) -> IO ()) -> Spec pqMatrix3 _ smpTest test = do - it "dh" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQEncOff) (c, PQEncOff) - it "dh/dh/pq" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQEncOff) (c, PQEncOn) - it "dh/pq/dh" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQEncOn) (c, PQEncOff) - it "dh/pq/pq" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQEncOn) (c, PQEncOn) - it "pq/dh/dh" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQEncOff) (c, PQEncOff) - it "pq/dh/pq" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQEncOff) (c, PQEncOn) - it "pq/pq/dh" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQEncOn) (c, PQEncOff) - it "pq" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQEncOn) (c, PQEncOn) + it "dh" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOff) + it "dh/dh/pq" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOn) + it "dh/pq/dh" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOn) (c, PQSupportOff) + it "dh/pq/pq" $ smpTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOn) (c, PQSupportOn) + it "pq/dh/dh" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOff) (c, PQSupportOff) + it "pq/dh/pq" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOff) (c, PQSupportOn) + it "pq/pq/dh" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOn) (c, PQSupportOff) + it "pq" $ smpTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOn) (c, PQSupportOn) testDuplexConnection :: (HasCallStack, Transport c) => TProxy c -> c -> c -> IO () -testDuplexConnection _ alice bob = testDuplexConnection' (alice, IKPQOn) (bob, PQEncOn) +testDuplexConnection _ alice bob = testDuplexConnection' (alice, IKPQOn) (bob, PQSupportOn) -testDuplexConnection' :: (HasCallStack, Transport c) => (c, InitialKeys) -> (c, PQEncryption) -> IO () +testDuplexConnection' :: (HasCallStack, Transport c) => (c, InitialKeys) -> (c, PQSupport) -> IO () testDuplexConnection' (alice, aPQ) (bob, bPQ) = do let pq = pqConnectionMode aPQ bPQ ("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW T INV" <> pqConnModeStr aPQ <> " subscribe") @@ -246,9 +246,9 @@ testDuplexConnection' (alice, aPQ) (bob, bPQ) = do alice #:# "nothing else should be delivered to alice" testDuplexConnRandomIds :: (HasCallStack, Transport c) => TProxy c -> c -> c -> IO () -testDuplexConnRandomIds _ alice bob = testDuplexConnRandomIds' (alice, IKPQOn) (bob, PQEncOn) +testDuplexConnRandomIds _ alice bob = testDuplexConnRandomIds' (alice, IKPQOn) (bob, PQSupportOn) -testDuplexConnRandomIds' :: (HasCallStack, Transport c) => (c, InitialKeys) -> (c, PQEncryption) -> IO () +testDuplexConnRandomIds' :: (HasCallStack, Transport c) => (c, InitialKeys) -> (c, PQSupport) -> IO () testDuplexConnRandomIds' (alice, aPQ) (bob, bPQ) = do let pq = pqConnectionMode aPQ bPQ ("1", bobConn, Right (INV cReq)) <- alice #: ("1", "", "NEW T INV" <> pqConnModeStr aPQ <> " subscribe") @@ -282,7 +282,7 @@ testDuplexConnRandomIds' (alice, aPQ) (bob, bPQ) = do alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK) alice #:# "nothing else should be delivered to alice" -testContactConnection :: Transport c => (c, InitialKeys) -> (c, PQEncryption) -> (c, PQEncryption) -> IO () +testContactConnection :: Transport c => (c, InitialKeys) -> (c, PQSupport) -> (c, PQSupport) -> IO () testContactConnection (alice, aPQ) (bob, bPQ) (tom, tPQ) = do ("1", "alice_contact", Right (INV cReq)) <- alice #: ("1", "alice_contact", "NEW T CON" <> pqConnModeStr aPQ <> " subscribe") let cReq' = strEncode cReq @@ -316,7 +316,7 @@ testContactConnection (alice, aPQ) (bob, bPQ) (tom, tPQ) = do tom <#= \case ("", "alice", Msg' 4 pq' "hi there") -> pq' == atPQ; _ -> False tom #: ("23", "alice", "ACK 4") #> ("23", "alice", OK) -testContactConnRandomIds :: Transport c => (c, InitialKeys) -> (c, PQEncryption) -> IO () +testContactConnRandomIds :: Transport c => (c, InitialKeys) -> (c, PQSupport) -> IO () testContactConnRandomIds (alice, aPQ) (bob, bPQ) = do let pq = pqConnectionMode aPQ bPQ ("1", aliceContact, Right (INV cReq)) <- alice #: ("1", "", "NEW T CON" <> pqConnModeStr aPQ <> " subscribe") @@ -380,7 +380,7 @@ testSubscrNotification t (server, _) client = do withSmpServer (ATransport t) $ client <# ("", "conn1", ERR (SMP AUTH)) -- this new server does not have the queue -testMsgDeliveryServerRestart :: forall c. Transport c => (c, InitialKeys) -> (c, PQEncryption) -> IO () +testMsgDeliveryServerRestart :: forall c. Transport c => (c, InitialKeys) -> (c, PQSupport) -> IO () testMsgDeliveryServerRestart (alice, aPQ) (bob, bPQ) = do let pq = pqConnectionMode aPQ bPQ withServer $ do @@ -547,9 +547,9 @@ testResumeDeliveryQuotaExceeded _ alice bob = do bob #: ("5", "alice", "ACK 9") #> ("5", "alice", OK) connect :: Transport c => (c, ByteString) -> (c, ByteString) -> IO () -connect (h1, name1) (h2, name2) = connect' (h1, name1, IKPQOn) (h2, name2, PQEncOn) +connect (h1, name1) (h2, name2) = connect' (h1, name1, IKPQOn) (h2, name2, PQSupportOn) -connect' :: forall c. Transport c => (c, ByteString, InitialKeys) -> (c, ByteString, PQEncryption) -> IO () +connect' :: forall c. Transport c => (c, ByteString, InitialKeys) -> (c, ByteString, PQSupport) -> IO () connect' (h1, name1, pqMode1) (h2, name2, pqMode2) = do ("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW T INV" <> pqConnModeStr pqMode1 <> " subscribe") let cReq' = strEncode cReq @@ -561,15 +561,15 @@ connect' (h1, name1, pqMode1) (h2, name2, pqMode2) = do h2 <# ("", name1, CON pq) h1 <# ("", name2, CON pq) -pqConnectionMode :: InitialKeys -> PQEncryption -> PQEncryption -pqConnectionMode pqMode1 pqMode2 = PQEncryption $ enablePQ (CR.connPQEncryption pqMode1) && enablePQ pqMode2 +pqConnectionMode :: InitialKeys -> PQSupport -> PQEncryption +pqConnectionMode pqMode1 pqMode2 = PQEncryption $ supportPQ (CR.connPQEncryption pqMode1) && supportPQ pqMode2 -enableKEMStr :: PQEncryption -> ByteString -enableKEMStr PQEncOn = " " <> strEncode PQEncOn +enableKEMStr :: PQSupport -> ByteString +enableKEMStr PQSupportOn = " " <> strEncode PQSupportOn enableKEMStr _ = "" pqConnModeStr :: InitialKeys -> ByteString -pqConnModeStr (IKNoPQ PQEncOff) = "" +pqConnModeStr (IKNoPQ PQSupportOff) = "" pqConnModeStr pq = " " <> strEncode pq sendMessage :: Transport c => (c, ConnId) -> (c, ConnId) -> ByteString -> IO () diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 8228ae4cd..f5e689e96 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -81,7 +81,7 @@ testE2ERatchetParams :: RcvE2ERatchetParamsUri 'C.X448 testE2ERatchetParams = E2ERatchetParamsUri (mkVersionRange (VersionE2E 1) (VersionE2E 1)) testDhPubKey testDhPubKey Nothing testE2ERatchetParams12 :: RcvE2ERatchetParamsUri 'C.X448 -testE2ERatchetParams12 = E2ERatchetParamsUri (supportedE2EEncryptVRange PQEncOn) testDhPubKey testDhPubKey Nothing +testE2ERatchetParams12 = E2ERatchetParamsUri (supportedE2EEncryptVRange PQSupportOn) testDhPubKey testDhPubKey Nothing connectionRequest :: AConnectionRequestUri connectionRequest = @@ -95,7 +95,7 @@ connectionRequestCurrentRange :: AConnectionRequestUri connectionRequestCurrentRange = ACR SCMInvitation $ CRInvitationUri - connReqData {crAgentVRange = supportedSMPAgentVRange PQEncOn, crSmpQueues = [queueV1, queueV1]} + connReqData {crAgentVRange = supportedSMPAgentVRange PQSupportOn, crSmpQueues = [queueV1, queueV1]} testE2ERatchetParams12 connectionRequestClientDataEmpty :: AConnectionRequestUri diff --git a/tests/AgentTests/DoubleRatchetTests.hs b/tests/AgentTests/DoubleRatchetTests.hs index 5c5241849..5b73be893 100644 --- a/tests/AgentTests/DoubleRatchetTests.hs +++ b/tests/AgentTests/DoubleRatchetTests.hs @@ -94,8 +94,8 @@ fullMsgLen Ratchet {rcSupportKEM} = headerLenLength + fullHeaderLen rcSupportKEM where -- v = current rcVersion headerLenLength = case rcSupportKEM of - PQEncOn -> 3 -- two bytes are added because of two Large used in new encoding - PQEncOff -> 1 + PQSupportOn -> 3 -- two bytes are added because of two Large used in new encoding + PQSupportOff -> 1 -- TODO PQ below should work too -- | v >= pqRatchetE2EEncryptVersion = 3 -- | otherwise = 1 @@ -371,6 +371,7 @@ testDecodeV2RatchetJSON :: IO () testDecodeV2RatchetJSON = do let v2RatchetJSON = "{\"rcVersion\":[2,2],\"rcAD\":\"2GEJrq48TmQse6NR16I-hrI0tSySZQ57E_g46nDceAPRAiF6j0drq26RTE7be6X7uiB4RaGJGf4QRXzcYuVtWw==\",\"rcDHRs\":\"TUM0Q0FRQXdCUVlESzJWdUJDSUVJRkNYbUxtSHQ3SUNfeHpGTi1Qb3ZqTVQ3S2p6XzZlZlBjOG9fRFY2RWxKOQ==\",\"rcRK\":\"BOX2X7YW5qDSp2XknY_lqacSrtDqQNPvS6iJlZIs3G0=\",\"rcNs\":0,\"rcNr\":0,\"rcPN\":0,\"rcNHKs\":\"IMouSkXUvzT_mo0WM-pqEUK09-HTLk9WOTCFQglyQxU=\",\"rcNHKr\":\"g-tus1clYPV0rGlzkf5a959tUqDYQVZ1FpcPeXdKwxI=\"}" Right (r :: Ratchet X25519) <- pure $ J.eitherDecodeStrict' v2RatchetJSON + rcSupportKEM r `shouldBe` PQSupportOff rcEnableKEM r `shouldBe` PQEncOff rcSndKEM r `shouldBe` PQEncOff rcRcvKEM r `shouldBe` PQEncOff @@ -386,7 +387,7 @@ testX3dh _ = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion (pkBob1, pkBob2, Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v Nothing - (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQEncOff + (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff let paramsBob = pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob paramsAlice `shouldBe` paramsBob @@ -395,7 +396,7 @@ testX3dhV1 :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO () testX3dhV1 _ = do g <- C.newRandom (pkBob1, pkBob2, Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g (VersionE2E 1) Nothing - (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g (VersionE2E 1) PQEncOff + (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g (VersionE2E 1) PQSupportOff let paramsBob = pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob paramsAlice `shouldBe` paramsBob @@ -405,7 +406,7 @@ testPqX3dhProposeInReply _ = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion -- initiate (no KEM) - (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQEncOff + (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff -- propose KEM in reply (pkBob1, pkBob2, pKemBob_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSProposed ProposeKEM) Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemBob_ e2eAlice @@ -417,7 +418,7 @@ testPqX3dhProposeAccept _ = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion -- initiate (propose KEM) - (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQEncOn + (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn E2ERatchetParams _ _ _ (Just (RKParamsProposed aliceKem)) <- pure e2eAlice -- accept KEM (pkBob1, pkBob2, pKemBob_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM aliceKem) @@ -430,7 +431,7 @@ testPqX3dhProposeReject _ = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion -- initiate (propose KEM) - (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQEncOn + (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn E2ERatchetParams _ _ _ (Just (RKParamsProposed _)) <- pure e2eAlice -- reject KEM (pkBob1, pkBob2, Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v Nothing @@ -443,7 +444,7 @@ testPqX3dhAcceptWithoutProposalError _ = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion -- initiate (no KEM) - (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQEncOff + (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff E2ERatchetParams _ _ _ Nothing <- pure e2eAlice -- incorrectly accept KEM -- we don't have key in proposal, so we just generate it @@ -457,7 +458,7 @@ testPqX3dhProposeAgain _ = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion -- initiate (propose KEM) - (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQEncOn + (pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn E2ERatchetParams _ _ _ (Just (RKParamsProposed _)) <- pure e2eAlice -- propose KEM again in reply - this is not an error (pkBob1, pkBob2, pKemBob_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSProposed ProposeKEM) @@ -520,13 +521,13 @@ initRatchets = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion (pkBob1, pkBob2, _pKemParams@Nothing, AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v Nothing - (pkAlice1, pkAlice2, _pKem@Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams g v PQEncOff + (pkAlice1, pkAlice2, _pKem@Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob (_, pkBob3) <- atomically $ C.generateKeyPair g - let vs = testRatchetVersions PQEncOff + let vs = testRatchetVersions PQSupportOff bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob - alice = initRcvRatchet vs pkAlice2 paramsAlice PQEncOff + alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOff pure (alice, bob, encrypt' noSndKEM, decrypt' noRcvKEM, (\#>)) initRatchetsKEMProposed :: forall a. (AlgorithmI a, DhAlgorithm a) => IO (Ratchet a, Ratchet a, Encrypt a, Decrypt a, EncryptDecryptSpec a) @@ -534,16 +535,16 @@ initRatchetsKEMProposed = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion -- initiate (no KEM) - (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams g v PQEncOff + (pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff -- propose KEM in reply let useKem = AUseKEM SRKSProposed ProposeKEM (pkBob1, pkBob2, pKemParams_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem) Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob (_, pkBob3) <- atomically $ C.generateKeyPair g - let vs = testRatchetVersions PQEncOn + let vs = testRatchetVersions PQSupportOn bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob - alice = initRcvRatchet vs pkAlice2 paramsAlice PQEncOn + alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn pure (alice, bob, encrypt' hasSndKEM, decrypt' hasRcvKEM, (!#>)) initRatchetsKEMAccepted :: forall a. (AlgorithmI a, DhAlgorithm a) => IO (Ratchet a, Ratchet a, Encrypt a, Decrypt a, EncryptDecryptSpec a) @@ -551,7 +552,7 @@ initRatchetsKEMAccepted = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion -- initiate (propose) - (pkAlice1, pkAlice2, pKem_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQEncOn + (pkAlice1, pkAlice2, pKem_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn E2ERatchetParams _ _ _ (Just (RKParamsProposed aliceKem)) <- pure e2eAlice -- accept let useKem = AUseKEM SRKSAccepted (AcceptKEM aliceKem) @@ -559,9 +560,9 @@ initRatchetsKEMAccepted = do Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKem_ e2eBob (_, pkBob3) <- atomically $ C.generateKeyPair g - let vs = testRatchetVersions PQEncOn + let vs = testRatchetVersions PQSupportOn bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob - alice = initRcvRatchet vs pkAlice2 paramsAlice PQEncOn + alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn pure (alice, bob, encrypt' hasSndKEM, decrypt' hasRcvKEM, (!#>)) initRatchetsKEMProposedAgain :: forall a. (AlgorithmI a, DhAlgorithm a) => IO (Ratchet a, Ratchet a, Encrypt a, Decrypt a, EncryptDecryptSpec a) @@ -569,19 +570,19 @@ initRatchetsKEMProposedAgain = do g <- C.newRandom let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion -- initiate (propose KEM) - (pkAlice1, pkAlice2, pKem_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQEncOn + (pkAlice1, pkAlice2, pKem_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn -- propose KEM again in reply let useKem = AUseKEM SRKSProposed ProposeKEM (pkBob1, pkBob2, pKemParams_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem) Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKem_ e2eBob (_, pkBob3) <- atomically $ C.generateKeyPair g - let vs = testRatchetVersions PQEncOn + let vs = testRatchetVersions PQSupportOn bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob - alice = initRcvRatchet vs pkAlice2 paramsAlice PQEncOn + alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn pure (alice, bob, encrypt' hasSndKEM, decrypt' hasRcvKEM, (!#>)) -testRatchetVersions :: PQEncryption -> RatchetVersions +testRatchetVersions :: PQSupport -> RatchetVersions testRatchetVersions pq = let v = maxVersion $ supportedE2EEncryptVRange pq in RVersions v v diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index bc328bbad..706f3994f 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -72,7 +72,7 @@ import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteS import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction') import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), TransportSessionMode (TSMEntity, TSMUser), defaultSMPClientConfig) import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), pattern PQEncOn, pattern PQEncOff) +import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern PQEncOn, pattern PQEncOff, pattern PQSupportOn, pattern PQSupportOff) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Transport (NTFVersion, pattern VersionNTF, authBatchCmdsNTFVersion) @@ -173,9 +173,9 @@ agentCfgVPrev :: AgentConfig agentCfgVPrev = agentCfg { sndAuthAlg = C.AuthAlg C.SEd25519, - smpAgentVRange = \_ -> prevRange $ smpAgentVRange agentCfg PQEncOff, + smpAgentVRange = \_ -> prevRange $ smpAgentVRange agentCfg PQSupportOff, smpClientVRange = prevRange $ smpClientVRange agentCfg, - e2eEncryptVRange = \_ -> prevRange $ e2eEncryptVRange agentCfg PQEncOff, + e2eEncryptVRange = \_ -> prevRange $ e2eEncryptVRange agentCfg PQSupportOff, smpCfg = smpCfgVPrev } @@ -188,7 +188,7 @@ agentCfgV7 = } agentCfgRatchetVPrev :: AgentConfig -agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = \_ -> prevRange $ e2eEncryptVRange agentCfg PQEncOff} +agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = \_ -> prevRange $ e2eEncryptVRange agentCfg PQSupportOff} prevRange :: VersionRange v -> VersionRange v prevRange vr = vr {maxVersion = max (minVersion vr) (prevVersion $ maxVersion vr)} @@ -224,10 +224,10 @@ inAnyOrder g rs = do expected r rp = rp r createConnection :: AgentErrorMonad m => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> m (ConnId, ConnectionRequestUri c) -createConnection c userId enableNtfs cMode clientData = A.createConnection c userId enableNtfs cMode clientData (IKNoPQ PQEncOn) +createConnection c userId enableNtfs cMode clientData = A.createConnection c userId enableNtfs cMode clientData (IKNoPQ PQSupportOn) joinConnection :: AgentErrorMonad m => AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> m ConnId -joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId enableNtfs cReq connInfo PQEncOn +joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId enableNtfs cReq connInfo PQSupportOn sendMessage :: AgentErrorMonad m => AgentClient -> ConnId -> SMP.MsgFlags -> MsgBody -> m AgentMsgId sendMessage c connId msgFlags msgBody = do @@ -427,24 +427,24 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) = in allowNew && (isNothing srvAuth || (srvVersion >= v && clntVersion >= v && srvAuth == clntAuth)) -- TODO PQ test next version with PQ -testMatrix2 :: ATransport -> (PQEncryption -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec +testMatrix2 :: ATransport -> (PQSupport -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testMatrix2 t runTest = do - it "v7" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 $ runTest PQEncOn - it "v7 to current" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfg 3 $ runTest PQEncOn - it "current to v7" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfgV7 3 $ runTest PQEncOn - it "current with v7 server" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQEncOn - it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQEncOn - it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQEncOff - it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQEncOff - it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQEncOff + it "v7" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 $ runTest PQSupportOn + it "v7 to current" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfg 3 $ runTest PQSupportOn + it "current to v7" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfgV7 3 $ runTest PQSupportOn + it "current with v7 server" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQSupportOn + it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQSupportOn + it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff + it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff + it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff -- TODO PQ test next version with PQ -testRatchetMatrix2 :: ATransport -> (PQEncryption -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec +testRatchetMatrix2 :: ATransport -> (PQSupport -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testRatchetMatrix2 t runTest = do - it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQEncOn - it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 3 $ runTest PQEncOff - it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 3 $ runTest PQEncOff - it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 3 $ runTest PQEncOff + it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 3 $ runTest PQSupportOn + it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 3 $ runTest PQSupportOff + it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 3 $ runTest PQSupportOff + it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 3 $ runTest PQSupportOff testServerMatrix2 :: ATransport -> (InitialAgentServers -> IO ()) -> Spec testServerMatrix2 t runTest = do @@ -466,13 +466,14 @@ withAgentClientsCfg2 aCfg bCfg runTest = do withAgentClients2 :: (AgentClient -> AgentClient -> IO ()) -> IO () withAgentClients2 = withAgentClientsCfg2 agentCfg agentCfg -runAgentClientTest :: HasCallStack => PQEncryption -> AgentClient -> AgentClient -> AgentMsgId -> IO () -runAgentClientTest pqEnc alice@AgentClient {} bob baseId = +runAgentClientTest :: HasCallStack => PQSupport -> AgentClient -> AgentClient -> AgentMsgId -> IO () +runAgentClientTest pqSupport alice@AgentClient {} bob baseId = runRight_ $ do - (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (IKNoPQ pqEnc) SMSubscribe - aliceId <- A.joinConnection bob 1 True qInfo "bob's connInfo" pqEnc SMSubscribe + (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (IKNoPQ pqSupport) SMSubscribe + aliceId <- A.joinConnection bob 1 True qInfo "bob's connInfo" pqSupport SMSubscribe ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" + let pqEnc = CR.pqSupportToEnc pqSupport get alice ##> ("", bobId, A.CON pqEnc) get bob ##> ("", aliceId, INFO "alice's connInfo") get bob ##> ("", aliceId, A.CON pqEnc) @@ -527,15 +528,16 @@ testAgentClient3 = do get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False ackMessage c aIdForC 5 Nothing -runAgentClientContactTest :: HasCallStack => PQEncryption -> AgentClient -> AgentClient -> AgentMsgId -> IO () -runAgentClientContactTest pqEnc alice bob baseId = +runAgentClientContactTest :: HasCallStack => PQSupport -> AgentClient -> AgentClient -> AgentMsgId -> IO () +runAgentClientContactTest pqSupport alice bob baseId = runRight_ $ do - (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing (IKNoPQ pqEnc) SMSubscribe - aliceId <- A.joinConnection bob 1 True qInfo "bob's connInfo" pqEnc SMSubscribe + (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing (IKNoPQ pqSupport) SMSubscribe + aliceId <- A.joinConnection bob 1 True qInfo "bob's connInfo" pqSupport SMSubscribe ("", _, REQ invId _ "bob's connInfo") <- get alice - bobId <- acceptContact alice True invId "alice's connInfo" PQEncOn SMSubscribe + bobId <- acceptContact alice True invId "alice's connInfo" PQSupportOn SMSubscribe ("", _, CONF confId _ "alice's connInfo") <- get bob allowConnection bob aliceId confId "bob's connInfo" + let pqEnc = CR.pqSupportToEnc pqSupport get alice ##> ("", bobId, INFO "bob's connInfo") get alice ##> ("", bobId, A.CON pqEnc) get bob ##> ("", aliceId, A.CON pqEnc) @@ -690,7 +692,7 @@ testIncreaseConnAgentVersion t = do bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 2} initAgentServers testDB2 withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aliceId, bobId) <- runRight $ do - (aliceId, bobId) <- makeConnection_ PQEncOff alice bob + (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob exchangeGreetingsMsgId_ PQEncOff 4 alice bobId bob aliceId checkVersion alice bobId 2 checkVersion bob aliceId 2 @@ -751,7 +753,7 @@ testIncreaseConnAgentVersionMaxCompatible t = do bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 2} initAgentServers testDB2 withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aliceId, bobId) <- runRight $ do - (aliceId, bobId) <- makeConnection_ PQEncOff alice bob + (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob exchangeGreetingsMsgId_ PQEncOff 4 alice bobId bob aliceId checkVersion alice bobId 2 checkVersion bob aliceId 2 @@ -779,7 +781,7 @@ testIncreaseConnAgentVersionStartDifferentVersion t = do bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB2 withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aliceId, bobId) <- runRight $ do - (aliceId, bobId) <- makeConnection_ PQEncOff alice bob + (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob exchangeGreetingsMsgId_ PQEncOff 4 alice bobId bob aliceId checkVersion alice bobId 2 checkVersion bob aliceId 2 @@ -1029,7 +1031,7 @@ testRatchetSync t = withAgentClients2 $ \alice bob -> withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aliceId, bobId, bob2) <- setupDesynchronizedRatchet alice bob runRight $ do - ConnectionStats {ratchetSyncState} <- synchronizeRatchet bob2 aliceId PQEncOn False + ConnectionStats {ratchetSyncState} <- synchronizeRatchet bob2 aliceId PQSupportOn False liftIO $ ratchetSyncState `shouldBe` RSStarted get alice =##> ratchetSyncP bobId RSAgreed get bob2 =##> ratchetSyncP aliceId RSAgreed @@ -1073,7 +1075,7 @@ setupDesynchronizedRatchet alice bob = do runRight_ $ do subscribeConnection bob2 aliceId - Left A.CMD {cmdErr = PROHIBITED} <- runExceptT $ synchronizeRatchet bob2 aliceId PQEncOn False + Left A.CMD {cmdErr = PROHIBITED} <- runExceptT $ synchronizeRatchet bob2 aliceId PQSupportOn False 8 <- sendMessage alice bobId SMP.noMsgFlags "hello 5" get alice ##> ("", bobId, SENT 8) @@ -1104,7 +1106,7 @@ testRatchetSyncServerOffline t = withAgentClients2 $ \alice bob -> do ("", "", DOWN _ _) <- nGet alice ("", "", DOWN _ _) <- nGet bob2 - ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQEncOn False + ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False liftIO $ ratchetSyncState `shouldBe` RSStarted withSmpServerStoreMsgLogOn t testPort $ \_ -> do @@ -1134,7 +1136,7 @@ testRatchetSyncClientRestart t = do setupDesynchronizedRatchet alice bob ("", "", DOWN _ _) <- nGet alice ("", "", DOWN _ _) <- nGet bob2 - ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQEncOn False + ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False liftIO $ ratchetSyncState `shouldBe` RSStarted disconnectAgentClient bob2 bob3 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB2 @@ -1161,7 +1163,7 @@ testRatchetSyncSuspendForeground t = do ("", "", DOWN _ _) <- nGet alice ("", "", DOWN _ _) <- nGet bob2 - ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQEncOn False + ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False liftIO $ ratchetSyncState `shouldBe` RSStarted suspendAgent bob2 0 @@ -1195,10 +1197,10 @@ testRatchetSyncSimultaneous t = do ("", "", DOWN _ _) <- nGet alice ("", "", DOWN _ _) <- nGet bob2 - ConnectionStats {ratchetSyncState = bRSS} <- runRight $ synchronizeRatchet bob2 aliceId PQEncOn False + ConnectionStats {ratchetSyncState = bRSS} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False liftIO $ bRSS `shouldBe` RSStarted - ConnectionStats {ratchetSyncState = aRSS} <- runRight $ synchronizeRatchet alice bobId PQEncOn True + ConnectionStats {ratchetSyncState = aRSS} <- runRight $ synchronizeRatchet alice bobId PQSupportOn True liftIO $ aRSS `shouldBe` RSStarted withSmpServerStoreMsgLogOn t testPort $ \_ -> do @@ -1253,20 +1255,21 @@ testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do pure r makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId) -makeConnection = makeConnection_ PQEncOn +makeConnection = makeConnection_ PQSupportOn -makeConnection_ :: PQEncryption -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId) +makeConnection_ :: PQSupport -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId) makeConnection_ pqEnc alice bob = makeConnectionForUsers_ pqEnc alice 1 bob 1 makeConnectionForUsers :: AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) -makeConnectionForUsers = makeConnectionForUsers_ PQEncOn +makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn -makeConnectionForUsers_ :: PQEncryption -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) -makeConnectionForUsers_ pqEnc alice aliceUserId bob bobUserId = do - (bobId, qInfo) <- A.createConnection alice aliceUserId True SCMInvitation Nothing (CR.IKNoPQ pqEnc) SMSubscribe - aliceId <- A.joinConnection bob bobUserId True qInfo "bob's connInfo" pqEnc SMSubscribe +makeConnectionForUsers_ :: PQSupport -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) +makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do + (bobId, qInfo) <- A.createConnection alice aliceUserId True SCMInvitation Nothing (CR.IKNoPQ pqSupport) SMSubscribe + aliceId <- A.joinConnection bob bobUserId True qInfo "bob's connInfo" pqSupport SMSubscribe ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" + let pqEnc = CR.pqSupportToEnc pqSupport get alice ##> ("", bobId, A.CON pqEnc) get bob ##> ("", aliceId, INFO "alice's connInfo") get bob ##> ("", aliceId, A.CON pqEnc) @@ -1392,7 +1395,7 @@ testBatchedSubscriptions nCreate nDel t = do a <- getSMPAgentClient' 1 agentCfg initAgentServers2 testDB b <- getSMPAgentClient' 2 agentCfg initAgentServers2 testDB2 conns <- runServers $ do - conns <- replicateM (nCreate :: Int) $ makeConnection_ PQEncOff a b + conns <- replicateM (nCreate :: Int) $ makeConnection_ PQSupportOff a b forM_ conns $ \(aId, bId) -> exchangeGreetings_ PQEncOff a bId b aId let (aIds', bIds') = unzip $ take nDel conns delete a bIds' @@ -1456,10 +1459,10 @@ testBatchedSubscriptions nCreate nDel t = do testAsyncCommands :: IO () testAsyncCommands = withAgentClients2 $ \alice bob -> runRight_ $ do - bobId <- createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQEncOn) SMSubscribe + bobId <- createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe ("1", bobId', INV (ACR _ qInfo)) <- get alice liftIO $ bobId' `shouldBe` bobId - aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQEncOn SMSubscribe + aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe ("2", aliceId', OK) <- get bob liftIO $ aliceId' `shouldBe` aliceId ("", _, CONF confId _ "bob's connInfo") <- get alice @@ -1506,7 +1509,7 @@ testAsyncCommands = testAsyncCommandsRestore :: ATransport -> IO () testAsyncCommandsRestore t = do alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB - bobId <- runRight $ createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQEncOn) SMSubscribe + bobId <- runRight $ createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe liftIO $ noMessages alice "alice doesn't receive INV because server is down" disconnectAgentClient alice alice' <- liftIO $ getSMPAgentClient' 2 agentCfg initAgentServers testDB @@ -1523,7 +1526,7 @@ testAcceptContactAsync = (_, qInfo) <- createConnection alice 1 True SCMContact Nothing SMSubscribe aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe ("", _, REQ invId _ "bob's connInfo") <- get alice - bobId <- acceptContactAsync alice "1" True invId "alice's connInfo" PQEncOn SMSubscribe + bobId <- acceptContactAsync alice "1" True invId "alice's connInfo" PQSupportOn SMSubscribe get alice =##> \case ("1", c, OK) -> c == bobId; _ -> False ("", _, CONF confId _ "alice's connInfo") <- get bob allowConnection bob aliceId confId "bob's connInfo" @@ -1809,10 +1812,10 @@ testJoinConnectionAsyncReplyError t = do a <- getSMPAgentClient' 1 agentCfg initAgentServers testDB b <- getSMPAgentClient' 2 agentCfg initAgentServersSrv2 testDB2 (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do - bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQEncOn) SMSubscribe + bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId - aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQEncOn SMSubscribe + aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) @@ -2353,7 +2356,7 @@ testDeliveryReceiptsVersion t = do b <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = \_ -> mkVersionRange 1 3} initAgentServers testDB2 withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aId, bId) <- runRight $ do - (aId, bId) <- makeConnection_ PQEncOff a b + (aId, bId) <- makeConnection_ PQSupportOff a b checkVersion a bId 3 checkVersion b aId 3 (4, _) <- A.sendMessage a bId PQEncOff SMP.noMsgFlags "hello" @@ -2392,7 +2395,7 @@ testDeliveryReceiptsVersion t = do get b' =##> \case ("", c, Rcvd 10) -> c == aId; _ -> False ackMessage b' aId 11 Nothing -- TODO PQ this part hangs when waiting for Rcvd, because connection tries to upgrade to PQ encryption. - -- replacing 2 PQEncOn with PQEncOff above prevents hanging. + -- replacing 2 PQSupportOn with PQEncOff above prevents hanging. -- (12, _) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello 2" -- get a' ##> ("", bId, SENT 12) -- get b' =##> \case ("", c, Msg' 12 PQEncOff "hello 2") -> c == aId; _ -> False diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index af91dac42..4bac4fb83 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -45,7 +45,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction') import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), pattern PQEncOn) +import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Crypto.File (CryptoFile (..)) import Simplex.Messaging.Encoding.String (StrEncoding (..)) @@ -190,7 +190,7 @@ cData1 = lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, - pqEncryption = CR.PQEncOn + pqSupport = CR.PQSupportOn } testPrivateAuthKey :: C.APrivateAuthKey @@ -662,7 +662,7 @@ testGetPendingServerCommand st = do Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db (Just smpServer1) corrId' `shouldBe` "4" where - command = AClientCommand $ APC SAEConn $ NEW True (ACM SCMInvitation) (IKNoPQ PQEncOn) SMSubscribe + command = AClientCommand $ APC SAEConn $ NEW True (ACM SCMInvitation) (IKNoPQ PQSupportOn) SMSubscribe corruptCmd :: DB.Connection -> ByteString -> ConnId -> IO () corruptCmd db corrId connId = DB.execute db "UPDATE commands SET command = cast('bad' as blob) WHERE conn_id = ? AND corr_id = ?" (connId, corrId)