agent: initialize ratchet on processing confirmation to support decryption of messages received before allowConnection; return SndQueueSecured from joinConnection, acceptContact (#1233)

2026-04-28 04:05:17 +00:00 · 2024-07-18 19:54:14 +04:00
parent 0de596dbcf
commit 7565ddd91c
6 changed files with 241 additions and 167 deletions
@@ -339,7 +339,7 @@ prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri
 prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs

 -- | Join SMP agent connection (JOIN command).
-joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
+joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
 joinConnection c userId Nothing enableNtfs = withAgentEnv c .:: joinConn c userId "" False enableNtfs
 joinConnection c userId (Just connId) enableNtfs = withAgentEnv c .:: joinConn c userId connId True enableNtfs
 {-# INLINE joinConnection #-}
@@ -350,7 +350,7 @@ allowConnection c = withAgentEnv c .:. allowConnection' c
 {-# INLINE allowConnection #-}

 -- | Accept contact after REQ notification (ACPT command)
-acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
+acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
 acceptContact c enableNtfs = withAgentEnv c .:: acceptContact' c "" enableNtfs
 {-# INLINE acceptContact #-}

@@ -783,7 +783,7 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of
          cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
      withStore c $ \db -> createNewConn db g cData SCMInvitation

-joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
+joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured)
 joinConn c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode = do
  srv <- case cReq of
    CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ ->
@@ -842,7 +842,7 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport
 versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_
 {-# INLINE versionPQSupport_ #-}

-joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ConnId
+joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, SndQueueSecured)
 joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv =
  withInvLock c (strEncode inv) "joinConnSrv" $ do
    (cData, q, _, rc, e2eSndParams) <- startJoinInvitation userId connId Nothing enableNtfs inv pqSup
@@ -859,7 +859,7 @@ joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo p
    -- otherwise we would need to manage retries here to avoid SndQueue recreated with a different key,
    -- similar to how joinConnAsync does that.
    tryError (secureConfirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case
-      Right _ -> pure connId'
+      Right sqSecured -> pure (connId', sqSecured)
      Left e -> do
        -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md
        void $ withStore' c $ \db -> deleteConn db Nothing connId'
@@ -869,10 +869,10 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo
    Just (qInfo, vrsn) -> do
      (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv
      void $ sendInvitation c userId qInfo vrsn cReq cInfo
-      pure connId'
+      pure (connId', False)
    Nothing -> throwE $ AGENT A_VERSION

-joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ()
+joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
 joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do
  SomeConn cType conn <- withStore c (`getConn` connId)
  case conn of
@@ -880,7 +880,7 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo
    SndConnection _ sq -> doJoin $ Just sq
    _ -> throwE $ CMD PROHIBITED $ "joinConnSrvAsync: bad connection " <> show cType
  where
-    doJoin :: Maybe SndQueue -> AM ()
+    doJoin :: Maybe SndQueue -> AM SndQueueSecured
    doJoin sq_ = do
      (cData, sq, _, rc, e2eSndParams) <- startJoinInvitation userId connId sq_ enableNtfs inv pqSupport
      sq' <- withStore c $ \db -> runExceptT $ do
@@ -907,18 +907,14 @@ createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVers
 allowConnection' :: AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
 allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConnection" $ do
  withStore c (`getConn` connId) >>= \case
-    SomeConn _ (RcvConnection _ rq@RcvQueue {server, rcvId, e2ePrivKey, smpClientVersion = v}) -> do
-      senderKey <- withStore c $ \db -> runExceptT $ do
-        AcceptedConfirmation {ratchetState, senderConf = SMPConfirmation {senderKey, e2ePubKey, smpClientVersion = v'}} <- ExceptT $ acceptConfirmation db confId ownConnInfo
-        liftIO $ createRatchet db connId ratchetState
-        let dhSecret = C.dh' e2ePubKey e2ePrivKey
-        liftIO $ setRcvQueueConfirmedE2E db rq dhSecret $ min v v'
-        pure senderKey
+    SomeConn _ (RcvConnection _ RcvQueue {server, rcvId}) -> do
+      AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <-
+        withStore c $ \db -> acceptConfirmation db confId ownConnInfo
      enqueueCommand c "" connId (Just server) . AInternalCommand $ ICAllowSecure rcvId senderKey
    _ -> throwE $ CMD PROHIBITED "allowConnection"

 -- | Accept contact (ACPT command) in Reader monad
-acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
+acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured)
 acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do
  Invitation {contactConnId, connReq} <- withStore c (`getInvitation` invId)
  withStore c (`getConn` contactConnId) >>= \case
@@ -1155,8 +1151,8 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do
          let initUsed = [qServer q]
          usedSrvs <- newTVarIO initUsed
          tryCommand . withNextSrv c userId usedSrvs initUsed $ \srv -> do
-            joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
-            notify OK
+            sqSecured <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
+            notify $ JOINED sqSecured
        LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
        ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
        SWCH ->
@@ -2492,6 +2488,18 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                          confId <- withStore c $ \db -> do
                            setConnAgentVersion db connId agentVersion
                            when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport'
+                            -- /
+                            -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion),
+                            -- initiating party initializes ratchet on processing confirmation;
+                            -- previously, it initialized ratchet on allowConnection;
+                            -- this is to support decryption of messages that may be received before allowConnection
+                            liftIO $ do
+                              createRatchet db connId rc'
+                              let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq
+                                  SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf
+                                  dhSecret = C.dh' e2ePubKey' e2ePrivKey'
+                              setRcvQueueConfirmedE2E db rq dhSecret $ min v v'
+                            -- /
                            createConfirmation db g newConfirmation
                          let srvs = map qServer $ smpReplyQueues senderConf
                          notify $ CONF confId pqSupport' srvs connInfo
@@ -2775,25 +2783,27 @@ connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _
    Just qInfo' -> do
      -- in case of SKEY retry the connection is already duplex
      sq' <- maybe upgradeConn pure sq_
-      agentSecureSndQueue c sq'
+      void $ agentSecureSndQueue c cData sq'
      enqueueConfirmation c cData sq' ownConnInfo Nothing
      where
        upgradeConn = do
          (sq, _) <- lift $ newSndQueue userId connId qInfo'
          withStore c $ \db -> upgradeRcvConnToDuplex db connId sq

-secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
+secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
 secureConfirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do
-  agentSecureSndQueue c sq
+  sqSecured <- agentSecureSndQueue c cData sq
  storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode
  lift $ submitPendingMsg c cData sq
+  pure sqSecured

-secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM ()
+secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
 secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do
-  agentSecureSndQueue c sq
+  sqSecured <- agentSecureSndQueue c cData sq
  msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode
  void $ sendConfirmation c sq msg
  withStore' c $ \db -> setSndQueueStatus db sq Confirmed
+  pure sqSecured
  where
    mkConfirmation :: AgentMessage -> AM MsgBody
    mkConfirmation aMessage = do
@@ -2806,11 +2816,17 @@ secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv
        (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion
        pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo}

-agentSecureSndQueue :: AgentClient -> SndQueue -> AM ()
-agentSecureSndQueue c sq@SndQueue {sndSecure, status} =
-  when (sndSecure && status == New) $ do
-    secureSndQueue c sq
-    withStore' c $ \db -> setSndQueueStatus db sq Secured
+agentSecureSndQueue :: AgentClient -> ConnData -> SndQueue -> AM SndQueueSecured
+agentSecureSndQueue c ConnData {connAgentVersion} sq@SndQueue {sndSecure, status}
+  | sndSecure && status == New = do
+      secureSndQueue c sq
+      withStore' c $ \db -> setSndQueueStatus db sq Secured
+      pure initiatorRatchetOnConf
+  -- on repeat JOIN processing (e.g. previous attempt to create reply queue failed)
+  | sndSecure && status == Secured = pure initiatorRatchetOnConf
+  | otherwise = pure False
+  where
+    initiatorRatchetOnConf = connAgentVersion >= ratchetOnConfSMPAgentVersion

 mkAgentConfirmation :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> AM AgentMessage
 mkAgentConfirmation c cData sq srv connInfo subMode = do
@@ -42,6 +42,7 @@ module Simplex.Messaging.Agent.Protocol
    deliveryRcptsSMPAgentVersion,
    pqdrSMPAgentVersion,
    sndAuthKeySMPAgentVersion,
+    ratchetOnConfSMPAgentVersion,
    currentSMPAgentVersion,
    supportedSMPAgentVRange,
    e2eEncConnInfoLength,
@@ -49,6 +50,7 @@ module Simplex.Messaging.Agent.Protocol

    -- * SMP agent protocol types
    ConnInfo,
+    SndQueueSecured,
    ACommand (..),
    AEvent (..),
    AEvt (..),
@@ -257,11 +259,14 @@ pqdrSMPAgentVersion = VersionSMPA 5
 sndAuthKeySMPAgentVersion :: VersionSMPA
 sndAuthKeySMPAgentVersion = VersionSMPA 6

+ratchetOnConfSMPAgentVersion :: VersionSMPA
+ratchetOnConfSMPAgentVersion = VersionSMPA 7
+
 minSupportedSMPAgentVersion :: VersionSMPA
 minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion

 currentSMPAgentVersion :: VersionSMPA
-currentSMPAgentVersion = VersionSMPA 6
+currentSMPAgentVersion = VersionSMPA 7

 supportedSMPAgentVRange :: VersionRangeSMPA
 supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPAgentVersion
@@ -327,6 +332,8 @@ deriving instance Show AEvt

 type ConnInfo = ByteString

+type SndQueueSecured = Bool
+
 -- | Parameterized type for SMP agent events
 data AEvent (e :: AEntity) where
  INV :: AConnectionRequestUri -> AEvent AEConn
@@ -354,6 +361,7 @@ data AEvent (e :: AEntity) where
  DEL_USER :: Int64 -> AEvent AENone
  STAT :: ConnectionStats -> AEvent AEConn
  OK :: AEvent AEConn
+  JOINED :: SndQueueSecured -> AEvent AEConn
  ERR :: AgentErrorType -> AEvent AEConn
  SUSPENDED :: AEvent AENone
  RFPROG :: Int64 -> Int64 -> AEvent AERcvFile
@@ -422,6 +430,7 @@ data AEventTag (e :: AEntity) where
  DEL_USER_ :: AEventTag AENone
  STAT_ :: AEventTag AEConn
  OK_ :: AEventTag AEConn
+  JOINED_ :: AEventTag AEConn
  ERR_ :: AEventTag AEConn
  SUSPENDED_ :: AEventTag AENone
  -- XFTP commands and responses
@@ -474,6 +483,7 @@ aEventTag = \case
  DEL_USER _ -> DEL_USER_
  STAT _ -> STAT_
  OK -> OK_
+  JOINED _ -> JOINED_
  ERR _ -> ERR_
  SUSPENDED -> SUSPENDED_
  RFPROG {} -> RFPROG_