agent: use PQ keys in contact request data inside link container (but not in contact request link); use PQ keys in invitations sent to contact addresses

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

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
 

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

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

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)
 

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