diff --git a/simplexmq.cabal b/simplexmq.cabal index a388fd216..c07b66cea 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -194,6 +194,7 @@ library Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement + Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes else exposed-modules: Simplex.Messaging.Agent.Store.SQLite @@ -248,6 +249,7 @@ library Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260411_service_certs Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement + Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes Simplex.Messaging.Agent.Store.SQLite.Util if flag(client_postgres) || flag(server_postgres) exposed-modules: diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index e9a7379b4..e4a66202e 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/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 :" <> 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) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index a2db356a6..afe698769 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/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 diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index e9946cca0..7639bb388 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/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 = diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/DB.hs b/src/Simplex/Messaging/Agent/Store/Postgres/DB.hs index deec20e2f..ae60fcb4d 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/DB.hs +++ b/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 #-} diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs index de6e3f182..f34b120e2 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs +++ b/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 diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260919_ratchet_verify_codes.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260919_ratchet_verify_codes.hs new file mode 100644 index 000000000..9f3c732a2 --- /dev/null +++ b/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; +|] diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql index 60496f79e..a0d408c36 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql +++ b/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 ); diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs index 3585f42c2..e50d8bd43 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs +++ b/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 diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260919_ratchet_verify_codes.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260919_ratchet_verify_codes.hs new file mode 100644 index 000000000..8b42d595b --- /dev/null +++ b/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; + |] diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index 6ea5d9b53..de0c1494b 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/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, diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs index 9373b41f0..b38f2b5d1 100644 --- a/src/Simplex/Messaging/Crypto/Ratchet.hs +++ b/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 diff --git a/tests/AgentTests/DoubleRatchetTests.hs b/tests/AgentTests/DoubleRatchetTests.hs index 95bfb67d4..6de00a495 100644 --- a/tests/AgentTests/DoubleRatchetTests.hs +++ b/tests/AgentTests/DoubleRatchetTests.hs @@ -53,6 +53,7 @@ doubleRatchetTests = do it "should propose KEM during agreement, but no shared secret" $ testAlgs testPqX3dhProposeInReply it "should agree shared secret using KEM" $ testAlgs testPqX3dhProposeAccept it "should reject proposed KEM in reply" $ testAlgs testPqX3dhProposeReject + it "should agree different PQ associated data with substituted KEM key" $ testAlgs testPqX3dhSubstitutedKem it "should allow second proposal in reply" $ testAlgs testPqX3dhProposeAgain describe "hybrid KEM key agreement errors" $ do it "should fail if reply contains acceptance without proposal" $ testAlgs testPqX3dhAcceptWithoutProposalError @@ -362,6 +363,7 @@ testDecodeV2RatchetJSON :: IO () testDecodeV2RatchetJSON = do let v2RatchetJSON = "{\"rcVersion\":[2,2],\"rcAD\":\"2GEJrq48TmQse6NR16I-hrI0tSySZQ57E_g46nDceAPRAiF6j0drq26RTE7be6X7uiB4RaGJGf4QRXzcYuVtWw==\",\"rcDHRs\":\"TUM0Q0FRQXdCUVlESzJWdUJDSUVJRkNYbUxtSHQ3SUNfeHpGTi1Qb3ZqTVQ3S2p6XzZlZlBjOG9fRFY2RWxKOQ==\",\"rcRK\":\"BOX2X7YW5qDSp2XknY_lqacSrtDqQNPvS6iJlZIs3G0=\",\"rcNs\":0,\"rcNr\":0,\"rcPN\":0,\"rcNHKs\":\"IMouSkXUvzT_mo0WM-pqEUK09-HTLk9WOTCFQglyQxU=\",\"rcNHKr\":\"g-tus1clYPV0rGlzkf5a959tUqDYQVZ1FpcPeXdKwxI=\"}" Right (r :: Ratchet X25519) <- pure $ J.eitherDecodeStrict' v2RatchetJSON + rcVCPQ r `shouldBe` Nothing rcSupportKEM r `shouldBe` PQSupportOff rcEnableKEM r `shouldBe` PQEncOff rcSndKEM r `shouldBe` PQEncOff @@ -417,6 +419,18 @@ testPqX3dhProposeAccept _ = do Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob paramsAlice `compatibleRatchets` paramsBob +testPqX3dhSubstitutedKem :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO () +testPqX3dhSubstitutedKem _ = do + g <- C.newRandom + let v = currentE2EEncryptVersion + (pksAlice@(_, _, Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn + (_, E2ERatchetParams _ _ _ (Just (RKParamsProposed mallorysKem))) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn + (pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM mallorysKem) + Right (paramsBob, _) <- pure $ pqX3dhSnd pksBob e2eAlice + Right (paramsAlice, _) <- runExceptT $ pqX3dhRcv pksAlice e2eBob + assocData paramsAlice `shouldBe` assocData paramsBob + rcVerifyCodePQ paramsAlice `shouldNotBe` rcVerifyCodePQ paramsBob + testPqX3dhProposeReject :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO () testPqX3dhProposeReject _ = do g <- C.newRandom @@ -459,9 +473,9 @@ testPqX3dhProposeAgain _ = do compatibleRatchets :: (RatchetInitParams, x) -> (RatchetInitParams, x) -> Expectation compatibleRatchets - (RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, _) - (RatchetInitParams {assocData = ad, ratchetKey = rk, sndHK = shk, rcvNextHK = rnhk, kemAccepted = ka}, _) = do - assocData == ad && ratchetKey == rk && sndHK == shk && rcvNextHK == rnhk `shouldBe` True + (RatchetInitParams {assocData, rcVerifyCodePQ, ratchetKey, sndHK, rcvNextHK, kemAccepted}, _) + (RatchetInitParams {assocData = ad, rcVerifyCodePQ = vcPQ, ratchetKey = rk, sndHK = shk, rcvNextHK = rnhk, kemAccepted = ka}, _) = do + assocData == ad && rcVerifyCodePQ == vcPQ && ratchetKey == rk && sndHK == shk && rcvNextHK == rnhk `shouldBe` True case (kemAccepted, ka) of (Just RatchetKEMAccepted {rcPQRr, rcPQRss, rcPQRct}, Just RatchetKEMAccepted {rcPQRr = pqk, rcPQRss = pqss, rcPQRct = pqct}) -> pqk /= rcPQRr && pqss == rcPQRss && pqct == rcPQRct `shouldBe` True diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index cf6c3c8f6..ecfa36e42 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -204,7 +204,7 @@ pattern INFO :: ConnInfo -> AEvent 'AEConn pattern INFO connInfo = A.INFO PQSupportOn connInfo pattern REQ :: InvitationId -> NonEmpty SMPServer -> ConnInfo -> AEvent e -pattern REQ invId srvs connInfo <- A.REQ invId PQSupportOn srvs connInfo _ +pattern REQ invId srvs connInfo <- A.REQ invId PQSupportOn srvs connInfo _ _ pattern CON :: AEvent 'AEConn pattern CON = A.CON PQEncOn @@ -293,7 +293,7 @@ createConnection c userId enableNtfs cMode clientData subMode = do joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured) joinConnection c userId enableNtfs cReq connInfo subMode = do - connId <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn + (connId, _) <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn sndSecure <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq connInfo PQSupportOn subMode pure (connId, sndSecure) @@ -581,9 +581,9 @@ functionalAPITests ps = do it "should pass with correct password" $ testSMPServerConnectionTest ps auth (srv auth) `shouldReturn` Right (Just (Right testServerInformation)) it "should fail without password" $ testSMPServerConnectionTest ps auth (srv Nothing) `shouldReturn` Left authErr it "should fail with incorrect password" $ testSMPServerConnectionTest ps auth (srv $ Just "wrong") `shouldReturn` Left authErr - describe "getRatchetAdHash" $ - it "should return the same data for both peers" $ - withSmpServer ps testRatchetAdHash + describe "getConnectionVerifyCodes" $ + it "should return the same codes for both peers" $ + withSmpServer ps testConnectionVerifyCodes describe "Delivery receipts" $ do it "should send and receive delivery receipt" $ withSmpServer ps testDeliveryReceipts it "send delivery receipts concurrently with messages" $ testDeliveryReceiptsConcurrent ps @@ -755,7 +755,7 @@ runAgentClientTestPQ :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (A runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId = runRight_ $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ False SMSubscribe - aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo bPQ sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecured' `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice @@ -984,12 +984,12 @@ runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (Agent runAgentClientContactTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId = runRight_ $ do (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe - aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo bPQ sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection - ("", _, A.REQ invId pqSup' _ "bob's connInfo" _) <- get alice + ("", _, A.REQ invId pqSup' _ "bob's connInfo" _ _) <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn - bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ) + (bobId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ) sqSecured' <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob @@ -1053,7 +1053,7 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp Nothing -> expectationFailure "address must advertise DR ratchet keys" -- classic (non-DR) join drops the address keys from the request let connReqJoin = if useDR then connReq' else case connReq' of CRContactUri d _ -> CRContactUri d Nothing - aliceId <- A.prepareConnectionToJoin bob 1 True connReqJoin bPQ + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReqJoin bPQ if asyncJoin then do A.joinConnectionAsync bob "join" False aliceId True connReqJoin "bob's connInfo" bPQ SMSubscribe @@ -1061,9 +1061,9 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp else do sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReqJoin "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False - ("", _, A.REQ invId reqPQ _ "bob's connInfo" _) <- get alice + ("", _, A.REQ invId reqPQ _ "bob's connInfo" _ _) <- get alice liftIO $ reqPQ `shouldBe` PQSupportOn - bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + (bobId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) if asyncAccept then do acceptContactAsync alice "accept" bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe @@ -1093,10 +1093,10 @@ runCreateConnectionDRTest_ asyncNew addrIK bPQ ps = withSmpServer ps $ withAgent liftIO $ case addrKeys_ of Just (_, CR.E2ERatchetParamsUri _ _ _ kem_) -> isJust kem_ `shouldBe` supportPQ (CR.initialPQEncryption False addrIK) Nothing -> expectationFailure "createConnection must advertise DR ratchet keys" - aliceId <- A.prepareConnectionToJoin bob 1 True connReq bPQ + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReq bPQ void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" bPQ SMSubscribe - ("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice - bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + ("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice + (bobId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) void $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc @@ -1118,10 +1118,10 @@ testContactDRMatrix ps = do joinContactDR :: HasCallStack => AgentClient -> AgentClient -> ConnectionRequestUri 'CMContact -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO () joinContactDR alice requester connReq addrIK pqEnc = do - aliceId <- A.prepareConnectionToJoin requester 1 True connReq PQSupportOn + (aliceId, _) <- A.prepareConnectionToJoin requester 1 True connReq PQSupportOn void $ A.joinConnection requester NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe - ("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice - reqId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + ("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice + (reqId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) void $ acceptContact alice 1 reqId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe ("", _, A.CONF confId _ _ "alice's connInfo") <- get requester allowConfirmGreet alice reqId requester aliceId confId addrIK pqEnc @@ -1149,7 +1149,7 @@ testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob ca joinContactDR alice carol connReq2 addrIK pqEnc void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK) void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK) - aId <- A.prepareConnectionToJoin bob 1 True connReq1 PQSupportOn + (aId, _) <- A.prepareConnectionToJoin bob 1 True connReq1 PQSupportOn void $ A.joinConnection bob NRMInteractive 1 aId True connReq1 "bob's connInfo" PQSupportOn SMSubscribe get alice =##> \case ("", _, A.ERR _) -> True; _ -> False @@ -1192,11 +1192,11 @@ testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \al liftIO $ shortLink' `shouldBe` shortLink (_, ContactLinkData _ updated, connReq') <- getConnShortLink bob 1 shortLink liftIO $ ratchetKeys updated `shouldBe` ratchetKeys published - aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReq' bPQ sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False - ("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice - bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + ("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice + (bobId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) _ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc @@ -1216,10 +1216,10 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do (ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing _ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe (_, _, connReq') <- getConnShortLink bob 1 shortLink - aId <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn + (aId, _) <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn _ <- A.joinConnection bob NRMInteractive 1 aId True connReq' "bob's connInfo" PQSupportOn SMSubscribe - ("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice - bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) + ("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice + (bId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK) pure (bId, invId, aId) ("", "", DOWN _ _) <- nGet alice ("", "", DOWN _ _) <- nGet bob @@ -1244,12 +1244,12 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId where msgId = subtract baseId . fst connectViaContact b pq qInfo = do - aId <- A.prepareConnectionToJoin b 1 True qInfo pq + (aId, _) <- A.prepareConnectionToJoin b 1 True qInfo pq sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo "bob's connInfo" pq SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection - ("", _, A.REQ invId pqSup' _ "bob's connInfo" _) <- get alice + ("", _, A.REQ invId pqSup' _ "bob's connInfo" _ _) <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn - bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ) + (bId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ) sqSecuredAccept <- acceptContact alice 1 bId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe liftIO $ sqSecuredAccept `shouldBe` True ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b @@ -1290,10 +1290,10 @@ testRejectContactRequest :: HasCallStack => IO () testRejectContactRequest = withAgentClients2 $ \alice bob -> runRight_ $ do (_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe - aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` False -- joining via contact address connection - ("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _) <- get alice + ("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _ _) <- get alice Left (A.CMD PROHIBITED _) <- tryError $ rejectContact alice NRMInteractive 1 invId (Just "no rejection without double ratchet") rejectContact alice NRMInteractive 1 invId Nothing liftIO $ noMessages bob "nothing delivered to bob" @@ -1303,9 +1303,9 @@ testRejectContactRequestDR = withAgentClients2 $ \alice bob -> runRight_ $ do let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing} (_addrConnId, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe - aliceId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe - ("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice + ("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice rejectContact alice NRMInteractive 1 invId (Just "not now") ("", _, A.RJCT "not now") <- get bob pure () @@ -1315,9 +1315,9 @@ testRejectContactRequestDRAsync = withAgentClients2 $ \alice bob -> runRight_ $ do let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing} (_addrConnId, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe - aliceId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe - ("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice + ("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice rejectContactAsync alice "1" 1 invId (Just "not now") ("", _, A.RJCT "not now") <- get bob pure () @@ -1430,7 +1430,7 @@ testUpdateConnectionUserId = (connId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe newUserId <- createUser alice False [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer] _ <- changeConnectionUser alice 1 connId newUserId - aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured' `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice @@ -1589,7 +1589,7 @@ testInvitationErrors ps restart = do b <- getAgentB (bId, cReq) <- withServer1 ps $ runRight $ createConnection a 1 True SCMInvitation Nothing SMSubscribe ("", "", DOWN _ [_]) <- nGet a - aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn + (aId, _) <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn -- fails to secure the queue on testPort BROKER srv (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe (testPort `isSuffixOf` srv) `shouldBe` True @@ -1659,7 +1659,7 @@ testContactErrors ps restart = do b <- getAgentB (contactId, cReq) <- withServer1 ps $ runRight $ createConnection a 1 True SCMContact Nothing SMSubscribe ("", "", DOWN _ [_]) <- nGet a - aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn + (aId, _) <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn -- fails to create queue on testPort2 BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe (testPort2 `isSuffixOf` srv2) `shouldBe` True @@ -1681,10 +1681,10 @@ testContactErrors ps restart = do Right r -> error $ "unexpected result " <> show r Left _ -> putStrLn "retrying send" >> threadDelay 200000 >> loopSend loopSend - ("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _) <- get a + ("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _ _) <- get a pure invId ("", "", DOWN _ [_]) <- nGet a - bId <- runRight $ A.prepareConnectionToAccept a 1 True invId PQSupportOn + (bId, _) <- runRight $ A.prepareConnectionToAccept a 1 True invId PQSupportOn withServer2 ps $ do ("", "", UP _ [_]) <- nGet b'' let loopSecure = do @@ -1764,7 +1764,7 @@ testInvitationShortLink viaProxy a b = testJoinConn_ :: Bool -> Bool -> AgentClient -> ConnId -> AgentClient -> ConnectionRequestUri c -> ExceptT AgentErrorType IO () testJoinConn_ viaProxy sndSecure a bId b connReq = do - aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn + (aId, _) <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn sndSecure' <- A.joinConnection b NRMInteractive 1 aId True connReq "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sndSecure' `shouldBe` sndSecure ("", _, CONF confId _ "bob's connInfo") <- get a @@ -1792,7 +1792,7 @@ testInvitationShortLinkAsync viaProxy a b = do connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData runRight $ do - aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn + (aId, _) <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn A.joinConnectionAsync b "123" False aId True connReq "bob's connInfo" PQSupportOn SMSubscribe get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False ("", _, CONF confId _ "bob's connInfo") <- get a @@ -1834,7 +1834,7 @@ testContactShortLink viaProxy a b = (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe liftIO $ sndSecure `shouldBe` False ("", _, REQ invId _ "bob's connInfo") <- get a - bId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn + (bId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn sndSecure' <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe liftIO $ sndSecure' `shouldBe` True ("", _, CONF confId _ "alice's connInfo") <- get b @@ -1887,7 +1887,7 @@ testAddContactShortLink viaProxy a b = (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe liftIO $ sndSecure `shouldBe` False ("", _, REQ invId _ "bob's connInfo") <- get a - bId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn + (bId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn sndSecure' <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe liftIO $ sndSecure' `shouldBe` True ("", _, CONF confId _ "alice's connInfo") <- get b @@ -2046,7 +2046,7 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b (bId, sndSecure) <- joinConnection b 1 True connReq' "bob's connInfo" SMSubscribe liftIO $ sndSecure `shouldBe` False ("", _, REQ invId _ "bob's connInfo") <- get a - aId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn + (aId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn sndSecure' <- acceptContact a 1 aId True invId "alice's connInfo" PQSupportOn SMSubscribe liftIO $ sndSecure' `shouldBe` True ("", _, CONF confId _ "alice's connInfo") <- get b @@ -2749,7 +2749,7 @@ makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn makeConnectionForUsers_ :: HasCallStack => PQSupport -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive aliceUserId True True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) False SMSubscribe - aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport + (aliceId, _) <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe liftIO $ sqSecured' `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice @@ -3031,7 +3031,7 @@ testAsyncCommands alice bob baseId = createConnectionAsync alice "1" bobId True SCMInvitation IKPQOn False SMSubscribe ("1", bobId', INV (ACR _ qInfo)) <- get alice liftIO $ bobId' `shouldBe` bobId - aliceId <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn + (aliceId, _) <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe ("2", aliceId', JOINED sqSecured') <- get bob liftIO $ do @@ -3101,7 +3101,7 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> -- complete connection via contact address (aliceId, _) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe ("", _, REQ invId _ "bob's connInfo") <- get alice - bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn + (bobId, _) <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn _ <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe ("", _, CONF confId _ "alice's connInfo") <- get bob allowConnection bob aliceId confId "bob's connInfo" @@ -3129,7 +3129,7 @@ testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> liftIO $ aliceId' `shouldBe` aliceId -- complete connection ("", _, REQ invId _ "bob's connInfo") <- get alice - bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn + (bobId, _) <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn _ <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe ("", _, CONF confId _ "alice's connInfo") <- get bob allowConnection bob aliceId confId "bob's connInfo" @@ -3159,7 +3159,7 @@ testAcceptContactAsync alice bob baseId = (aliceId, sqSecuredJoin) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, REQ invId _ "bob's connInfo") <- get alice - bobId <- prepareConnectionToAccept alice 1 True invId PQSupportOn + (bobId, _) <- prepareConnectionToAccept alice 1 True invId PQSupportOn acceptContactAsync alice "1" bobId True invId "alice's connInfo" PQSupportOn SMSubscribe get alice =##> \case ("1", c, JOINED sqSecured') -> c == bobId && sqSecured' == True; _ -> False ("", _, CONF confId _ "alice's connInfo") <- get bob @@ -3440,7 +3440,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do createConnectionAsync a "1" bId True SCMInvitation IKPQOn False SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId - aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn + (aId, _) <- prepareConnectionToJoin b 1 True qInfo PQSupportOn joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId @@ -4023,13 +4023,23 @@ testServerInformation = serverCountry = Nothing } -testRatchetAdHash :: HasCallStack => IO () -testRatchetAdHash = +testConnectionVerifyCodes :: HasCallStack => IO () +testConnectionVerifyCodes = withAgentClients2 $ \a b -> runRight_ $ do (aId, bId) <- makeConnection a b - ad1 <- getConnectionRatchetAdHash a bId - ad2 <- getConnectionRatchetAdHash b aId - liftIO $ ad1 `shouldBe` ad2 + codes1 <- getConnectionVerifyCodes a bId + codes2 <- getConnectionVerifyCodes b aId + liftIO $ do + codes1 `shouldBe` codes2 + codePQ codes1 `shouldNotBe` Nothing + liftIO $ withTransaction (store $ agentEnv a) $ \db -> + DB.execute_ db "UPDATE ratchets SET rc_verify_code_ad = NULL, rc_verify_code_pq = NULL" + codes1' <- getConnectionVerifyCodes a bId + liftIO $ codes1' `shouldBe` codes1 + liftIO $ withTransaction (store $ agentEnv a) $ \db -> + DB.execute_ db "UPDATE ratchets SET ratchet_state = NULL" + codes1'' <- getConnectionVerifyCodes a bId + liftIO $ codes1'' `shouldBe` codes1 testDeliveryReceipts :: HasCallStack => IO () testDeliveryReceipts = diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index bb3932232..b8c86dee4 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -229,7 +229,7 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b withAgent 1 aCfg (servers aTestCfg) testDB $ \alice -> withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe - aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice @@ -285,7 +285,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs = -- otherwise the CONF messages would get mixed with MSG prePair alice bob = do (bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe - aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn + (aliceId, _) <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True confId <- @@ -344,7 +344,7 @@ agentViaProxyRetryOffline = do withServer $ \_ -> do (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe - aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn + (aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice