agent: resolve potential race conditions in double ratchet (#1923)

* agent: resolve potential race conditions in double ratchet

* update

* improve

* diff

* diff

* diff

* simpler

* more races

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
EvgenyandEvgeny @ SimpleX Chat authored and GitHub committed 2026-10-04 22:28:50 +01:00
1 parent fcc5670ae2
commit 65893a359a
11 files changed
+301 -125

No files matched your search

+131 -113
View File
@@ -2435,62 +2435,66 @@ enqueueMessageB c reqs = do
cfg <- asks config
(_, reqMids) <- unsafeWithStore c $ \db -> do
mapAccumLM (\ids r -> storeSentMsg db cfg ids r `E.catchAny` \e -> (ids,) <$> handleInternal e) IM.empty reqs
forME reqMids $ \((csqs_, _, _, _), InternalId msgId, pqSecr) -> forM csqs_ $ \(cData, sq :| sqs) -> do
submitPendingMsg c sq
let sqs' = filter (isActiveSndQ cData) sqs
pure ((msgId, pqSecr), if null sqs' then Nothing else Just (sqs', msgId))
forME reqMids $ submitSentMsg c
where
storeSentMsg ::
DB.Connection ->
AgentConfig ->
IntMap (Maybe Int64, AMessage) ->
Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage) ->
IO (IntMap (Maybe Int64, AMessage), Either AgentErrorType ((Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage), InternalId, PQEncryption))
storeSentMsg db cfg aMessageIds = \case
Left e -> pure (aMessageIds, Left e)
Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of
VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body")
Nothing -> do
(mbId_, r) <- case csqs_ of
Left e -> pure (Nothing, Left e)
Right (cData, sq :| _) -> do
mbId <- createSndMsgBody db aMessage
(Just mbId,) <$> storeSentMsg_ cData sq mbId aMessage
let aMessageIds' = maybe id (`IM.insert` (mbId_, aMessage)) i_ aMessageIds
pure (aMessageIds', r)
VRRef i -> case csqs_ of
Left e -> pure $ (aMessageIds, Left e)
Right (cData, sq :| _) -> case IM.lookup i aMessageIds of
Just (Just mbId, aMessage) -> (aMessageIds,) <$> storeSentMsg_ cData sq mbId aMessage
Just (Nothing, aMessage) -> do
mbId <- createSndMsgBody db aMessage
let aMessageIds' = IM.insert i (Just mbId, aMessage) aMessageIds
(aMessageIds',) <$> storeSentMsg_ cData sq mbId aMessage
Nothing -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg missing saved message body id")
where
storeSentMsg_ cData@ConnData {connId} sq sndMsgBodyId aMessage = fmap (first storeError) $ runExceptT $ do
let AgentConfig {e2eEncryptVRange} = cfg
internalTs <- liftIO getCurrentTime
(internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
-- We need to do pre-flight encoding that is not stored in database
-- to calculate its hash and remember it on connection (createSndMsg -> updateSndMsgHash)
-- to enable next enqueue.
-- (As encoding is different per connection, we can't store shared body, so it's repeated on delivery)
let agentMsgStr = encodeAgentMsgStr aMessage internalSndId prevMsgHash
internalHash = C.sha256Hash agentMsgStr
currentE2EVersion = maxVersion e2eEncryptVRange
(mek, paddedLen, pqEnc) <- agentRatchetEncryptHeader db cData e2eEncAgentMsgLength pqEnc_ currentE2EVersion
withExceptT (SEAgentError . cryptoError) $ CR.rcCheckCanPad paddedLen agentMsgStr
let msgType = aMessageType aMessage
-- msgBody is empty, because snd_messages record is linked to snd_message_bodies
msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody = "", pqEncryption = pqEnc, internalHash, prevMsgHash, sndMsgPrepData_ = Just SndMsgPrepData {encryptKey = mek, paddedLen, sndMsgBodyId}}
liftIO $ createSndMsg db connId msgData
liftIO $ createSndMsgDelivery db sq internalId
pure (req, internalId, pqEnc)
handleInternal :: E.SomeException -> IO (Either AgentErrorType b)
handleInternal = pure . Left . INTERNAL . show
submitSentMsg :: AgentClient -> ((Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage), InternalId, PQEncryption) -> AM' (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe ([SndQueue], AgentMsgId)))
submitSentMsg c ((csqs_, _, _, _), InternalId msgId, pqSecr) = forM csqs_ $ \(cData, sq :| sqs) -> do
submitPendingMsg c sq
let sqs' = filter (isActiveSndQ cData) sqs
pure ((msgId, pqSecr), if null sqs' then Nothing else Just (sqs', msgId))
storeSentMsg ::
DB.Connection ->
AgentConfig ->
IntMap (Maybe Int64, AMessage) ->
Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage) ->
IO (IntMap (Maybe Int64, AMessage), Either AgentErrorType ((Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage), InternalId, PQEncryption))
storeSentMsg db cfg aMessageIds = \case
Left e -> pure (aMessageIds, Left e)
Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of
VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body")
Nothing -> do
(mbId_, r) <- case csqs_ of
Left e -> pure (Nothing, Left e)
Right (cData, sq :| _) -> do
mbId <- createSndMsgBody db aMessage
(Just mbId,) <$> storeSentMsg_ cData sq mbId aMessage
let aMessageIds' = maybe id (`IM.insert` (mbId_, aMessage)) i_ aMessageIds
pure (aMessageIds', r)
VRRef i -> case csqs_ of
Left e -> pure $ (aMessageIds, Left e)
Right (cData, sq :| _) -> case IM.lookup i aMessageIds of
Just (Just mbId, aMessage) -> (aMessageIds,) <$> storeSentMsg_ cData sq mbId aMessage
Just (Nothing, aMessage) -> do
mbId <- createSndMsgBody db aMessage
let aMessageIds' = IM.insert i (Just mbId, aMessage) aMessageIds
(aMessageIds',) <$> storeSentMsg_ cData sq mbId aMessage
Nothing -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg missing saved message body id")
where
storeSentMsg_ cData@ConnData {connId} sq sndMsgBodyId aMessage = fmap (first storeError) $ runExceptT $ do
let AgentConfig {e2eEncryptVRange} = cfg
internalTs <- liftIO getCurrentTime
(internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
-- We need to do pre-flight encoding that is not stored in database
-- to calculate its hash and remember it on connection (createSndMsg -> updateSndMsgHash)
-- to enable next enqueue.
-- (As encoding is different per connection, we can't store shared body, so it's repeated on delivery)
let agentMsgStr = encodeAgentMsgStr aMessage internalSndId prevMsgHash
internalHash = C.sha256Hash agentMsgStr
currentE2EVersion = maxVersion e2eEncryptVRange
(mek, paddedLen, pqEnc) <- agentRatchetEncryptHeader db cData e2eEncAgentMsgLength pqEnc_ currentE2EVersion
withExceptT (SEAgentError . cryptoError) $ CR.rcCheckCanPad paddedLen agentMsgStr
let msgType = aMessageType aMessage
-- msgBody is empty, because snd_messages record is linked to snd_message_bodies
msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody = "", pqEncryption = pqEnc, internalHash, prevMsgHash, sndMsgPrepData_ = Just SndMsgPrepData {encryptKey = mek, paddedLen, sndMsgBodyId}}
liftIO $ createSndMsg db connId msgData
liftIO $ createSndMsgDelivery db sq internalId
pure (req, internalId, pqEnc)
encodeAgentMsgStr :: AMessage -> InternalSndId -> PrevSndMsgHash -> ByteString
encodeAgentMsgStr aMessage internalSndId prevMsgHash = do
let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
@@ -2865,15 +2869,18 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
SomeConn _ (DuplexConnection cData@ConnData {pqSupport} rqs sqs)
| ratchetSyncAllowed cData || force -> do
-- check queues are not switching?
when (pqSupport' /= pqSupport) $ withStore' c $ \db -> setConnPQSupport db connId pqSupport'
let cData' = cData {pqSupport = pqSupport'} :: ConnData
AgentConfig {e2eEncryptVRange} <- asks config
AgentConfig {e2eEncryptVRange, smpAgentVRange} <- asks config
g <- asks random
(pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqSupport'
enqueueRatchetKeyMsgs c cData' sqs e2eParams
withStore' c $ \db -> do
setConnRatchetSync db connId RSStarted
setRatchetX3dhKeys db connId pks
msgId <- withStore c $ \db -> runExceptT $ do
msgId <- storeRatchetKey db (L.head sqs) (maxVersion smpAgentVRange) e2eParams Nothing
liftIO $ do
when (pqSupport' /= pqSupport) $ setConnPQSupport db connId pqSupport'
setConnRatchetSync db connId RSStarted
setRatchetX3dhKeys db connId pks
pure msgId
lift $ enqueueRatchetKeyMsgs c cData' sqs msgId
let cData'' = cData' {ratchetSyncState = RSStarted} :: ConnData
conn' = DuplexConnection cData'' rqs sqs
connectionStats c conn'
@@ -3613,9 +3620,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
_ -> prohibited "handshake: incorrect state" >> ack
(Just e2eDh, Nothing) -> do
decryptClientMessage e2eDh clientMsg >>= \case
(SMP.PHEmpty, AgentRatchetKey {agentVersion, e2eEncryption}) -> do
(SMP.PHEmpty, AgentRatchetKey {agentVersion, e2eEncryption, info}) -> do
conn' <- updateConnVersion conn cData agentVersion
qDuplex conn' "AgentRatchetKey" $ \a -> newRatchetKey e2eEncryption a >> ack
qDuplex conn' "AgentRatchetKey" $ \a -> newRatchetKey e2eEncryption info a >> ack
(SMP.PHEmpty, AgentMsgEnvelope {agentVersion, encAgentMessage}) -> do
conn' <- updateConnVersion conn cData agentVersion
-- primary queue is set as Active in helloMsg, below is to set additional queues Active
@@ -3658,7 +3665,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
qDuplexAckDel conn'' name a = qDuplex conn'' name a >> ackDel msgId
resetRatchetSync :: AM (Connection c)
resetRatchetSync
| rss `notElem` ([RSOk, RSStarted] :: [RatchetSyncState]) = do
| rss `notElem` ([RSOk, RSStarted] :: [RatchetSyncState]) = ifM ((RSStarted ==) <$> getRatchetSyncState) (pure conn') $ do
let cData'' = (toConnData conn') {ratchetSyncState = RSOk} :: ConnData
conn'' = updateConnection cData'' conn'
cStats <- connectionStats c conn''
@@ -3699,7 +3706,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
notifySync :: AM ()
notifySync = qDuplex conn' "AGENT A_CRYPTO error" $ \connDuplex -> do
let rss' = cryptoErrToSyncState e
when (rss `elem` ([RSOk, RSAllowed, RSRequired] :: [RatchetSyncState])) $ do
whenM ((`elem` ([RSOk, RSAllowed, RSRequired] :: [RatchetSyncState])) <$> getRatchetSyncState) $ do
let cData'' = (toConnData conn') {ratchetSyncState = rss'} :: ConnData
conn'' = updateConnection cData'' connDuplex
cStats <- connectionStats c conn''
@@ -3795,6 +3802,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
enqueueCmd :: InternalCommand -> AM ()
enqueueCmd = enqueueCommand c "" connId (Just srv) . AInternalCommand
getRatchetSyncState :: AM RatchetSyncState
getRatchetSyncState = withStore c (`getConnRatchetSync` connId)
unexpected :: BrokerMsg -> AM ()
unexpected r = do
logServer "<--" c srv rId $ "unexpected: " <> bshow r
@@ -4163,42 +4173,47 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
DuplexConnection {} -> action conn'
_ -> qError $ name <> ": message must be sent to duplex connection"
newRatchetKey :: CR.RcvE2ERatchetParams 'C.X448 -> Connection 'CDuplex -> AM ()
newRatchetKey e2eOtherPartyParams@(CR.E2ERatchetParams e2eVersion k1Rcv k2Rcv _) conn'@(DuplexConnection cData'@ConnData {lastExternalSndId, pqSupport} _ sqs) =
newRatchetKey :: CR.RcvE2ERatchetParams 'C.X448 -> ByteString -> Connection 'CDuplex -> AM ()
newRatchetKey e2eOtherPartyParams@(CR.E2ERatchetParams e2eVersion k1Rcv k2Rcv _) info conn'@(DuplexConnection cData'@ConnData {lastExternalSndId, pqSupport} _ sqs) =
unlessM ratchetExists $ do
AgentConfig {e2eEncryptVRange} <- asks config
unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION)
keys <- getSendRatchetKeys
keys_ <- getSendRatchetKeys
let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange}
initRatchet rcVs keys
notifyAgreed
case keys_ of
Just (keys, replyKey_) -> initRatchet rcVs keys replyKey_ >> notifyAgreed
Nothing -> withStore' c $ \db -> addProcessedRatchetKeyHash db connId rkHashRcv
where
rkHashRcv = rkHash k1Rcv k2Rcv
rkHash k1 k2 = C.sha256Hash $ C.pubKeyBytes k1 <> C.pubKeyBytes k2
answeredKeyHash_ = case smpDecode info of
Right (AgentRatchetInfo RatchetInfo {answeredKeyHash}) -> answeredKeyHash
_ -> Nothing
ratchetExists :: AM Bool
ratchetExists = withStore' c $ \db -> do
exists <- checkRatchetKeyHashExists db connId rkHashRcv
unless exists $ addProcessedRatchetKeyHash db connId rkHashRcv
pure exists
getSendRatchetKeys :: AM (CR.RcvE2EPrivRatchetParams 'C.X448)
getSendRatchetKeys = case rss of
RSOk -> sendReplyKey -- receiving client
RSAllowed -> sendReplyKey
RSRequired -> sendReplyKey
RSStarted -> withStore c (`getRatchetX3dhKeys` connId) -- initiating client
RSAgreed -> do
withStore' c $ \db -> setConnRatchetSync db connId RSRequired
getSendRatchetKeys :: AM (Maybe (CR.RcvE2EPrivRatchetParams 'C.X448, Maybe (CR.RcvE2ERatchetParams 'C.X448)))
getSendRatchetKeys = getRatchetSyncState >>= \rss' -> case (rss', answeredKeyHash_) of
(RSStarted, Nothing) -> Just . (,Nothing) <$> withStore c (`getRatchetX3dhKeys` connId) -- initiating client
(RSStarted, Just h) -> fmap (,Nothing) . answeredKeys h <$> withStore c (`getRatchetX3dhKeys` connId)
(_, Nothing) -> Just <$> sendReplyKey -- receiving client
(RSAgreed, Just _) -> do
withStore' c $ \db -> addProcessedRatchetKeyHash db connId rkHashRcv >> setConnRatchetSync db connId RSRequired
notifyRatchetSyncError
-- can communicate for other client to reset to RSRequired
-- - need to add new AgentMsgEnvelope, AgentMessage, AgentMessageType
-- - need to deduplicate on receiving side
throwE $ AGENT (A_CRYPTO RATCHET_SYNC)
(_, Just _) -> pure Nothing
where
answeredKeys h keys@(pk1, pk2, _)
| rkHash (C.publicKey pk1) (C.publicKey pk2) == h = Just keys
| otherwise = Nothing
sendReplyKey = do
g <- asks random
(pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g e2eVersion pqSupport
enqueueRatchetKeyMsgs c cData' sqs e2eParams
pure pks
pure (pks, Just e2eParams)
notifyRatchetSyncError = do
let cData'' = cData' {ratchetSyncState = RSRequired} :: ConnData
conn'' = updateConnection cData'' conn'
@@ -4210,23 +4225,33 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
conn'' = updateConnection cData'' conn'
cStats <- connectionStats c conn''
notify $ RSYNC RSAgreed Nothing cStats
recreateRatchet :: CR.Ratchet 'C.X448 -> AM ()
recreateRatchet rc = withStore' c $ \db -> do
setConnRatchetSync db connId RSAgreed
deleteRatchet db connId
createRatchet db connId rc
recreateRatchet :: Maybe (CR.RcvE2ERatchetParams 'C.X448) -> Maybe AMessage -> CR.Ratchet 'C.X448 -> AM ()
recreateRatchet replyKey_ eready_ rc = do
cfg@AgentConfig {smpAgentVRange} <- asks config
(msgId_, r_) <- withStore c $ \db -> runExceptT $ do
msgId_ <- forM replyKey_ $ \e2eParams -> storeRatchetKey db (L.head sqs) (maxVersion smpAgentVRange) e2eParams (Just rkHashRcv)
liftIO $ do
addProcessedRatchetKeyHash db connId rkHashRcv
setConnRatchetSync db connId RSAgreed
deleteRatchet db connId
createRatchet db connId rc
r_ <- forM eready_ $ \msg -> liftIO $ storeSentMsg db cfg IM.empty (Right (Right (cData', sqs), Nothing, SMP.MsgFlags {notification = True}, vrValue msg)) >>= either E.throwIO pure . snd
pure (msgId_, r_)
forM_ msgId_ $ lift . enqueueRatchetKeyMsgs c cData' sqs
forM_ r_ $ \r -> lift $ do
r' <- submitSentMsg c r
enqueueSavedMessageB c $ mapMaybe snd $ rights [r']
-- compare public keys `k1` in AgentRatchetKey messages sent by self and other party
-- to determine ratchet initilization ordering
initRatchet :: CR.RatchetVersions -> CR.RcvE2EPrivRatchetParams 'C.X448 -> AM ()
initRatchet rcVs (pk1, pk2, pKem)
initRatchet :: CR.RatchetVersions -> CR.RcvE2EPrivRatchetParams 'C.X448 -> Maybe (CR.RcvE2ERatchetParams 'C.X448) -> AM ()
initRatchet rcVs (pk1, pk2, pKem) replyKey_
| rkHash (C.publicKey pk1) (C.publicKey pk2) <= rkHashRcv = do
rcParams <- liftError cryptoError $ CR.pqX3dhRcv (pk1, pk2, pKem) e2eOtherPartyParams
recreateRatchet $ CR.initRcvRatchet rcVs pk2 rcParams pqSupport
recreateRatchet replyKey_ Nothing $ 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
recreateRatchet $ CR.initSndRatchet rcVs k2Rcv rcDHRs rcParams
void . enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} $ EREADY lastExternalSndId
recreateRatchet replyKey_ (Just $ EREADY lastExternalSndId) $ CR.initSndRatchet rcVs k2Rcv rcDHRs rcParams
checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash
@@ -4339,32 +4364,25 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq
liftIO $ createSndMsg db connId msgData
liftIO $ createSndMsgDelivery db sq internalId
enqueueRatchetKeyMsgs :: AgentClient -> ConnData -> NonEmpty SndQueue -> CR.RcvE2ERatchetParams 'C.X448 -> AM ()
enqueueRatchetKeyMsgs c cData (sq :| sqs) e2eEncryption = do
msgId <- enqueueRatchetKey c sq e2eEncryption
mapM_ (lift . enqueueSavedMessage c msgId) $ filter (isActiveSndQ cData) sqs
enqueueRatchetKeyMsgs :: AgentClient -> ConnData -> NonEmpty SndQueue -> InternalId -> AM' ()
enqueueRatchetKeyMsgs c cData (sq :| sqs) (InternalId msgId) = do
submitPendingMsg c sq
mapM_ (enqueueSavedMessage c msgId) $ filter (isActiveSndQ cData) sqs
enqueueRatchetKey :: AgentClient -> SndQueue -> CR.RcvE2ERatchetParams 'C.X448 -> AM AgentMsgId
enqueueRatchetKey c sq@SndQueue {connId} e2eEncryption = do
aVRange <- asks $ smpAgentVRange . config
msgId <- storeRatchetKey $ maxVersion aVRange
lift $ submitPendingMsg c sq
pure $ unId msgId
where
storeRatchetKey :: VersionSMPA -> AM InternalId
storeRatchetKey agentVersion = withStore c $ \db -> runExceptT $ do
internalTs <- liftIO getCurrentTime
(internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
let agentMsg = AgentRatchetInfo ""
agentMsgStr = smpEncode agentMsg
internalHash = C.sha256Hash agentMsgStr
let msgBody = smpEncode $ AgentRatchetKey {agentVersion, e2eEncryption, info = agentMsgStr}
msgType = agentMessageType agentMsg
-- this message is e2e encrypted with queue key, not with double ratchet
msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption = PQEncOff, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing}
liftIO $ createSndMsg db connId msgData
liftIO $ createSndMsgDelivery db sq internalId
pure internalId
storeRatchetKey :: DB.Connection -> SndQueue -> VersionSMPA -> CR.RcvE2ERatchetParams 'C.X448 -> Maybe ByteString -> ExceptT StoreError IO InternalId
storeRatchetKey db sq@SndQueue {connId} agentVersion e2eEncryption answeredKeyHash_ = do
internalTs <- liftIO getCurrentTime
(internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
let agentMsg = AgentRatchetInfo RatchetInfo {answeredKeyHash = answeredKeyHash_}
agentMsgStr = smpEncode agentMsg
internalHash = C.sha256Hash agentMsgStr
let msgBody = smpEncode $ AgentRatchetKey {agentVersion, e2eEncryption, info = agentMsgStr}
msgType = agentMessageType agentMsg
-- this message is e2e encrypted with queue key, not with double ratchet
msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption = PQEncOff, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing}
liftIO $ createSndMsg db connId msgData
liftIO $ createSndMsgDelivery db sq internalId
pure internalId
-- encoded AgentMessage -> encoded EncAgentMessage
agentRatchetEncrypt :: DB.Connection -> ConnData -> ByteString -> (PQSupport -> Int) -> Maybe PQEncryption -> CR.VersionE2E -> ExceptT StoreError IO (ByteString, PQEncryption)
+14 -3
View File
@@ -79,6 +79,7 @@ module Simplex.Messaging.Agent.Protocol
SMPConfirmation (..),
AgentMsgEnvelope (..),
AgentMessage (..),
RatchetInfo (..),
RequestSignature (..),
AgentMessageType (..),
APrivHeader (..),
@@ -928,7 +929,7 @@ data AgentMessage
| -- AgentConnInfoReply is used by accepting party in duplexHandshake mode (v2), allowing to include reply queue(s) in the initial confirmation.
-- It made removed REPLY message unnecessary.
AgentConnInfoReply (NonEmpty SMPQueueInfo) ConnInfo
| AgentRatchetInfo ByteString
| AgentRatchetInfo RatchetInfo
| AgentMessage APrivHeader AMessage
| AgentServiceRequest (NonEmpty SMPQueueInfo) (Maybe RequestSignature) MsgBody
| AgentServiceResponse MsgBody
@@ -939,7 +940,7 @@ instance Encoding AgentMessage where
smpEncode = \case
AgentConnInfo cInfo -> smpEncode ('I', Tail cInfo)
AgentConnInfoReply smpQueues cInfo -> smpEncode ('D', smpQueues, Tail cInfo) -- 'D' stands for "duplex"
AgentRatchetInfo info -> smpEncode ('R', Tail info)
AgentRatchetInfo info -> smpEncode ('R', info)
AgentMessage hdr aMsg -> smpEncode ('M', hdr, aMsg)
AgentServiceRequest qs sig_ body -> smpEncode ('A', qs, sig_, Tail body)
AgentServiceResponse body -> smpEncode ('P', Tail body)
@@ -948,13 +949,23 @@ instance Encoding AgentMessage where
smpP >>= \case
'I' -> AgentConnInfo . unTail <$> smpP
'D' -> AgentConnInfoReply <$> smpP <*> (unTail <$> smpP)
'R' -> AgentRatchetInfo . unTail <$> smpP
'R' -> AgentRatchetInfo <$> smpP
'M' -> AgentMessage <$> smpP <*> smpP
'A' -> AgentServiceRequest <$> smpP <*> smpP <*> (unTail <$> smpP)
'P' -> AgentServiceResponse . unTail <$> smpP
'J' -> AgentRejection . unTail <$> smpP
_ -> fail "bad AgentMessage"
data RatchetInfo = RatchetInfo {answeredKeyHash :: Maybe ByteString}
deriving (Eq, Show)
instance Encoding RatchetInfo where
smpEncode RatchetInfo {answeredKeyHash} = smpEncode answeredKeyHash
smpP = do
answeredKeyHash <- smpP <|> pure Nothing
_ <- A.takeByteString
pure RatchetInfo {answeredKeyHash}
-- internal type for storing message type in the database
data AgentMessageType
= AM_CONN_INFO
@@ -76,6 +76,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
getExpiredServiceConns,
deleteExpiredServiceRequests,
getDeletedWaitingDeliveryConnIds,
getConnRatchetSync,
setConnRatchetSync,
addProcessedRatchetKeyHash,
checkRatchetKeyHashExists,
@@ -2797,6 +2798,11 @@ getDeletedWaitingDeliveryConnIds :: DB.Connection -> IO [ConnId]
getDeletedWaitingDeliveryConnIds db =
map fromOnly <$> DB.query_ db "SELECT conn_id FROM connections WHERE deleted_at_wait_delivery IS NOT NULL"
getConnRatchetSync :: DB.Connection -> ConnId -> IO (Either StoreError RatchetSyncState)
getConnRatchetSync db connId =
firstRow fromOnly SEConnNotFound $
DB.query db "SELECT ratchet_sync_state FROM connections WHERE conn_id = ?" (Only connId)
setConnRatchetSync :: DB.Connection -> ConnId -> RatchetSyncState -> IO ()
setConnRatchetSync db connId ratchetSyncState =
DB.execute db "UPDATE connections SET ratchet_sync_state = ? WHERE conn_id = ?" (ratchetSyncState, connId)
@@ -11,6 +11,15 @@ m20260929_ratchet_indexes =
[r|
DROP INDEX idx_skipped_messages_conn_id;
CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id, skipped_message_id);
DELETE FROM processed_ratchet_key_hashes AS h
WHERE EXISTS (
SELECT 1 FROM processed_ratchet_key_hashes d
WHERE d.conn_id = h.conn_id AND d.hash = h.hash AND d.processed_ratchet_key_hash_id < h.processed_ratchet_key_hash_id
);
DROP INDEX idx_processed_ratchet_key_hashes_hash;
CREATE UNIQUE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(conn_id, processed_ratchet_key_hash_id);
|]
@@ -18,6 +27,8 @@ down_m20260929_ratchet_indexes :: Text
down_m20260929_ratchet_indexes =
[r|
DROP INDEX idx_processed_ratchet_key_hashes_conn_id;
DROP INDEX idx_processed_ratchet_key_hashes_hash;
CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
DROP INDEX idx_skipped_messages_conn_id;
CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id);
|]
@@ -1177,7 +1177,7 @@ CREATE INDEX idx_processed_ratchet_key_hashes_created_at ON smp_agent_test_proto
CREATE INDEX idx_processed_ratchet_key_hashes_hash ON smp_agent_test_protocol_schema.processed_ratchet_key_hashes USING btree (conn_id, hash);
CREATE UNIQUE INDEX idx_processed_ratchet_key_hashes_hash ON smp_agent_test_protocol_schema.processed_ratchet_key_hashes USING btree (conn_id, hash);
@@ -9,6 +9,14 @@ import Database.SQLite.Simple.QQ (sql)
m20260929_ratchet_indexes :: Query
m20260929_ratchet_indexes =
[sql|
DELETE FROM processed_ratchet_key_hashes AS h
WHERE EXISTS (
SELECT 1 FROM processed_ratchet_key_hashes d
WHERE d.conn_id = h.conn_id AND d.hash = h.hash AND d.processed_ratchet_key_hash_id < h.processed_ratchet_key_hash_id
);
DROP INDEX idx_processed_ratchet_key_hashes_hash;
CREATE UNIQUE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(conn_id, processed_ratchet_key_hash_id);
|]
@@ -16,4 +24,6 @@ down_m20260929_ratchet_indexes :: Query
down_m20260929_ratchet_indexes =
[sql|
DROP INDEX idx_processed_ratchet_key_hashes_conn_id;
DROP INDEX idx_processed_ratchet_key_hashes_hash;
CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
|]
@@ -573,10 +573,6 @@ CREATE INDEX idx_encrypted_rcv_message_hashes_hash ON encrypted_rcv_message_hash
conn_id,
hash
);
CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(
conn_id,
hash
);
CREATE INDEX idx_snd_messages_rcpt_internal_id ON snd_messages(
conn_id,
rcpt_internal_id
@@ -641,6 +637,10 @@ CREATE INDEX idx_connections_deleted ON connections(deleted);
CREATE INDEX idx_connections_service_request_expires_at ON connections(
service_request_expires_at
);
CREATE UNIQUE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(
conn_id,
hash
);
CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(
conn_id,
processed_ratchet_key_hash_id