agent: attempt at faster queue rotation (does not work)

protocol/diagrams/duplex-messaging/queue-rotation-fast.mmd

@@ -9,8 +9,8 @@ sequenceDiagram
   A ->> S: SEND: QADD (R'): send address<br>of the new queue(s)
   S ->> B: MSG: QADD (R')
   B ->> R': SKEY: secure new queue
-  B ->> R': SEND: QTEST
-  R' ->> A: MSG: QTEST
+  B ->> R': SEND: QSEC: to agree shared secret
+  R' ->> A: MSG: QSEC
   A ->> R: DEL: delete the old queue
   B ->> R': SEND: send messages to the new queue
   R' ->> A: MSG: receive messages from the new queue

rfcs/2024-06-14-fast-connection.md

@@ -31,12 +31,18 @@ These are the proposed changes:
 5. Accepting client will secure the messaging queue before sending the confirmation to it.
 6. Initiating client will secure the messaging queue before sending the confirmation.
 
-See [this sequence diagram](../protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd) for the updated handshake protocol.
+See [this sequence diagram](../protocol/diagrams/duplex-messaging/duplex-creating-fast.mmd) for the updated handshake protocol.
 
 Changes to threat model: the attacker who compromised TLS and knows the queue address can block the connection, as the protocol no longer requires the recipient to decrypt the confirmation to secure the queue.
 
 Possibly, "fast connection" should be an option in Privacy & security settings.
 
+## Queue rotation
+
+It is possible to design a faster connection rotation protocol that also uses only 2 instead of 4 messages, QADD and SMP confirmation (to agree per-queue encryption) - it would require to stop delivery to the old queue as soon as QSEC message is sent, without any additional test messages.
+
+It would also require sending a new message envelope with the DH key in the public header instead of the usual confirmation message or a normal message.
+
 ## Implementation questions
 
 Currently we store received confirmations in the database, so that the client can confirm them. This becomes unnecessary.

src/Simplex/Messaging/Agent.hs

@@ -14,7 +14,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 -- |
 -- Module      : Simplex.Messaging.Agent
@@ -224,7 +224,7 @@
         atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ CRITICAL True $ show e)
 
 logServersStats :: AgentClient -> AM' ()
 logServersStats c = do
   delay <- asks (initialLogStatsDelay . config)
   liftIO $ threadDelay' delay
   int <- asks (logStatsInterval . config)
@@ -233,7 +233,7 @@
     liftIO $ threadDelay' int
 
 saveServersStats :: AgentClient -> AM' ()
 saveServersStats c@AgentClient {subQ, smpServersStats, xftpServersStats} = do
   -- sss <- mapM (lift . getAgentSMPServerStats) =<< readTVarIO smpServersStats
   -- xss <- mapM (lift . getAgentXFTPServerStats) =<< readTVarIO xftpServersStats
   -- let stats = AgentPersistedServerStats {smpServersStats = sss, xftpServersStats = xss}
@@ -243,7 +243,7 @@
   pure ()
 
 restoreServersStats :: AgentClient -> AM' ()
 restoreServersStats c@AgentClient {smpServersStats, xftpServersStats, srvStatsStartedAt} = do
   tryAgentError' (withStore c getServersStats) >>= \case
     Left e -> atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ INTERNAL $ show e)
     Right (startedAt, Nothing) -> atomically $ writeTVar srvStatsStartedAt startedAt
@@ -1195,6 +1195,25 @@
                     notify . SWITCH QDRcv SPSecured $ connectionStats conn'
                   _ -> internalErr "ICQSecure: no switching queue found"
               _ -> internalErr "ICQSecure: queue address not found in connection"
+        ICQSndSecure sId ->
+          withServer $ \srv -> tryWithLock "ICQSndSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
+            case find (sameQueue (srv, sId)) sqs of
+              Just sq'@SndQueue {server, sndId, sndSecure, status, smpClientVersion, e2ePubKey = Just dhPublicKey, dbReplaceQueueId = Just replaceQId} ->
+                case find ((replaceQId ==) . dbQId) sqs of
+                  Just sq1 -> when (status == New) $ do
+                    secureSndQueue c sq'
+                    withStore' c $ \db -> setSndQueueStatus db sq' Secured
+                    let sq'' = (sq' :: SndQueue) {status = Secured}
+                        queueAddress = SMPQueueAddress {smpServer = server, senderId = sndId, dhPublicKey, sndSecure}
+                        qInfo = SMPQueueInfo {clientVersion = smpClientVersion, queueAddress}
+                    -- sending QSEC to the new queue only, the old one will be removed if sent successfully
+                    void . enqueueMessages c cData [sq''] SMP.noMsgFlags $ QSEC [qInfo]
+                    sq1' <- withStore' c $ \db -> setSndSwitchStatus db sq1 $ Just SSSendingQSEC
+                    let sqs' = updatedQs sq1' sqs
+                        conn' = DuplexConnection cData rqs sqs'
+                    notify . SWITCH QDSnd SPCompleted $ connectionStats conn'
+                  _ -> internalErr "ICQSndSecure: no switching queue found"
+              _ -> internalErr "ICQSndSecure: queue address not found in connection"
         ICQDelete rId -> do
           withServer $ \srv -> tryWithLock "ICQDelete" . withDuplexConn $ \(DuplexConnection cData rqs sqs) -> do
             case removeQ (srv, rId) rqs of
@@ -1393,6 +1412,7 @@
                     AM_QCONT_ -> notifyDel msgId err
                     AM_QADD_ -> qError msgId "QADD: AUTH"
                     AM_QKEY_ -> qError msgId "QKEY: AUTH"
+                    AM_QSEC_ -> qError msgId "QKEY: AUTH"
                     AM_QUSE_ -> qError msgId "QUSE: AUTH"
                     AM_QTEST_ -> qError msgId "QTEST: AUTH"
                     AM_EREADY_ -> notifyDel msgId err
@@ -1446,8 +1466,13 @@
                 AM_QKEY_ -> do
                   SomeConn _ conn <- withStore c (`getConn` connId)
                   notify . SWITCH QDSnd SPConfirmed $ connectionStats conn
+                AM_QSEC_ -> withConnLock c connId "runSmpQueueMsgDelivery AM_QSEC_" $ completeConnSwitch "QSEC" SSSendingQSEC
                 AM_QUSE_ -> pure ()
-                AM_QTEST_ -> withConnLock c connId "runSmpQueueMsgDelivery AM_QTEST_" $ do
+                AM_QTEST_ -> withConnLock c connId "runSmpQueueMsgDelivery AM_QTEST_" $ completeConnSwitch "QTEST" SSSendingQTEST
+                AM_EREADY_ -> pure ()
+              delMsgKeep (msgType == AM_A_MSG_) msgId
+              where
+                completeConnSwitch msgTag expectedStatus = do
                   withStore' c $ \db -> setSndQueueStatus db sq Active
                   SomeConn _ conn <- withStore c (`getConn` connId)
                   case conn of
@@ -1459,9 +1484,9 @@
                         Just SndQueue {dbReplaceQueueId = Just replacedId, primary} ->
                           -- second part of this condition is a sanity check because dbReplaceQueueId cannot point to the same queue, see switchConnection'
                           case removeQP (\sq' -> dbQId sq' == replacedId && not (sameQueue addr sq')) sqs of
-                            Nothing -> internalErr msgId "sent QTEST: queue not found in connection"
+                            Nothing -> internalErr msgId $ "sent " <> msgTag <> ": queue not found in connection"
                             Just (sq', sq'' : sqs') -> do
-                              checkSQSwchStatus sq' SSSendingQTEST
+                              checkSQSwchStatus sq' expectedStatus
                               -- remove the delivery from the map to stop the thread when the delivery loop is complete
                               atomically $ TM.delete (qAddress sq') $ smpDeliveryWorkers c
                               withStore' c $ \db -> do
@@ -1471,12 +1496,9 @@
                               let sqs'' = sq'' :| sqs'
                                   conn' = DuplexConnection cData' rqs sqs''
                               notify . SWITCH QDSnd SPCompleted $ connectionStats conn'
-                            _ -> internalErr msgId "sent QTEST: there is only one queue in connection"
-                        _ -> internalErr msgId "sent QTEST: queue not in connection or not replacing another queue"
-                    _ -> internalErr msgId "QTEST sent not in duplex connection"
-                AM_EREADY_ -> pure ()
-              delMsgKeep (msgType == AM_A_MSG_) msgId
-              where
+                            _ -> internalErr msgId $ "sent " <> msgTag <> ": there is only one queue in connection"
+                        _ -> internalErr msgId $ "sent " <> msgTag <> ": queue not in connection or not replacing another queue"
+                    _ -> internalErr msgId $ msgTag <> " sent not in duplex connection"
                 setStatus status = do
                   withStore' c $ \db -> do
                     setSndQueueStatus db sq status
@@ -2249,8 +2271,9 @@
                           (DuplexConnection _ rqs _, Just replacedId) -> do
                             when primary . withStore' c $ \db -> setRcvQueuePrimary db connId rq
                             case find ((replacedId ==) . dbQId) rqs of
-                              Just rq'@RcvQueue {server, rcvId} -> do
-                                checkRQSwchStatus rq' RSSendingQUSE
+                              Just rq'@RcvQueue {server, rcvId, rcvSwchStatus} -> do
+                                unless (rcvSwchStatus == Just RSSendingQUSE || rcvSwchStatus == Just RSSendingQADD) $
+                                  switchStatusError rq RSSendingQUSE rcvSwchStatus
                                 void $ withStore' c $ \db -> setRcvSwitchStatus db rq' $ Just RSReceivedMessage
                                 enqueueCommand c "" connId (Just server) $ AInternalCommand $ ICQDelete rcvId
                               _ -> notify . ERR . AGENT $ A_QUEUE "replaced RcvQueue not found in connection"
@@ -2271,6 +2294,7 @@
                               A_QCONT addr -> qDuplexAckDel conn'' "QCONT" $ continueSending srvMsgId addr
                               QADD qs -> qDuplexAckDel conn'' "QADD" $ qAddMsg srvMsgId qs
                               QKEY qs -> qDuplexAckDel conn'' "QKEY" $ qKeyMsg srvMsgId qs
+                              QSEC qs -> qDuplexAckDel conn'' "QSEC" $ qSecMsg srvMsgId qs
                               QUSE qs -> qDuplexAckDel conn'' "QUSE" $ qUseMsg srvMsgId qs
                               -- no action needed for QTEST
                               -- any message in the new queue will mark it active and trigger deletion of the old queue
@@ -2543,14 +2567,20 @@
                     let (delSqs, keepSqs) = L.partition ((Just dbQueueId ==) . dbReplaceQId) sqs
                     case L.nonEmpty keepSqs of
                       Just sqs' -> do
-                        (sq_@SndQueue {sndPublicKey}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo
+                        (sq_@SndQueue {sndId, sndPublicKey, sndSecure = sndSecure'}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo
                         sq2 <- withStore c $ \db -> do
                           liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
                           addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
                         logServer "<--" c srv rId $ "MSG <QADD>:" <> logSecret srvMsgId <> " " <> logSecret (senderId queueAddress)
-                        let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
-                        void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPublicKey)]
-                        sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
+                        sq1 <-
+                          if sndSecure'
+                            then do
+                              enqueueCommand c "" connId (Just $ qServer sq2) $ AInternalCommand $ ICQSndSecure sndId
+                              withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSecuringQueue
+                            else do
+                              let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
+                              void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', sndPublicKey)]
+                              withStore' c $ \db -> setSndSwitchStatus db sq $ Just SSSendingQKEY
                         let sqs'' = updatedQs sq1 sqs' <> [sq2]
                             conn' = DuplexConnection cData' rqs sqs''
                         notify . SWITCH QDSnd SPStarted $ connectionStats conn'
@@ -2578,6 +2608,24 @@
             where
               SMPQueueInfo cVer' SMPQueueAddress {smpServer, senderId, dhPublicKey} = qInfo
 
+          qSecMsg :: SMP.MsgId -> NonEmpty SMPQueueInfo -> Connection 'CDuplex -> AM ()
+          qSecMsg srvMsgId (qInfo :| _) conn'@(DuplexConnection cData' rqs _) = do
+            when (ratchetSyncSendProhibited cData') $ throwE $ AGENT (A_QUEUE "ratchet is not synchronized")
+            clientVRange <- asks $ smpClientVRange . config
+            unless (qInfo `isCompatible` clientVRange) . throwE $ AGENT A_VERSION
+            case findRQ (smpServer, senderId) rqs of
+              Just rq'@RcvQueue {e2ePrivKey = dhPrivKey, smpClientVersion = cVer, status = status'}
+                | status' == New || status' == Confirmed -> do
+                    checkRQSwchStatus rq RSSendingQADD
+                    logServer "<--" c srv rId $ "MSG <QSEC>:" <> logSecret srvMsgId <> " " <> logSecret senderId
+                    let dhSecret = C.dh' dhPublicKey dhPrivKey
+                    withStore' c $ \db -> setRcvQueueConfirmedE2E db rq' dhSecret $ min cVer cVer'
+                    notify . SWITCH QDRcv SPCompleted $ connectionStats conn'
+                | otherwise -> qError "QSEC: queue already secured"
+              _ -> qError "QSEC: queue address not found in connection"
+            where
+              SMPQueueInfo cVer' SMPQueueAddress {smpServer, senderId, dhPublicKey} = qInfo
+
           -- processed by queue sender
           -- mark queue as Secured and to start sending messages to it
           qUseMsg :: SMP.MsgId -> NonEmpty ((SMPServer, SMP.SenderId), Bool) -> Connection 'CDuplex -> AM ()

src/Simplex/Messaging/Agent/Protocol.hs

@@ -526,16 +526,22 @@ instance FromJSON RcvSwitchStatus where
 data SndSwitchStatus
   = SSSendingQKEY
   | SSSendingQTEST
+  | SSSecuringQueue
+  | SSSendingQSEC
   deriving (Eq, Show)
 
 instance StrEncoding SndSwitchStatus where
   strEncode = \case
     SSSendingQKEY -> "sending_qkey"
     SSSendingQTEST -> "sending_qtest"
+    SSSecuringQueue -> "securing_queue"
+    SSSendingQSEC -> "sending_qsec"
   strP =
     A.takeTill (== ' ') >>= \case
       "sending_qkey" -> pure SSSendingQKEY
       "sending_qtest" -> pure SSSendingQTEST
+      "securing_queue" -> pure SSSecuringQueue
+      "sending_qsec" -> pure SSSendingQSEC
       _ -> fail "bad SndSwitchStatus"
 
 instance ToField SndSwitchStatus where toField = toField . decodeLatin1 . strEncode
@@ -795,6 +801,7 @@ data AgentMessageType
   | AM_QCONT_
   | AM_QADD_
   | AM_QKEY_
+  | AM_QSEC_
   | AM_QUSE_
   | AM_QTEST_
   | AM_EREADY_
@@ -811,6 +818,7 @@ instance Encoding AgentMessageType where
     AM_QCONT_ -> "QC"
     AM_QADD_ -> "QA"
     AM_QKEY_ -> "QK"
+    AM_QSEC_ -> "QS"
     AM_QUSE_ -> "QU"
     AM_QTEST_ -> "QT"
     AM_EREADY_ -> "E"
@@ -827,6 +835,7 @@ instance Encoding AgentMessageType where
           'C' -> pure AM_QCONT_
           'A' -> pure AM_QADD_
           'K' -> pure AM_QKEY_
+          'S' -> pure AM_QSEC_
           'U' -> pure AM_QUSE_
           'T' -> pure AM_QTEST_
           _ -> fail "bad AgentMessageType"
@@ -849,6 +858,7 @@ agentMessageType = \case
     A_QCONT _ -> AM_QCONT_
     QADD _ -> AM_QADD_
     QKEY _ -> AM_QKEY_
+    QSEC _ -> AM_QSEC_
     QUSE _ -> AM_QUSE_
     QTEST _ -> AM_QTEST_
     EREADY _ -> AM_EREADY_
@@ -873,6 +883,7 @@ data AMsgType
   | A_QCONT_
   | QADD_
   | QKEY_
+  | QSEC_
   | QUSE_
   | QTEST_
   | EREADY_
@@ -886,6 +897,7 @@ instance Encoding AMsgType where
     A_QCONT_ -> "QC"
     QADD_ -> "QA"
     QKEY_ -> "QK"
+    QSEC_ -> "QS"
     QUSE_ -> "QU"
     QTEST_ -> "QT"
     EREADY_ -> "E"
@@ -899,6 +911,7 @@ instance Encoding AMsgType where
           'C' -> pure A_QCONT_
           'A' -> pure QADD_
           'K' -> pure QKEY_
+          'S' -> pure QSEC_
           'U' -> pure QUSE_
           'T' -> pure QTEST_
           _ -> fail "bad AMsgType"
@@ -921,6 +934,10 @@ data AMessage
     QADD (NonEmpty (SMPQueueUri, Maybe SndQAddr))
   | -- key to secure the added queues and agree e2e encryption key (sent by sender)
     QKEY (NonEmpty (SMPQueueInfo, SndPublicAuthKey))
+  | -- sent by the sender who secured the queue with SKEY (SMP protocol v9).
+    -- This message is needed to agree shared secret - it completes switching.
+    -- This message requires a new envelope that is sent together with public DH key.
+    QSEC (NonEmpty SMPQueueInfo)
   | -- inform that the queues are ready to use (sent by recipient)
     QUSE (NonEmpty (SndQAddr, Bool))
   | -- sent by the sender to test new queues and to complete switching
@@ -977,6 +994,7 @@ instance Encoding AMessage where
     A_QCONT addr -> smpEncode (A_QCONT_, addr)
     QADD qs -> smpEncode (QADD_, qs)
     QKEY qs -> smpEncode (QKEY_, qs)
+    QSEC qs -> smpEncode (QSEC_, qs)
     QUSE qs -> smpEncode (QUSE_, qs)
     QTEST qs -> smpEncode (QTEST_, qs)
     EREADY lastDecryptedMsgId -> smpEncode (EREADY_, lastDecryptedMsgId)
@@ -989,6 +1007,7 @@ instance Encoding AMessage where
         A_QCONT_ -> A_QCONT <$> smpP
         QADD_ -> QADD <$> smpP
         QKEY_ -> QKEY <$> smpP
+        QSEC_ -> QSEC <$> smpP
         QUSE_ -> QUSE <$> smpP
         QTEST_ -> QTEST <$> smpP
         EREADY_ -> EREADY <$> smpP

src/Simplex/Messaging/Agent/Store.hs

@@ -382,6 +382,7 @@ data InternalCommand
   | ICDeleteConn
   | ICDeleteRcvQueue SMP.RecipientId
   | ICQSecure SMP.RecipientId SMP.SndPublicAuthKey
+  | ICQSndSecure SMP.SenderId
   | ICQDelete SMP.RecipientId
 
 data InternalCommandTag
@@ -392,6 +393,7 @@ data InternalCommandTag
   | ICDeleteConn_
   | ICDeleteRcvQueue_
   | ICQSecure_
+  | ICQSndSecure_
   | ICQDelete_
   deriving (Show)
 
@@ -404,6 +406,7 @@ instance StrEncoding InternalCommand where
     ICDeleteConn -> strEncode ICDeleteConn_
     ICDeleteRcvQueue rId -> strEncode (ICDeleteRcvQueue_, rId)
     ICQSecure rId senderKey -> strEncode (ICQSecure_, rId, senderKey)
+    ICQSndSecure sId -> strEncode (ICQSndSecure_, sId)
     ICQDelete rId -> strEncode (ICQDelete_, rId)
   strP =
     strP >>= \case
@@ -414,6 +417,7 @@ instance StrEncoding InternalCommand where
       ICDeleteConn_ -> pure ICDeleteConn
       ICDeleteRcvQueue_ -> ICDeleteRcvQueue <$> _strP
       ICQSecure_ -> ICQSecure <$> _strP <*> _strP
+      ICQSndSecure_ -> ICQSndSecure <$> _strP
       ICQDelete_ -> ICQDelete <$> _strP
 
 instance StrEncoding InternalCommandTag where
@@ -425,6 +429,7 @@ instance StrEncoding InternalCommandTag where
     ICDeleteConn_ -> "DELETE_CONN"
     ICDeleteRcvQueue_ -> "DELETE_RCV_QUEUE"
     ICQSecure_ -> "QSECURE"
+    ICQSndSecure_ -> "QSND_SECURE"
     ICQDelete_ -> "QDELETE"
   strP =
     A.takeTill (== ' ') >>= \case
@@ -435,6 +440,7 @@ instance StrEncoding InternalCommandTag where
       "DELETE_CONN" -> pure ICDeleteConn_
       "DELETE_RCV_QUEUE" -> pure ICDeleteRcvQueue_
       "QSECURE" -> pure ICQSecure_
+      "QSND_SECURE" -> pure ICQSndSecure_
       "QDELETE" -> pure ICQDelete_
       _ -> fail "bad InternalCommandTag"
 
@@ -452,6 +458,7 @@ internalCmdTag = \case
   ICDeleteConn -> ICDeleteConn_
   ICDeleteRcvQueue {} -> ICDeleteRcvQueue_
   ICQSecure {} -> ICQSecure_
+  ICQSndSecure {} -> ICQSndSecure_
   ICQDelete _ -> ICQDelete_
 
 -- * Confirmation types