mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-09-01 20:18:26 +00:00
Merge branch 'master' into ep/conc-msgs
This commit is contained in:
Evgeny Poberezkin
+1
-1
@@ -1,7 +1,7 @@
|
||||
cabal-version: 3.0
|
||||
|
||||
name: simplexmq
|
||||
version: 7.0.0.4
|
||||
version: 7.0.0.5
|
||||
synopsis: SimpleXMQ message broker
|
||||
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
|
||||
<./docs/Simplex-Messaging-Client.html client> and
|
||||
|
||||
@@ -427,8 +427,9 @@ createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::. newCo
|
||||
-- Caller provides root signing key pair and link entity ID.
|
||||
-- Returns the created link and internal params.
|
||||
-- The link address is fully determined at this point.
|
||||
prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> AE (CreatedConnLink 'CMContact, PreparedLinkParams)
|
||||
prepareConnectionLink c userId rootKey linkEntityId checkNotices = withAgentEnv c . prepareConnectionLink' c userId rootKey linkEntityId checkNotices
|
||||
prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams)
|
||||
prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData srv_ =
|
||||
withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData srv_
|
||||
{-# INLINE prepareConnectionLink #-}
|
||||
|
||||
-- | Create connection for prepared link (single network call).
|
||||
@@ -969,10 +970,10 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey
|
||||
|
||||
-- | Prepare connection link for contact mode (no network, no database).
|
||||
-- Caller provides root signing key pair and link entity ID.
|
||||
prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> AM (CreatedConnLink 'CMContact, PreparedLinkParams)
|
||||
prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData = do
|
||||
prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams)
|
||||
prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData srv_ = do
|
||||
g <- asks random
|
||||
plpSrvWithAuth@(ProtoServerWithAuth srv _) <- getSMPServer c userId
|
||||
plpSrvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_
|
||||
when checkNotices $ checkClientNotices c plpSrvWithAuth
|
||||
AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
|
||||
plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
|
||||
@@ -1228,8 +1229,8 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
|
||||
SCMInvitation -> do
|
||||
g <- asks random
|
||||
let pqEnc = CR.initialPQEncryption (isJust userLinkData_) pqInitKeys
|
||||
(pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
|
||||
withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem
|
||||
(pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
|
||||
withStore' c $ \db -> createRatchetX3dhKeys db connId pks
|
||||
pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange
|
||||
prepareLinkData :: UserConnLinkData c -> C.PublicKeyX25519 -> AM (C.CbNonce, SMPQueueUri, ConnectionRequestUri c, ClntQueueReqData)
|
||||
prepareLinkData userLinkData e2eDhKey = do
|
||||
@@ -1350,9 +1351,9 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
|
||||
Nothing -> throwE $ AGENT A_VERSION
|
||||
where
|
||||
createRatchet_ db g maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do
|
||||
(pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
|
||||
(pks, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
|
||||
(_, rcDHRs) <- atomically $ C.generateKeyPair g
|
||||
rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams
|
||||
rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pks e2eRcvParams
|
||||
let rcVs = CR.RatchetVersions {current = v, maxSupported}
|
||||
rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams
|
||||
liftIO $ createSndRatchet db connId rc e2eSndParams
|
||||
@@ -1429,8 +1430,8 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup su
|
||||
Left e -> do
|
||||
nonBlockingNotifyEvent c ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no rcv ratchet " <> show e))
|
||||
let pqEnc = CR.initialPQEncryption False pqInitKeys
|
||||
(pk1, pk2, pKem, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc
|
||||
createRatchetX3dhKeys db connId pk1 pk2 pKem
|
||||
(pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) pqEnc
|
||||
createRatchetX3dhKeys db connId pks
|
||||
pure e2eRcvParams
|
||||
let cReq = CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eVR
|
||||
pure $ CCLink cReq Nothing
|
||||
@@ -2477,11 +2478,11 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
|
||||
let cData' = cData {pqSupport = pqSupport'} :: ConnData
|
||||
AgentConfig {e2eEncryptVRange} <- asks config
|
||||
g <- asks random
|
||||
(pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqSupport'
|
||||
(pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqSupport'
|
||||
enqueueRatchetKeyMsgs c sqs e2eParams
|
||||
withStore' c $ \db -> do
|
||||
setConnRatchetSync db connId RSStarted
|
||||
setRatchetX3dhKeys db connId pk1 pk2 pKem
|
||||
setRatchetX3dhKeys db connId pks
|
||||
let cData'' = cData' {ratchetSyncState = RSStarted} :: ConnData
|
||||
conn' = DuplexConnection cData'' rqs sqs
|
||||
connectionStats c conn'
|
||||
@@ -3403,8 +3404,8 @@ processSMPTransmissions c (tSess@(userId, srv, _), THandleParams {thAuth, sessio
|
||||
-- party initiating connection
|
||||
(RcvConnection _ _, Just (CR.AE2ERatchetParams _ e2eSndParams@(CR.E2ERatchetParams e2eVersion _ _ _))) -> do
|
||||
unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION)
|
||||
(pk1, rcDHRs, pKem) <- withStore c (`getRatchetX3dhKeys` connId)
|
||||
rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 rcDHRs pKem e2eSndParams
|
||||
pks@(_, rcDHRs, _) <- withStore c (`getRatchetX3dhKeys` connId)
|
||||
rcParams <- liftError cryptoError $ CR.pqX3dhRcv pks e2eSndParams
|
||||
let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange}
|
||||
pqSupport' = pqSupport `CR.pqSupportAnd` versionPQSupport_ agentVersion (Just e2eVersion)
|
||||
rc = CR.initRcvRatchet rcVs rcDHRs rcParams pqSupport'
|
||||
@@ -3645,7 +3646,7 @@ processSMPTransmissions c (tSess@(userId, srv, _), THandleParams {thAuth, sessio
|
||||
exists <- checkRatchetKeyHashExists db connId rkHashRcv
|
||||
unless exists $ addProcessedRatchetKeyHash db connId rkHashRcv
|
||||
pure exists
|
||||
getSendRatchetKeys :: AM (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams)
|
||||
getSendRatchetKeys :: AM (CR.RcvE2EPrivRatchetParams 'C.X448)
|
||||
getSendRatchetKeys = case rss of
|
||||
RSOk -> sendReplyKey -- receiving client
|
||||
RSAllowed -> sendReplyKey
|
||||
@@ -3661,9 +3662,9 @@ processSMPTransmissions c (tSess@(userId, srv, _), THandleParams {thAuth, sessio
|
||||
where
|
||||
sendReplyKey = do
|
||||
g <- asks random
|
||||
(pk1, pk2, pKem, e2eParams) <- liftIO $ CR.generateRcvE2EParams g e2eVersion pqSupport
|
||||
(pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g e2eVersion pqSupport
|
||||
enqueueRatchetKeyMsgs c sqs e2eParams
|
||||
pure (pk1, pk2, pKem)
|
||||
pure pks
|
||||
notifyRatchetSyncError = do
|
||||
let cData'' = cData' {ratchetSyncState = RSRequired} :: ConnData
|
||||
conn'' = updateConnection cData'' conn'
|
||||
@@ -3682,14 +3683,14 @@ processSMPTransmissions c (tSess@(userId, srv, _), THandleParams {thAuth, sessio
|
||||
createRatchet db connId rc
|
||||
-- compare public keys `k1` in AgentRatchetKey messages sent by self and other party
|
||||
-- to determine ratchet initilization ordering
|
||||
initRatchet :: CR.RatchetVersions -> (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams) -> AM ()
|
||||
initRatchet :: CR.RatchetVersions -> CR.RcvE2EPrivRatchetParams 'C.X448 -> AM ()
|
||||
initRatchet rcVs (pk1, pk2, pKem)
|
||||
| rkHash (C.publicKey pk1) (C.publicKey pk2) <= rkHashRcv = do
|
||||
rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eOtherPartyParams
|
||||
rcParams <- liftError cryptoError $ CR.pqX3dhRcv (pk1, pk2, pKem) e2eOtherPartyParams
|
||||
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
|
||||
rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd (pk1, pk2, CR.APRKP CR.SRKSProposed <$> pKem) e2eOtherPartyParams
|
||||
recreateRatchet $ CR.initSndRatchet rcVs k2Rcv rcDHRs rcParams
|
||||
void . enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} $ EREADY lastExternalSndId
|
||||
|
||||
|
||||
@@ -1359,11 +1359,11 @@ deleteSndMsgsExpired db ttl limit = do
|
||||
|]
|
||||
(cutoffTs, limit)
|
||||
|
||||
createRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
|
||||
createRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem =
|
||||
createRatchetX3dhKeys :: DB.Connection -> ConnId -> CR.RcvE2EPrivRatchetParams 'C.X448 -> IO ()
|
||||
createRatchetX3dhKeys db connId (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) =
|
||||
DB.execute db "INSERT INTO ratchets (conn_id, x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem) VALUES (?, ?, ?, ?)" (connId, x3dhPrivKey1, x3dhPrivKey2, pqPrivKem)
|
||||
|
||||
getRatchetX3dhKeys :: DB.Connection -> ConnId -> IO (Either StoreError (C.PrivateKeyX448, C.PrivateKeyX448, Maybe CR.RcvPrivRKEMParams))
|
||||
getRatchetX3dhKeys :: DB.Connection -> ConnId -> IO (Either StoreError (CR.RcvE2EPrivRatchetParams 'C.X448))
|
||||
getRatchetX3dhKeys db connId =
|
||||
firstRow' keys SEX3dhKeysNotFound $
|
||||
DB.query db "SELECT x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem FROM ratchets WHERE conn_id = ?" (Only connId)
|
||||
@@ -1373,8 +1373,8 @@ getRatchetX3dhKeys db connId =
|
||||
_ -> Left SEX3dhKeysNotFound
|
||||
|
||||
-- used to remember new keys when starting ratchet re-synchronization
|
||||
setRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> Maybe CR.RcvPrivRKEMParams -> IO ()
|
||||
setRatchetX3dhKeys db connId x3dhPrivKey1 x3dhPrivKey2 pqPrivKem =
|
||||
setRatchetX3dhKeys :: DB.Connection -> ConnId -> CR.RcvE2EPrivRatchetParams 'C.X448 -> IO ()
|
||||
setRatchetX3dhKeys db connId (x3dhPrivKey1, x3dhPrivKey2, pqPrivKem) =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
|
||||
@@ -45,6 +45,7 @@ module Simplex.Messaging.Crypto.Ratchet
|
||||
AE2ERatchetParams (..),
|
||||
E2ERatchetParamsUri (..),
|
||||
E2ERatchetParams (..),
|
||||
RcvE2EPrivRatchetParams,
|
||||
VersionE2E,
|
||||
VersionRangeE2E,
|
||||
pattern VersionE2E,
|
||||
@@ -403,24 +404,30 @@ instance RatchetKEMStateI s => ToField (PrivRKEMParams s) where toField = toFiel
|
||||
|
||||
instance (Typeable s, RatchetKEMStateI s) => FromField (PrivRKEMParams s) where fromField = blobFieldDecoder smpDecode
|
||||
|
||||
type E2EPrivRatchetParams s a = (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s))\
|
||||
|
||||
type RcvE2EPrivRatchetParams a = E2EPrivRatchetParams 'RKSProposed a
|
||||
|
||||
type AE2EPrivRatchetParams a = (PrivateKey a, PrivateKey a, Maybe APrivRKEMParams)
|
||||
|
||||
data UseKEM (s :: RatchetKEMState) where
|
||||
ProposeKEM :: UseKEM 'RKSProposed
|
||||
AcceptKEM :: KEMPublicKey -> UseKEM 'RKSAccepted
|
||||
|
||||
data AUseKEM = forall s. RatchetKEMStateI s => AUseKEM (SRatchetKEMState s) (UseKEM s)
|
||||
|
||||
mkRcvE2ERatchetParams :: VersionE2E -> (PrivateKey a, PrivateKey a, Maybe RcvPrivRKEMParams) -> RcvE2ERatchetParams a
|
||||
mkRcvE2ERatchetParams :: VersionE2E -> RcvE2EPrivRatchetParams a -> RcvE2ERatchetParams a
|
||||
mkRcvE2ERatchetParams v (pk1, pk2, pKem) = E2ERatchetParams v (publicKey pk1) (publicKey pk2) (mkKem <$> pKem)
|
||||
where
|
||||
mkKem :: RcvPrivRKEMParams -> RcvRKEMParams
|
||||
mkKem (PrivateRKParamsProposed (k, _)) = RKParamsProposed k
|
||||
|
||||
generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s), E2ERatchetParams s a)
|
||||
generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (E2EPrivRatchetParams s a, E2ERatchetParams s a)
|
||||
generateE2EParams g v useKEM_ = do
|
||||
(k1, pk1) <- atomically $ generateKeyPair g
|
||||
(k2, pk2) <- atomically $ generateKeyPair g
|
||||
kems <- kemParams
|
||||
pure (pk1, pk2, snd <$> kems, E2ERatchetParams v k1 k2 (fst <$> kems))
|
||||
pure ((pk1, pk2, snd <$> kems), E2ERatchetParams v k1 k2 (fst <$> kems))
|
||||
where
|
||||
kemParams :: IO (Maybe (RKEMParams s, PrivRKEMParams s))
|
||||
kemParams = case useKEM_ of
|
||||
@@ -436,7 +443,7 @@ 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 -> PQSupport -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams 'RKSProposed), E2ERatchetParams 'RKSProposed a)
|
||||
generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> PQSupport -> IO (RcvE2EPrivRatchetParams a, RcvE2ERatchetParams a)
|
||||
generateRcvE2EParams g v = generateE2EParams g v . proposeKEM_
|
||||
where
|
||||
proposeKEM_ :: PQSupport -> Maybe (UseKEM 'RKSProposed)
|
||||
@@ -445,14 +452,14 @@ generateRcvE2EParams g v = generateE2EParams g v . 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)
|
||||
generateSndE2EParams :: forall a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe AUseKEM -> IO (AE2EPrivRatchetParams a, AE2ERatchetParams a)
|
||||
generateSndE2EParams g v = \case
|
||||
Nothing -> do
|
||||
(pk1, pk2, _, e2eParams) <- generateE2EParams g v Nothing
|
||||
pure (pk1, pk2, Nothing, AE2ERatchetParams SRKSProposed e2eParams)
|
||||
((pk1, pk2, _), e2eParams) <- generateE2EParams g v Nothing
|
||||
pure ((pk1, pk2, Nothing), AE2ERatchetParams SRKSProposed e2eParams)
|
||||
Just (AUseKEM s useKEM) -> do
|
||||
(pk1, pk2, pKem, e2eParams) <- generateE2EParams g v (Just useKEM)
|
||||
pure (pk1, pk2, APRKP s <$> pKem, AE2ERatchetParams s e2eParams)
|
||||
((pk1, pk2, pKem), e2eParams) <- generateE2EParams g v (Just useKEM)
|
||||
pure ((pk1, pk2, APRKP s <$> pKem), AE2ERatchetParams s e2eParams)
|
||||
|
||||
data RatchetInitParams = RatchetInitParams
|
||||
{ assocData :: Str,
|
||||
@@ -464,9 +471,9 @@ data RatchetInitParams = RatchetInitParams
|
||||
deriving (Show)
|
||||
|
||||
-- this is used by the peer joining the connection
|
||||
pqX3dhSnd :: DhAlgorithm a => PrivateKey a -> PrivateKey a -> Maybe APrivRKEMParams -> E2ERatchetParams 'RKSProposed a -> Either CryptoError (RatchetInitParams, Maybe KEMKeyPair)
|
||||
pqX3dhSnd :: DhAlgorithm a => AE2EPrivRatchetParams a -> E2ERatchetParams 'RKSProposed a -> Either CryptoError (RatchetInitParams, Maybe KEMKeyPair)
|
||||
-- 3. replied 2. received
|
||||
pqX3dhSnd spk1 spk2 spKem_ (E2ERatchetParams v rk1 rk2 rKem_) = do
|
||||
pqX3dhSnd (spk1, spk2, spKem_) (E2ERatchetParams v rk1 rk2 rKem_) = do
|
||||
(ks_, kem_) <- sndPq
|
||||
let initParams = pqX3dh (publicKey spk1, rk1) (dh' rk1 spk2) (dh' rk2 spk1) (dh' rk2 spk2) kem_
|
||||
pure (initParams, ks_)
|
||||
@@ -480,9 +487,9 @@ pqX3dhSnd spk1 spk2 spKem_ (E2ERatchetParams v rk1 rk2 rKem_) = do
|
||||
_ -> Right (Nothing, Nothing)
|
||||
|
||||
-- this is used by the peer that created new connection, after receiving the reply
|
||||
pqX3dhRcv :: forall s a. (RatchetKEMStateI s, DhAlgorithm a) => PrivateKey a -> PrivateKey a -> Maybe (PrivRKEMParams 'RKSProposed) -> E2ERatchetParams s a -> ExceptT CryptoError IO (RatchetInitParams, Maybe KEMKeyPair)
|
||||
pqX3dhRcv :: forall s a. (RatchetKEMStateI s, DhAlgorithm a) => RcvE2EPrivRatchetParams a -> E2ERatchetParams s a -> ExceptT CryptoError IO (RatchetInitParams, Maybe KEMKeyPair)
|
||||
-- 1. sent 4. received in reply
|
||||
pqX3dhRcv rpk1 rpk2 rpKem_ (E2ERatchetParams v sk1 sk2 sKem_) = do
|
||||
pqX3dhRcv (rpk1, rpk2, rpKem_) (E2ERatchetParams v sk1 sk2 sKem_) = do
|
||||
kem_ <- rcvPq
|
||||
let initParams = pqX3dh (sk1, publicKey rpk1) (dh' sk2 rpk1) (dh' sk1 rpk2) (dh' sk2 rpk2) (snd <$> kem_)
|
||||
pure (initParams, fst <$> kem_)
|
||||
|
||||
@@ -381,19 +381,19 @@ testX3dh :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
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 PQSupportOff
|
||||
let paramsBob = pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
|
||||
paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
|
||||
(pksBob@(_, _, Nothing), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v Nothing
|
||||
(pksAlice@(_, _, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
|
||||
let paramsBob = pqX3dhSnd pksBob e2eAlice
|
||||
paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
paramsAlice `shouldBe` paramsBob
|
||||
|
||||
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) PQSupportOff
|
||||
let paramsBob = pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
|
||||
paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
|
||||
(pksBob@(_, _, Nothing), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g (VersionE2E 1) Nothing
|
||||
(pksAlice@(_, _, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams @a g (VersionE2E 1) PQSupportOff
|
||||
let paramsBob = pqX3dhSnd pksBob e2eAlice
|
||||
paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
paramsAlice `shouldBe` paramsBob
|
||||
|
||||
testPqX3dhProposeInReply :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
@@ -401,11 +401,11 @@ testPqX3dhProposeInReply _ = do
|
||||
g <- C.newRandom
|
||||
let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
|
||||
-- initiate (no KEM)
|
||||
(pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
|
||||
(pksAlice@(_, _, 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
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
|
||||
(pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSProposed ProposeKEM)
|
||||
Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
paramsAlice `compatibleRatchets` paramsBob
|
||||
|
||||
testPqX3dhProposeAccept :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
@@ -413,12 +413,12 @@ testPqX3dhProposeAccept _ = do
|
||||
g <- C.newRandom
|
||||
let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
|
||||
-- initiate (propose KEM)
|
||||
(pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
|
||||
(pksAlice@(_, _, 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)
|
||||
Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemBob_ e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKemAlice_ e2eBob
|
||||
(pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM aliceKem)
|
||||
Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
paramsAlice `compatibleRatchets` paramsBob
|
||||
|
||||
testPqX3dhProposeReject :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
@@ -426,12 +426,12 @@ testPqX3dhProposeReject _ = do
|
||||
g <- C.newRandom
|
||||
let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
|
||||
-- initiate (propose KEM)
|
||||
(pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
|
||||
(pksAlice@(_, _, 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
|
||||
Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKemAlice_ e2eBob
|
||||
(pksBob@(_, _, Nothing), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v Nothing
|
||||
Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
paramsAlice `compatibleRatchets` paramsBob
|
||||
|
||||
testPqX3dhAcceptWithoutProposalError :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
@@ -439,26 +439,26 @@ testPqX3dhAcceptWithoutProposalError _ = do
|
||||
g <- C.newRandom
|
||||
let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
|
||||
-- initiate (no KEM)
|
||||
(pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOff
|
||||
(pksAlice@(_, _, 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
|
||||
(k, _) <- sntrup761Keypair g
|
||||
(pkBob1, pkBob2, pKemBob_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM k)
|
||||
pqX3dhSnd pkBob1 pkBob2 pKemBob_ e2eAlice `shouldBe` Left C.CERatchetKEMState
|
||||
runExceptT (pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob) `shouldReturn` Left C.CERatchetKEMState
|
||||
(pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM k)
|
||||
pqX3dhSnd pksBob e2eAlice `shouldBe` Left C.CERatchetKEMState
|
||||
runExceptT (pqX3dhRcv pksAlice e2eBob) `shouldReturn` Left C.CERatchetKEMState
|
||||
|
||||
testPqX3dhProposeAgain :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
testPqX3dhProposeAgain _ = do
|
||||
g <- C.newRandom
|
||||
let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
|
||||
-- initiate (propose KEM)
|
||||
(pkAlice1, pkAlice2, pKemAlice_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
|
||||
(pksAlice@(_, _, 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)
|
||||
Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemBob_ e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKemAlice_ e2eBob
|
||||
(pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSProposed ProposeKEM)
|
||||
Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
paramsAlice `compatibleRatchets` paramsBob
|
||||
|
||||
compatibleRatchets :: (RatchetInitParams, x) -> (RatchetInitParams, x) -> Expectation
|
||||
@@ -515,10 +515,10 @@ initRatchets :: (AlgorithmI a, DhAlgorithm a) => IO (Ratchet a, Ratchet a, Encry
|
||||
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 PQSupportOff
|
||||
Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
|
||||
(pksBob@(_, _, Nothing), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v Nothing
|
||||
(pksAlice@(_, pkAlice2, Nothing), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff
|
||||
Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
(_, pkBob3) <- atomically $ C.generateKeyPair g
|
||||
let vs = testRatchetVersions
|
||||
bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
|
||||
@@ -530,12 +530,12 @@ initRatchetsKEMProposed = do
|
||||
g <- C.newRandom
|
||||
let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
|
||||
-- initiate (no KEM)
|
||||
(pkAlice1, pkAlice2, Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff
|
||||
(pksAlice@(_, 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
|
||||
(pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
|
||||
Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
(_, pkBob3) <- atomically $ C.generateKeyPair g
|
||||
let vs = testRatchetVersions
|
||||
bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
|
||||
@@ -547,13 +547,13 @@ initRatchetsKEMAccepted = do
|
||||
g <- C.newRandom
|
||||
let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
|
||||
-- initiate (propose)
|
||||
(pkAlice1, pkAlice2, pKem_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn
|
||||
(pksAlice@(_, pkAlice2, Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn
|
||||
E2ERatchetParams _ _ _ (Just (RKParamsProposed aliceKem)) <- pure e2eAlice
|
||||
-- accept
|
||||
let useKem = AUseKEM SRKSAccepted (AcceptKEM aliceKem)
|
||||
(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
|
||||
(pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
|
||||
Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
(_, pkBob3) <- atomically $ C.generateKeyPair g
|
||||
let vs = testRatchetVersions
|
||||
bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
|
||||
@@ -565,12 +565,12 @@ initRatchetsKEMProposedAgain = do
|
||||
g <- C.newRandom
|
||||
let v = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
|
||||
-- initiate (propose KEM)
|
||||
(pkAlice1, pkAlice2, pKem_@(Just _), e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOn
|
||||
(pksAlice@(_, pkAlice2, 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
|
||||
(pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
|
||||
Right paramsBob <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
(_, pkBob3) <- atomically $ C.generateKeyPair g
|
||||
let vs = testRatchetVersions
|
||||
bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
|
||||
|
||||
@@ -1810,7 +1810,7 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b
|
||||
linkEntId <- atomically $ C.randomBytes 32 g
|
||||
runRight $ do
|
||||
(ccLink@(CCLink connReq (Just shortLink)), preparedParams) <-
|
||||
A.prepareConnectionLink (client a) 1 rootKey linkEntId True Nothing
|
||||
A.prepareConnectionLink (client a) 1 rootKey linkEntId True Nothing Nothing
|
||||
liftIO $ strDecode (strEncode shortLink) `shouldBe` Right shortLink
|
||||
_ <- A.createConnectionForLink (client a) NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn SMSubscribe
|
||||
(FixedLinkData {linkConnReq = connReq', linkEntityId}, ContactLinkData _ userCtData') <- getConnShortLink b 1 shortLink
|
||||
|
||||
Reference in New Issue
Block a user