mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-28 22:28:22 +00:00
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 (#1563)
* 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 * do not use PQ keys in the link with old address versions
This commit is contained in:
Evgeny
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user