agent: PQ rachet security code, store AD and pqAD in database, bulk reading (#1874)

* agent: PQ rachet security code, store AD and pqAD in database, bulk reading

* rename to verify code

* diff

* refactor

* query

* reduce transactions

* request binding

* simplify

* fix query and security code derivation

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>

src/Simplex/Messaging/Agent.hs

@@ -106,7 +106,8 @@ module Simplex.Messaging.Agent
     deleteConnection,
     deleteConnections,
     getConnectionServers,
-    getConnectionRatchetAdHash,
+    getConnectionVerifyCodes,
+    getConnectionsVerifyCodes,
     setProtocolServers,
     setUserEntitlement,
     checkUserServers,
@@ -484,12 +485,12 @@ changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConne
 -- the caller of joinConnection saves connection ID to the database.
 -- Instead of it we could send confirmation asynchronously, but then it would be harder to report
 -- "link deleted" (SMP AUTH) interactively, so this approach is simpler overall.
-prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> PQSupport -> AE ConnId
+prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> PQSupport -> AE (ConnId, ContactRequestBinding)
 prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs Nothing
 {-# INLINE prepareConnectionToJoin #-}
 
 -- | Create SMP agent connection without queue (to be joined with acceptContact passing invitation ID).
-prepareConnectionToAccept :: AgentClient -> UserId -> Bool -> InvitationId -> PQSupport -> AE ConnId
+prepareConnectionToAccept :: AgentClient -> UserId -> Bool -> InvitationId -> PQSupport -> AE (ConnId, ContactRequestBinding)
 prepareConnectionToAccept c userId enableNtfs = withAgentEnv c .: newConnToAccept c userId "" enableNtfs
 {-# INLINE prepareConnectionToAccept #-}
 
@@ -673,9 +674,13 @@ getConnectionServers c = withAgentEnv c . getConnectionServers' c
 {-# INLINE getConnectionServers #-}
 
 -- | get connection ratchet associated data hash for verification (should match peer AD hash)
-getConnectionRatchetAdHash :: AgentClient -> ConnId -> AE ByteString
-getConnectionRatchetAdHash c = withAgentEnv c . getConnectionRatchetAdHash' c
-{-# INLINE getConnectionRatchetAdHash #-}
+getConnectionVerifyCodes :: AgentClient -> ConnId -> AE ConnVerifyCodes
+getConnectionVerifyCodes c = withAgentEnv c . getConnectionVerifyCodes' c
+{-# INLINE getConnectionVerifyCodes #-}
+
+getConnectionsVerifyCodes :: AgentClient -> [ConnId] -> AE (Map ConnId ConnVerifyCodes)
+getConnectionsVerifyCodes c = withAgentEnv c . getConnectionsVerifyCodes' c
+{-# INLINE getConnectionsVerifyCodes #-}
 
 -- | Test protocol server
 testProtocolServer :: forall p. ProtocolTypeI p => AgentClient -> NetworkRequestMode -> UserId -> ProtoServerWithAuth p -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
@@ -1311,8 +1316,13 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
         SCMInvitation -> do
           g <- asks random
           let pqEnc = CR.initialPQEncryption (isJust userLinkData_) pqInitKeys
-          (pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
-          withStore' c $ \db -> createRatchetX3dhKeys db connId pks
+          e2eRcvParams <- withStore' c $ \db -> do
+            lockConnForUpdate db connId
+            getRatchetX3dhKeys db connId >>= \case
+              Right keys -> pure $ CR.mkRcvE2ERatchetParams (maxVersion e2eEncryptVRange) keys
+              Left _ -> do
+                (pks, e2eRcvParams) <- CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
+                e2eRcvParams <$ createRatchetX3dhKeys db connId pks
           pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange
     setLinkDataRatchetKeys :: Maybe AddressRatchetKeys -> UserConnLinkData c -> UserConnLinkData c
     setLinkDataRatchetKeys ks = \case
@@ -1370,30 +1380,47 @@ newQueueNtfSubscription c RcvQueue {userId, connId, server, clientNtfCreds} ntfS
   ns <- asks ntfSupervisor
   liftIO $ sendNtfSubCommand ns (NSCCreate, [connId])
 
-newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> Maybe UTCTime -> ConnectionRequestUri c -> PQSupport -> AM ConnId
+newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> Maybe UTCTime -> ConnectionRequestUri c -> PQSupport -> AM (ConnId, ContactRequestBinding)
 newConnToJoin c userId connId enableNtfs serviceRequestExpiresAt cReq pqSupport = case cReq of
   CRInvitationUri {} ->
     lift (compatibleInvitationUri cReq) >>= \case
-      Just (_, _, aVersion) -> create aVersion
+      Just (_, Compatible e2eRcvParams, aVersion) -> create aVersion $ Right e2eRcvParams
       Nothing -> throwE $ AGENT A_VERSION
   CRContactUri {} ->
     lift (compatibleContactUri cReq) >>= \case
-      Just (_, _, aVersion) -> create aVersion
+      Just (Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {senderId}}, ratchet_, aVersion) ->
+        create aVersion $ case ratchet_ of
+          Just (_, Compatible e2eRcvParams) -> Right e2eRcvParams
+          Nothing -> Left senderId
       Nothing -> throwE $ AGENT A_VERSION
   where
-    create :: Compatible VersionSMPA -> AM ConnId
-    create (Compatible connAgentVersion) = do
+    create :: Compatible VersionSMPA -> Either SMP.SenderId (CR.RcvE2ERatchetParams 'C.X448) -> AM (ConnId, ContactRequestBinding)
+    create (Compatible connAgentVersion) addrOrParams = do
       g <- asks random
+      maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
       let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport, serviceRequestExpiresAt}
-      withStore c $ \db -> createNewConn db g cData SCMInvitation
+      withStore c $ \db -> runExceptT $ do
+        connId' <- ExceptT $ createNewConn db g cData SCMInvitation
+        binding <- case addrOrParams of
+          Right e2eRcvParams -> CRBRatchet . ratchetVerifyCodes . fst <$> createRatchet_ db g connId' maxSupported pqSupport e2eRcvParams
+          Left senderId -> do
+            let pqEnc = CR.initialPQEncryption False $ CR.joinContactInitialKeys pqSupport
+            (pks, CR.E2ERatchetParams _ k1 k2 kem_) <- liftIO $ CR.generateRcvE2EParams g maxSupported pqEnc
+            liftIO $ CRBRequest (requestCode k1 k2 kem_ senderId) <$ createRatchetX3dhKeys db connId' pks
+        pure (connId', binding)
 
-newConnToAccept :: AgentClient -> UserId -> ConnId -> Bool -> InvitationId -> PQSupport -> AM ConnId
+requestCode :: C.PublicKeyX448 -> C.PublicKeyX448 -> Maybe (CR.RKEMParams 'CR.RKSProposed) -> SMP.SenderId -> ByteString
+requestCode k1 k2 kem_ sndId = C.sha256Hash $ smpEncode (k1, k2, kem_, sndId)
+
+newConnToAccept :: AgentClient -> UserId -> ConnId -> Bool -> InvitationId -> PQSupport -> AM (ConnId, ContactRequestBinding)
 newConnToAccept c userId connId enableNtfs invId pqSup = do
   Invitation {connReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId
   case connReq of
     CRInvitation cReq -> newConnToJoin c userId connId enableNtfs Nothing cReq pqSup
-    CRInvitationDR dr -> (\ConnData {connId = connId'} -> connId') <$> newConnToAcceptDR c userId connId dr enableNtfs
-      
+    CRInvitationDR dr@DRInvitation {ratchetState} -> do
+      ConnData {connId = connId'} <- newConnToAcceptDR c userId connId dr enableNtfs
+      pure (connId', CRBRatchet $ ratchetVerifyCodes ratchetState)
+
 newConnToAcceptDR :: AgentClient -> UserId -> ConnId -> DRInvitation -> Bool -> AM ConnData
 newConnToAcceptDR c userId connId DRInvitation {agentVersion, pqSupport} enableNtfs = do
   g <- asks random
@@ -1436,7 +1463,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSupport =
           (q, _) <- lift $ newSndQueue userId "" qInfo sndKey_
           withStore c $ \db -> runExceptT $ do
             liftIO $ lockConnForUpdate db connId
-            e2eSndParams <- snd <$> createRatchet_ db g connId maxSupported pqSupport e2eRcvParams
+            (_, e2eSndParams) <- liftIO (getSndRatchet db connId v) >>= either (const $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams) pure
             sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
             pure ((cData, sq'), (Just e2eSndParams, lnkId_))
     Nothing -> throwE $ AGENT A_VERSION
@@ -1729,7 +1756,7 @@ serviceRequest_ c userId cReqUri@(CRContactUri _ addrKeys_) timeout_ doSend = do
   when (isNothing addrKeys_) $ throwE $ AGENT $ A_SERVICE ASENotDRAddress
   reqTimeout <- maybe (asks $ serviceRequestTimeout . config) pure timeout_
   expiresAt <- addUTCTime reqTimeout <$> liftIO getCurrentTime
-  connId <- newConnToJoin c userId "" False (Just expiresAt) cReqUri PQSupportOn
+  (connId, _) <- newConnToJoin c userId "" False (Just expiresAt) cReqUri PQSupportOn
   var <- atomically newEmptyTMVar
   atomically $ TM.insert connId var (serviceRequests c)
   r <- tryAllErrors $ do
@@ -2989,10 +3016,12 @@ getConnectionServers' c connId = do
   SomeConn _ conn <- withStore c (`getConn` connId)
   connectionStats c conn
 
-getConnectionRatchetAdHash' :: AgentClient -> ConnId -> AM ByteString
-getConnectionRatchetAdHash' c connId = do
-  CR.Ratchet {rcAD = Str rcAD} <- withStore c (`getRatchet` connId)
-  pure $ C.sha256Hash rcAD
+getConnectionVerifyCodes' :: AgentClient -> ConnId -> AM ConnVerifyCodes
+getConnectionVerifyCodes' c connId =
+  getConnectionsVerifyCodes' c [connId] >>= maybe (throwE $ CONN NOT_FOUND "") pure . M.lookup connId
+
+getConnectionsVerifyCodes' :: AgentClient -> [ConnId] -> AM (Map ConnId ConnVerifyCodes)
+getConnectionsVerifyCodes' c connIds = withStore' c (`getRatchetVerifyCodes` connIds)
 
 connectionStats :: AgentClient -> Connection c -> AM ConnectionStats
 connectionStats c = \case
@@ -4040,14 +4069,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
               enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} (EREADY lastExternalSndId)
 
           smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM ()
-          smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData _) cInfo = do
+          smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData (CR.E2ERatchetParamsUri _ k1 k2 kem_)) cInfo = do
             logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' srvMsgId
             case conn' of
-              ContactConnection {} -> do
+              ContactConnection _ RcvQueue {sndId} -> do
                 -- show connection request even if invitaion via contact address is not compatible.
                 invId <- storeInvitation (CRInvitation connReq) cInfo False
                 let srvs = L.map qServer $ crSmpQueues crData
-                notify $ REQ invId PQSupportOn srvs cInfo False
+                notify $ REQ invId PQSupportOn srvs cInfo (CRBRequest $ requestCode k1 k2 kem_ sndId) False
               _ -> prohibited "inv: sent to message conn"
 
           storeInvitation :: ContactRequest -> ConnInfo -> Bool -> AM InvitationId
@@ -4074,7 +4103,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                           parseMessage "3" agentMsgBody >>= \case
                             AgentConnInfoReply (replyQueue :| _) cInfo -> do
                               invId <- storeInvitation (CRInvitationDR $ mkDR replyQueue) cInfo False
-                              notify $ REQ invId PQSupportOn (qServer replyQueue :| []) cInfo True
+                              notify $ REQ invId PQSupportOn (qServer replyQueue :| []) cInfo (CRBRatchet $ ratchetVerifyCodes ratchetState) True
                             AgentServiceRequest (replyQueue :| _) sig_ payload ->
                               case verifyServiceReq rc payload sig_ of
                                 Left err -> logError ("service request: " <> T.pack err) >> notify (ERR $ AGENT $ A_SERVICE ASEBadSignature)

src/Simplex/Messaging/Agent/Protocol.hs

@@ -166,6 +166,8 @@ module Simplex.Messaging.Agent.Protocol
     ConnId,
     ConfirmationId,
     InvitationId,
+    ConnVerifyCodes (..),
+    ContactRequestBinding (..),
     MsgIntegrity (..),
     MsgErrorType (..),
     QueueStatus (..),
@@ -404,7 +406,7 @@ data AEvent (e :: AEntity) where
   LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn
   LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> ConnectionRequestUri 'CMContact -> AEvent AEConn
   CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
-  REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> Bool -> AEvent AEConn -- ConnInfo is from sender; Bool - rejection reason can be sent
+  REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> ContactRequestBinding -> Bool -> AEvent AEConn -- ConnInfo is from sender; Bool - rejection reason can be sent
   SREQ :: InvitationId -> Maybe C.PublicKeyEd25519 -> MsgBody -> AEvent AEConn
   SSENT :: AgentMsgId -> Maybe SMPServer -> AEvent AEConn
   RJCT :: ConnInfo -> AEvent AEConn
@@ -1372,6 +1374,15 @@ type ConfirmationId = ByteString
 
 type InvitationId = ByteString
 
+data ConnVerifyCodes = ConnVerifyCodes
+  { codeAD :: ByteString,
+    codePQ :: Maybe ByteString
+  }
+  deriving (Eq, Show)
+
+data ContactRequestBinding = CRBRatchet ConnVerifyCodes | CRBRequest ByteString
+  deriving (Eq, Show)
+
 extraSMPServerHosts :: Map TransportHost TransportHost
 extraSMPServerHosts =
   M.fromList

src/Simplex/Messaging/Agent/Store/AgentStore.hs

@@ -165,6 +165,8 @@ module Simplex.Messaging.Agent.Store.AgentStore
     createRatchet,
     deleteRatchet,
     getRatchet,
+    getRatchetVerifyCodes,
+    ratchetVerifyCodes,
     getRatchetForUpdate,
     getSkippedMsgKeys,
     updateRatchet,
@@ -291,6 +293,7 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as U
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
+import Data.Either (partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (foldl', sortBy)
@@ -1474,9 +1477,11 @@ createSndRatchet db connId ratchetState (CR.AE2ERatchetParams s (CR.E2ERatchetPa
     db
     [sql|
       INSERT INTO ratchets
-        (conn_id, ratchet_state, x3dh_pub_key_1, x3dh_pub_key_2, pq_pub_kem) VALUES (?, ?, ?, ?, ?)
+        (conn_id, ratchet_state, rc_verify_code_ad, rc_verify_code_pq, x3dh_pub_key_1, x3dh_pub_key_2, pq_pub_kem) VALUES (?, ?, ?, ?, ?, ?, ?)
       ON CONFLICT (conn_id) DO UPDATE SET
         ratchet_state = EXCLUDED.ratchet_state,
+        rc_verify_code_ad = EXCLUDED.rc_verify_code_ad,
+        rc_verify_code_pq = EXCLUDED.rc_verify_code_pq,
         x3dh_priv_key_1 = NULL,
         x3dh_priv_key_2 = NULL,
         x3dh_pub_key_1 = EXCLUDED.x3dh_pub_key_1,
@@ -1484,7 +1489,13 @@ createSndRatchet db connId ratchetState (CR.AE2ERatchetParams s (CR.E2ERatchetPa
         pq_priv_kem = NULL,
         pq_pub_kem = EXCLUDED.pq_pub_kem
     |]
-    (connId, ratchetState, x3dhPubKey1, x3dhPubKey2, CR.ARKP s <$> pqPubKem)
+    ((connId, ratchetState) :. verifyCodesRow (ratchetVerifyCodes ratchetState) :. (x3dhPubKey1, x3dhPubKey2, CR.ARKP s <$> pqPubKem))
+
+ratchetVerifyCodes :: RatchetX448 -> ConnVerifyCodes
+ratchetVerifyCodes CR.Ratchet {rcAD, rcVCPQ} = ConnVerifyCodes {codeAD = C.sha256Hash $ unStr rcAD, codePQ = unStr <$> rcVCPQ}
+
+verifyCodesRow :: ConnVerifyCodes -> (Binary ByteString, Maybe (Binary ByteString))
+verifyCodesRow ConnVerifyCodes {codeAD, codePQ} = (Binary codeAD, Binary <$> codePQ)
 
 getSndRatchet :: DB.Connection -> ConnId -> CR.VersionE2E -> IO (Either StoreError (RatchetX448, CR.AE2ERatchetParams 'C.X448))
 getSndRatchet db connId v =
@@ -1505,10 +1516,12 @@ createRatchet db connId rc =
   DB.execute
     db
     [sql|
-      INSERT INTO ratchets (conn_id, ratchet_state)
-      VALUES (?, ?)
+      INSERT INTO ratchets (conn_id, ratchet_state, rc_verify_code_ad, rc_verify_code_pq)
+      VALUES (?, ?, ?, ?)
       ON CONFLICT (conn_id) DO UPDATE SET
-        ratchet_state = ?,
+        ratchet_state = EXCLUDED.ratchet_state,
+        rc_verify_code_ad = EXCLUDED.rc_verify_code_ad,
+        rc_verify_code_pq = EXCLUDED.rc_verify_code_pq,
         x3dh_priv_key_1 = NULL,
         x3dh_priv_key_2 = NULL,
         x3dh_pub_key_1 = NULL,
@@ -1516,7 +1529,42 @@ createRatchet db connId rc =
         pq_priv_kem = NULL,
         pq_pub_kem = NULL
     |]
-    (connId, rc, rc)
+    ((connId, rc) :. verifyCodesRow (ratchetVerifyCodes rc))
+
+getRatchetVerifyCodes :: DB.Connection -> [ConnId] -> IO (Map ConnId ConnVerifyCodes)
+getRatchetVerifyCodes db connIds = do
+  (saved, computed) <- partitionEithers . mapMaybe rowCodes <$> selectCodes
+  stored <- saveCodes computed
+  pure $ M.fromList $ saved <> stored
+  where
+    rowCodes (connId, codeAD_, codePQ_, rc_) = case codeAD_ of
+      Just codeAD -> Just $ Left $ toCodes (connId, codeAD, codePQ_)
+      Nothing -> Right . (connId,) . ratchetVerifyCodes <$> rc_
+    toCodes (connId, Binary codeAD, codePQ_) = (connId, ConnVerifyCodes {codeAD, codePQ = fromBinary <$> codePQ_})
+    codesRow (connId, cs) = verifyCodesRow cs :. Only connId
+    codesQuery :: Query
+    codesQuery = "SELECT conn_id, rc_verify_code_ad, rc_verify_code_pq, CASE WHEN rc_verify_code_ad IS NULL THEN ratchet_state END FROM ratchets"
+    selectCodes :: IO [(ConnId, Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe RatchetX448)]
+    saveCodes :: [(ConnId, ConnVerifyCodes)] -> IO [(ConnId, ConnVerifyCodes)]
+#if defined(dbPostgres)
+    selectCodes = DB.query db (codesQuery <> " WHERE conn_id IN ?") (Only (In connIds))
+    saveCodes cs =
+      map toCodes
+        <$> DB.returning
+          db
+          [sql|
+            UPDATE ratchets r
+            SET rc_verify_code_ad = COALESCE(r.rc_verify_code_ad, (upd.rc_verify_code_ad :: BYTEA)),
+              rc_verify_code_pq = CASE WHEN r.rc_verify_code_ad IS NULL THEN (upd.rc_verify_code_pq :: BYTEA) ELSE r.rc_verify_code_pq END
+            FROM (VALUES(?, ?, ?)) AS upd(rc_verify_code_ad, rc_verify_code_pq, conn_id)
+            WHERE r.conn_id = (upd.conn_id :: BYTEA)
+            RETURNING r.conn_id, r.rc_verify_code_ad, r.rc_verify_code_pq
+          |]
+          (map codesRow cs)
+#else
+    selectCodes = concat <$> mapM (DB.query db (codesQuery <> " WHERE conn_id = ?") . Only) connIds
+    saveCodes cs = cs <$ unless (null cs) (DB.executeMany db "UPDATE ratchets SET rc_verify_code_ad = ?, rc_verify_code_pq = ? WHERE conn_id = ?" $ map codesRow cs)
+#endif
 
 deleteRatchet :: DB.Connection -> ConnId -> IO ()
 deleteRatchet db connId =

src/Simplex/Messaging/Agent/Store/Postgres/DB.hs

@@ -13,6 +13,7 @@ module Simplex.Messaging.Agent.Store.Postgres.DB
     execute,
     execute_,
     executeMany,
+    returning,
     query,
     query_,
     blobFieldDecoder,
@@ -60,6 +61,10 @@ executeMany :: ToRow q => PSQL.Connection -> Query -> [q] -> IO ()
 executeMany db q qs = void $ PSQL.executeMany db q qs `E.catch` addSql q
 {-# INLINE executeMany #-}
 
+returning :: (ToRow q, FromRow r) => PSQL.Connection -> Query -> [q] -> IO [r]
+returning db q qs = PSQL.returning db q qs `E.catch` addSql q
+{-# INLINE returning #-}
+
 query :: (ToRow q, FromRow r) => PSQL.Connection -> Query -> q -> IO [r]
 query db q qs = PSQL.query db q qs `E.catch` addSql q
 {-# INLINE query #-}

src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs

@@ -15,6 +15,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260410_receive_attem
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Text, Maybe Text)]
@@ -29,7 +30,8 @@ schemaMigrations =
     ("20260410_receive_attempts", m20260410_receive_attempts, Just down_m20260410_receive_attempts),
     ("20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs),
     ("20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
-    ("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement)
+    ("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
+    ("20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260919_ratchet_verify_codes.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes where
+
+import Data.Text (Text)
+import Text.RawString.QQ (r)
+
+m20260919_ratchet_verify_codes :: Text
+m20260919_ratchet_verify_codes =
+  [r|
+ALTER TABLE ratchets ADD COLUMN rc_verify_code_ad BYTEA;
+ALTER TABLE ratchets ADD COLUMN rc_verify_code_pq BYTEA;
+|]
+
+down_m20260919_ratchet_verify_codes :: Text
+down_m20260919_ratchet_verify_codes =
+  [r|
+ALTER TABLE ratchets DROP COLUMN rc_verify_code_pq;
+ALTER TABLE ratchets DROP COLUMN rc_verify_code_ad;
+|]

src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql

@@ -448,7 +448,9 @@ CREATE TABLE smp_agent_test_protocol_schema.ratchets (
     x3dh_pub_key_1 bytea,
     x3dh_pub_key_2 bytea,
     pq_priv_kem bytea,
-    pq_pub_kem bytea
+    pq_pub_kem bytea,
+    rc_verify_code_ad bytea,
+    rc_verify_code_pq bytea
 );
 
 

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs

@@ -51,6 +51,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260410_receive_attempt
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260411_service_certs
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -101,7 +102,8 @@ schemaMigrations =
     ("m20260410_receive_attempts", m20260410_receive_attempts, Just down_m20260410_receive_attempts),
     ("m20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs),
     ("m20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
-    ("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement)
+    ("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
+    ("m20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260919_ratchet_verify_codes.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20260919_ratchet_verify_codes :: Query
+m20260919_ratchet_verify_codes =
+  [sql|
+ALTER TABLE ratchets ADD COLUMN rc_verify_code_ad BLOB;
+ALTER TABLE ratchets ADD COLUMN rc_verify_code_pq BLOB;
+  |]
+
+down_m20260919_ratchet_verify_codes :: Query
+down_m20260919_ratchet_verify_codes =
+  [sql|
+ALTER TABLE ratchets DROP COLUMN rc_verify_code_pq;
+ALTER TABLE ratchets DROP COLUMN rc_verify_code_ad;
+  |]

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql

@@ -182,7 +182,9 @@ CREATE TABLE ratchets(
   x3dh_pub_key_1 BLOB,
   x3dh_pub_key_2 BLOB,
   pq_priv_kem BLOB,
-  pq_pub_kem BLOB
+  pq_pub_kem BLOB,
+  rc_verify_code_ad BLOB,
+  rc_verify_code_pq BLOB
 ) WITHOUT ROWID, STRICT;
 CREATE TABLE skipped_messages(
   skipped_message_id INTEGER PRIMARY KEY,

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -451,6 +451,7 @@ generateSndE2EParams g v = \case
 
 data RatchetInitParams = RatchetInitParams
   { assocData :: Str,
+    rcVerifyCodePQ :: Str,
     ratchetKey :: RatchetKey,
     sndHK :: HeaderKey,
     rcvNextHK :: HeaderKey,
@@ -493,14 +494,14 @@ pqX3dhRcv (rpk1, rpk2, rpKem_) (E2ERatchetParams _ sk1 sk2 sKem_) = do
 
 pqX3dh :: DhAlgorithm a => (PublicKey a, PublicKey a) -> DhSecret a -> DhSecret a -> DhSecret a -> Maybe RatchetKEMAccepted -> RatchetInitParams
 pqX3dh (sk1, rk1) dh1 dh2 dh3 kemAccepted =
-  RatchetInitParams {assocData, ratchetKey = RatchetKey sk, sndHK = Key hk, rcvNextHK = Key nhk, kemAccepted}
+  RatchetInitParams {assocData, rcVerifyCodePQ = Str vcPQ, ratchetKey = RatchetKey sk, sndHK = Key hk, rcvNextHK = Key nhk, kemAccepted}
   where
     assocData = Str $ pubKeyBytes sk1 <> pubKeyBytes rk1
     dhs = dhBytes' dh1 <> dhBytes' dh2 <> dhBytes' dh3 <> pq
     pq = maybe "" (\RatchetKEMAccepted {rcPQRss = KEMSharedKey ss} -> BA.convert ss) kemAccepted
-    (hk, nhk, sk) =
-      let salt = B.replicate 64 '\0'
-       in hkdf3 salt dhs "SimpleXX3DH"
+    salt = B.replicate 64 '\0'
+    (hk, nhk, sk) = hkdf3 salt dhs "SimpleXX3DH"
+    vcPQ = hkdf salt dhs "SimpleXVerifyCode" 32
 
 type RatchetX448 = Ratchet 'X448
 
@@ -509,6 +510,8 @@ data Ratchet a = Ratchet
     rcVersion :: RatchetVersions,
     -- associated data - must be the same in both parties ratchets
     rcAD :: Str,
+    -- verification code covering all handshake keys, absent in the ratchets created before it was added
+    rcVCPQ :: Maybe Str,
     rcDHRs :: PrivateKey a,
     rcKEM :: Maybe RatchetKEM,
     rcSupportKEM :: PQSupport, -- defines header size, can only be enabled once
@@ -637,13 +640,14 @@ instance FromField MessageKey where fromField = blobFieldDecoder smpDecode
 -- @
 initSndRatchet ::
   forall a. (AlgorithmI a, DhAlgorithm a) => RatchetVersions -> PublicKey a -> PrivateKey a -> (RatchetInitParams, Maybe KEMKeyPair) -> Ratchet a
-initSndRatchet rcVersion rcDHRr rcDHRs (RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) = do
+initSndRatchet rcVersion rcDHRr rcDHRs (RatchetInitParams {assocData, rcVerifyCodePQ, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) = do
   -- state.RK, state.CKs, state.NHKs = KDF_RK_HE(SK, DH(state.DHRs, state.DHRr) || state.PQRss)
   let (rcRK, rcCKs, rcNHKs) = rootKdf ratchetKey rcDHRr rcDHRs (rcPQRss <$> kemAccepted)
       pqOn = isJust rcPQRs_
    in Ratchet
         { rcVersion,
           rcAD = assocData,
+          rcVCPQ = Just rcVerifyCodePQ,
           rcDHRs,
           rcKEM = (`RatchetKEM` kemAccepted) <$> rcPQRs_,
           rcSupportKEM = PQSupport pqOn,
@@ -668,10 +672,11 @@ initSndRatchet rcVersion rcDHRr rcDHRs (RatchetInitParams {assocData, ratchetKey
 -- as part of the connection request and random salt was received from the sender.
 initRcvRatchet ::
   forall a. (AlgorithmI a, DhAlgorithm a) => RatchetVersions -> PrivateKey a -> (RatchetInitParams, Maybe KEMKeyPair) -> PQSupport -> Ratchet a
-initRcvRatchet rcVersion rcDHRs (RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) pqSupport =
+initRcvRatchet rcVersion rcDHRs (RatchetInitParams {assocData, rcVerifyCodePQ, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) pqSupport =
   Ratchet
     { rcVersion,
       rcAD = assocData,
+      rcVCPQ = Just rcVerifyCodePQ,
       rcDHRs,
       -- rcKEM:
       -- state.PQRs = bob_pq_kem_key_pair