diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 69ca55b87..53e24c3a8 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -974,7 +974,8 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s SCMContact -> pure $ CRContactUri crData SCMInvitation -> do g <- asks random - (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) (CR.initialPQEncryption pqInitKeys) + let pqEnc = CR.initialPQEncryption (isJust userData_) pqInitKeys + (pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange prepareLinkData :: ConnInfo -> C.PublicKeyX25519 -> AM (C.CbNonce, SMPQueueUri, ConnectionRequestUri c, ClntQueueReqData) @@ -1002,11 +1003,13 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c) connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of Just ShortLinkCreds {shortLinkId, shortLinkKey} - | qUri == qUri' -> - let link = case cReq of - CRContactUri _ -> CSLContact SLSServer CCTContact srv shortLinkKey - CRInvitationUri {} -> CSLInvitation SLSServer srv shortLinkId shortLinkKey - in pure $ CCLink cReq (Just link) + | qUri == qUri' -> pure $ case cReq of + CRContactUri _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey + CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) -> + let cReq' = case pqInitKeys of + CR.IKPQOn -> CRInvitationUri crData $ CR.E2ERatchetParamsUri vr k1 k2 Nothing -- remove PQ keys + _ -> cReq -- either PQ is disabled, or disabled for initial request because there is no short link + in CCLink cReq' $ Just $ CSLInvitation SLSServer srv shortLinkId shortLinkKey | otherwise -> throwE $ INTERNAL "different rcv queue address" Nothing -> let updated (ConnReqUriData _ vr _ _) = (ConnReqUriData SSSimplex vr [qUri'] clientData) @@ -1138,8 +1141,9 @@ joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMod >>= (mapM_ (delInvSL c connId srv) lnkId_ $>) joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case - Just (qInfo, vrsn) -> do - (CCLink cReq _, service) <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing Nothing (CR.IKNoPQ pqSup) subMode srv + Just (qInfo, vrsn@(Compatible v)) -> do + let pqInitKeys = CR.joinContactInitialKeys (v >= pqdrSMPAgentVersion) pqSup + (CCLink cReq _, service) <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing Nothing pqInitKeys subMode srv void $ sendInvitation c userId connId qInfo vrsn cReq cInfo pure (False, service) Nothing -> throwE $ AGENT A_VERSION diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 8a29a9299..c26d88cec 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1919,7 +1919,7 @@ commandP binaryP = s :: Parser a -> Parser a s p = A.space *> p pqIKP :: Parser InitialKeys - pqIKP = strP_ <|> pure (IKNoPQ PQSupportOff) + pqIKP = strP_ <|> pure (IKLinkPQ PQSupportOff) pqSupP :: Parser PQSupport pqSupP = strP_ <|> pure PQSupportOff diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs index 576e78c03..e3daadfd9 100644 --- a/src/Simplex/Messaging/Crypto/Ratchet.hs +++ b/src/Simplex/Messaging/Crypto/Ratchet.hs @@ -57,6 +57,7 @@ module Simplex.Messaging.Crypto.Ratchet generateSndE2EParams, initialPQEncryption, connPQEncryption, + joinContactInitialKeys, replyKEM_, pqSupportToEnc, pqEncToSupport, @@ -308,7 +309,7 @@ instance (RatchetKEMStateI s, AlgorithmI a) => StrEncoding (E2ERatchetParamsUri RKParamsAccepted ct k -> [("kem_ct", strEncode ct), ("kem_key", strEncode k)] strP = toE2ERatchetParamsUri <$?> strP {-# INLINE strP #-} - + toE2ERatchetParamsUri :: RatchetKEMStateI s => AE2ERatchetParamsUri a -> Either String (E2ERatchetParamsUri s a) toE2ERatchetParamsUri = \case AE2ERatchetParamsUri _ (E2ERatchetParamsUri vr k1 k2 Nothing) -> Right $ E2ERatchetParamsUri vr k1 k2 Nothing @@ -851,32 +852,39 @@ instance StrEncoding PQSupport where strP = pqEncToSupport <$> strP {-# INLINE strP #-} -data InitialKeys = IKUsePQ | IKNoPQ PQSupport +data InitialKeys + = IKUsePQ -- use PQ keys in contact request and short link data + | IKLinkPQ PQSupport -- use PQ keys in short link data only, if PQSupport enabled deriving (Eq, Show) pattern IKPQOn :: InitialKeys -pattern IKPQOn = IKNoPQ PQSupportOn +pattern IKPQOn = IKLinkPQ PQSupportOn pattern IKPQOff :: InitialKeys -pattern IKPQOff = IKNoPQ PQSupportOff +pattern IKPQOff = IKLinkPQ PQSupportOff instance StrEncoding InitialKeys where strEncode = \case IKUsePQ -> "pq=invitation" - IKNoPQ pq -> strEncode pq - strP = IKNoPQ <$> strP <|> "pq=invitation" $> IKUsePQ + IKLinkPQ pq -> strEncode pq + strP = IKLinkPQ <$> strP <|> "pq=invitation" $> IKUsePQ -- determines whether PQ key should be included in invitation link -initialPQEncryption :: InitialKeys -> PQSupport -initialPQEncryption = \case +initialPQEncryption :: Bool -> InitialKeys -> PQSupport +initialPQEncryption shortLink = \case IKUsePQ -> PQSupportOn - IKNoPQ _ -> PQSupportOff -- default + IKLinkPQ (PQSupport enable) -> PQSupport $ enable && shortLink -- determines whether PQ encryption should be used in connection connPQEncryption :: InitialKeys -> PQSupport connPQEncryption = \case IKUsePQ -> PQSupportOn - IKNoPQ pq -> pq -- default for creating connection is IKNoPQ PQEncOn + IKLinkPQ pq -> pq -- default for creating connection is IKLinkPQ PQEncOn + +joinContactInitialKeys :: Bool -> PQSupport -> InitialKeys +joinContactInitialKeys pqCompatible = \case + PQSupportOn | pqCompatible -> IKUsePQ + pqEnc -> IKLinkPQ pqEnc rcCheckCanPad :: Int -> ByteString -> ExceptT CryptoError IO () rcCheckCanPad paddedMsgLen msg = @@ -1187,7 +1195,7 @@ instance (AlgorithmI a, Typeable a) => FromField (Ratchet a) where fromField = b instance ToField PQEncryption where toField (PQEncryption pqEnc) = toField (BI pqEnc) -instance FromField PQEncryption where +instance FromField PQEncryption where #if defined(dbPostgres) fromField f dat = PQEncryption . unBI <$> fromField f dat #else diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 005c333f8..000cee386 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -270,7 +270,7 @@ inAnyOrder g rs = withFrozenCallStack $ do createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c) createConnection c userId enableNtfs cMode clientData subMode = do - (connId, (CCLink cReq _, Nothing)) <- A.createConnection c userId enableNtfs cMode Nothing clientData (IKNoPQ PQSupportOn) subMode + (connId, (CCLink cReq _, Nothing)) <- A.createConnection c userId enableNtfs cMode Nothing clientData IKPQOn subMode pure (connId, cReq) joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured) @@ -662,7 +662,7 @@ withAgentClients3 runTest = runAgentClientTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO () runAgentClientTest pqSupport sqSecured viaProxy alice bob baseId = - runAgentClientTestPQ sqSecured viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId + runAgentClientTestPQ sqSecured viaProxy (alice, IKLinkPQ pqSupport) (bob, pqSupport) baseId runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId = @@ -864,7 +864,7 @@ testAgentClient3 = runAgentClientContactTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO () runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId = - runAgentClientContactTestPQ sqSecured viaProxy pqSupport (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId + runAgentClientContactTestPQ sqSecured viaProxy pqSupport (alice, IKLinkPQ pqSupport) (bob, pqSupport) baseId runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId = @@ -2067,7 +2067,7 @@ makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn True makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do - (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice aliceUserId True SCMInvitation Nothing Nothing (CR.IKNoPQ pqSupport) SMSubscribe + (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice aliceUserId True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) SMSubscribe aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport (sqSecured', Nothing) <- A.joinConnection bob bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured @@ -2338,7 +2338,7 @@ receiveMsg c cId msgId msg = do testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO () testAsyncCommands sqSecured alice bob baseId = runRight_ $ do - bobId <- createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe + bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bobId', INV (ACR _ qInfo)) <- get alice liftIO $ bobId' `shouldBe` bobId aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe @@ -2389,7 +2389,7 @@ testAsyncCommands sqSecured alice bob baseId = testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO () testAsyncCommandsRestore ps = do alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB - bobId <- runRight $ createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe + bobId <- runRight $ createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe liftIO $ noMessages alice "alice doesn't receive INV because server is down" disposeAgentClient alice withAgent 2 agentCfg initAgentServers testDB $ \alice' -> @@ -2670,7 +2670,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do withAgent 1 cfg' initAgentServers testDB $ \a -> withAgent 2 cfg' initAgentServersSrv2 testDB2 $ \b -> do (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do - bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe + bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe @@ -2715,7 +2715,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do withAgent 1 agentCfg initAgentServers testDB $ \a -> withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do - bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe + bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index fc96ef896..44b58a7f8 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -49,7 +49,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) -import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), pattern PQSupportOn) +import Simplex.Messaging.Crypto.Ratchet (pattern IKPQOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding.String (StrEncoding (..)) import Simplex.Messaging.Protocol (EntityId (..), QueueMode (..), SubscriptionMode (..), pattern VersionSMPC) @@ -697,7 +697,7 @@ testGetPendingServerCommand st = do Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db connId (Just smpServer1) corrId' `shouldBe` "4" where - command = AClientCommand $ NEW True (ACM SCMInvitation) (IKNoPQ PQSupportOn) SMSubscribe + command = AClientCommand $ NEW True (ACM SCMInvitation) IKPQOn 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) diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 207550a32..55a734828 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -224,7 +224,7 @@ agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 baseId = withAgent 1 aCfg (servers aTestCfg) testDB $ \alice -> withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do - (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn (sqSecured, Nothing) <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True @@ -280,7 +280,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs = -- agent connections have to be set up in advance -- otherwise the CONF messages would get mixed with MSG prePair alice bob = do - (bobId, (CCLink qInfo Nothing, Nothing)) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + (bobId, (CCLink qInfo Nothing, Nothing)) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn (sqSecured, Nothing) <- runExceptT' $ A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True @@ -331,7 +331,7 @@ agentViaProxyVersionError = withAgent 1 agentCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do Left (A.BROKER _ (TRANSPORT TEVersion)) <- withAgent 2 agentCfg (servers [SMPServer testHost2 testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do - (_bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + (_bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe pure () @@ -351,7 +351,7 @@ agentViaProxyRetryOffline = do let pqEnc = CR.PQEncOn withServer $ \_ -> do (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do - (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + (bobId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn (sqSecured, Nothing) <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True