mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-07-28 12:09:55 +00:00
agent: refactor type for private keys in double ratchet (#1830)
This commit is contained in:
Evgeny
@@ -1225,8 +1225,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
|
||||
@@ -1347,9 +1347,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
|
||||
@@ -1426,8 +1426,8 @@ joinConnSrv c nm userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup su
|
||||
Left e -> do
|
||||
nonBlockingWriteTBQueue (subQ 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
|
||||
@@ -2475,11 +2475,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'
|
||||
@@ -3410,8 +3410,8 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
|
||||
-- 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'
|
||||
@@ -3652,7 +3652,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
|
||||
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
|
||||
@@ -3668,9 +3668,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
|
||||
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'
|
||||
@@ -3689,14 +3689,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
|
||||
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_)
|
||||
|
||||
Reference in New Issue
Block a user