From c5eb66038bb9268671a353638606f6d0bd1de761 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 3 Jul 2025 09:29:39 +0000 Subject: [PATCH] agent: allow to accept contact requests after address is deleted (#1580) --- simplexmq.cabal | 4 +- src/Simplex/Messaging/Agent.hs | 65 ++++++++----------- src/Simplex/Messaging/Agent/Store.hs | 2 +- .../Messaging/Agent/Store/AgentStore.hs | 15 ++--- .../Agent/Store/Postgres/Migrations/App.hs | 4 +- ..._conn_invitations_remove_cascade_delete.hs | 37 +++++++++++ .../Agent/Store/SQLite/Migrations/App.hs | 4 +- .../Migrations/M20250517_service_certs.hs | 1 + ..._conn_invitations_remove_cascade_delete.hs | 38 +++++++++++ .../Store/SQLite/Migrations/agent_schema.sql | 2 +- tests/AgentTests/FunctionalAPITests.hs | 31 +++++---- 11 files changed, 136 insertions(+), 67 deletions(-) create mode 100644 src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20250702_conn_invitations_remove_cascade_delete.hs create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250702_conn_invitations_remove_cascade_delete.hs diff --git a/simplexmq.cabal b/simplexmq.cabal index 497b2b981..fe8c91e90 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -162,6 +162,7 @@ library Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links + Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete else exposed-modules: Simplex.Messaging.Agent.Store.SQLite @@ -208,6 +209,7 @@ library Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links + Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete if !flag(client_library) exposed-modules: Simplex.FileTransfer.Client.Main @@ -559,7 +561,7 @@ test-suite simplexmq-test build-depends: memory , sqlcipher-simple - if !flag(client_postgres) || flag(server_postgres) + if !flag(client_postgres) || flag(client_postgres) || flag(server_postgres) build-depends: deepseq ==1.4.* , process diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index dffe27389..b0c5526e6 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -343,8 +343,8 @@ allowConnectionAsync c = withAgentEnv c .:: allowConnectionAsync' c {-# INLINE allowConnectionAsync #-} -- | Accept contact after REQ notification (ACPT command) asynchronously, synchronous response is new connection id -acceptContactAsync :: AgentClient -> ACorrId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId -acceptContactAsync c aCorrId enableNtfs = withAgentEnv c .:: acceptContactAsync' c aCorrId enableNtfs +acceptContactAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId +acceptContactAsync c userId aCorrId enableNtfs = withAgentEnv c .:: acceptContactAsync' c userId aCorrId enableNtfs {-# INLINE acceptContactAsync #-} -- | Acknowledge message (ACK command) asynchronously, no synchronous response @@ -406,8 +406,8 @@ prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c {-# INLINE prepareConnectionToJoin #-} -- | Create SMP agent connection without queue (to be joined with acceptContact passing invitation ID). -prepareConnectionToAccept :: AgentClient -> Bool -> ConfirmationId -> PQSupport -> AE ConnId -prepareConnectionToAccept c enableNtfs = withAgentEnv c .: newConnToAccept c "" enableNtfs +prepareConnectionToAccept :: AgentClient -> UserId -> Bool -> ConfirmationId -> PQSupport -> AE ConnId +prepareConnectionToAccept c userId enableNtfs = withAgentEnv c .: newConnToAccept c userId "" enableNtfs {-# INLINE prepareConnectionToAccept #-} -- | Join SMP agent connection (JOIN command). @@ -421,13 +421,13 @@ allowConnection c = withAgentEnv c .:. allowConnection' c {-# INLINE allowConnection #-} -- | Accept contact after REQ notification (ACPT command) -acceptContact :: AgentClient -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (SndQueueSecured, Maybe ClientServiceId) -acceptContact c connId enableNtfs = withAgentEnv c .:: acceptContact' c connId enableNtfs +acceptContact :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (SndQueueSecured, Maybe ClientServiceId) +acceptContact c userId connId enableNtfs = withAgentEnv c .:: acceptContact' c userId connId enableNtfs {-# INLINE acceptContact #-} -- | Reject contact (RJCT command) -rejectContact :: AgentClient -> ConnId -> ConfirmationId -> AE () -rejectContact c = withAgentEnv c .: rejectContact' c +rejectContact :: AgentClient -> ConfirmationId -> AE () +rejectContact c = withAgentEnv c . rejectContact' c {-# INLINE rejectContact #-} -- | Subscribe to receive connection messages (SUB command) @@ -770,16 +770,13 @@ allowConnectionAsync' c corrId connId confId ownConnInfo = -- and also it can't be triggered by user concurrently several times in a row. It could be improved similarly to -- `acceptContact` by creating a new map for invitation locks and taking lock here, and removing `unacceptInvitation` -- while marking invitation as accepted inside "lock level transaction" after successful `joinConnAsync`. -acceptContactAsync' :: AgentClient -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId -acceptContactAsync' c corrId enableNtfs invId ownConnInfo pqSupport subMode = do - Invitation {contactConnId, connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId - withStore c (`getConn` contactConnId) >>= \case - SomeConn _ (ContactConnection ConnData {userId} _) -> do - withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do - withStore' c (`unacceptInvitation` invId) - throwE err - _ -> throwE $ CMD PROHIBITED "acceptContactAsync" +acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId +acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do + Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId + withStore' c $ \db -> acceptInvitation db invId ownConnInfo + joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do + withStore' c (`unacceptInvitation` invId) + throwE err ackMessageAsync' :: AgentClient -> ACorrId -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM () ackMessageAsync' c corrId connId msgId rcptInfo_ = do @@ -1036,13 +1033,10 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} withStore c $ \db -> createNewConn db g cData SCMInvitation -newConnToAccept :: AgentClient -> ConnId -> Bool -> ConfirmationId -> PQSupport -> AM ConnId -newConnToAccept c connId enableNtfs invId pqSup = do - Invitation {connReq, contactConnId} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId - withStore c (`getConn` contactConnId) >>= \case - SomeConn _ (ContactConnection ConnData {userId} _) -> - newConnToJoin c userId connId enableNtfs connReq pqSup - _ -> throwE $ CMD PROHIBITED "newConnToAccept" +newConnToAccept :: AgentClient -> UserId -> ConnId -> Bool -> ConfirmationId -> PQSupport -> AM ConnId +newConnToAccept c userId connId enableNtfs invId pqSup = do + Invitation {connReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId + newConnToJoin c userId connId enableNtfs connReq pqSup joinConn :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (SndQueueSecured, Maybe ClientServiceId) joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do @@ -1220,20 +1214,17 @@ allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConne _ -> throwE $ CMD PROHIBITED "allowConnection" -- | Accept contact (ACPT command) in Reader monad -acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (SndQueueSecured, Maybe ClientServiceId) -acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do - Invitation {contactConnId, connReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId - withStore c (`getConn` contactConnId) >>= \case - SomeConn _ (ContactConnection ConnData {userId} _) -> do - r <- joinConn c userId connId enableNtfs connReq ownConnInfo pqSupport subMode - withStore' c $ \db -> acceptInvitation db invId ownConnInfo - pure r - _ -> throwE $ CMD PROHIBITED "acceptContact" +acceptContact' :: AgentClient -> UserId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (SndQueueSecured, Maybe ClientServiceId) +acceptContact' c userId connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do + Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContact'" invId + r <- joinConn c userId connId enableNtfs connReq ownConnInfo pqSupport subMode + withStore' c $ \db -> acceptInvitation db invId ownConnInfo + pure r -- | Reject contact (RJCT command) in Reader monad -rejectContact' :: AgentClient -> ConnId -> InvitationId -> AM () -rejectContact' c contactConnId invId = - withStore c $ \db -> deleteInvitation db contactConnId invId +rejectContact' :: AgentClient -> InvitationId -> AM () +rejectContact' c invId = + withStore' c $ \db -> deleteInvitation db invId {-# INLINE rejectContact' #-} -- | Subscribe to receive connection messages (SUB command) in Reader monad diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 4ae22213c..faedce6bb 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -515,7 +515,7 @@ data NewInvitation = NewInvitation data Invitation = Invitation { invitationId :: InvitationId, - contactConnId :: ConnId, + contactConnId_ :: Maybe ConnId, connReq :: ConnectionRequestUri 'CMInvitation, recipientConnInfo :: ConnInfo, ownConnInfo :: Maybe ConnInfo, diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index c568de319..09b76671b 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -728,7 +728,7 @@ createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInf db [sql| INSERT INTO conn_invitations - (invitation_id, contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0); + (invitation_id, contact_conn_id, cr_invitation, recipient_conn_info, accepted) VALUES (?, ?, ?, ?, 0); |] (Binary invitationId, contactConnId, connReq, Binary recipientConnInfo) @@ -745,8 +745,8 @@ getInvitation db cxt invitationId = |] (Only (Binary invitationId)) where - invitation (contactConnId, connReq, recipientConnInfo, ownConnInfo, BI accepted) = - Invitation {invitationId, contactConnId, connReq, recipientConnInfo, ownConnInfo, accepted} + invitation (contactConnId_, connReq, recipientConnInfo, ownConnInfo, BI accepted) = + Invitation {invitationId, contactConnId_, connReq, recipientConnInfo, ownConnInfo, accepted} acceptInvitation :: DB.Connection -> InvitationId -> ConnInfo -> IO () acceptInvitation db invitationId ownConnInfo = @@ -764,12 +764,9 @@ unacceptInvitation :: DB.Connection -> InvitationId -> IO () unacceptInvitation db invitationId = DB.execute db "UPDATE conn_invitations SET accepted = 0, own_conn_info = NULL WHERE invitation_id = ?" (Only (Binary invitationId)) -deleteInvitation :: DB.Connection -> ConnId -> InvitationId -> IO (Either StoreError ()) -deleteInvitation db contactConnId invId = - getConn db contactConnId $>>= \case - SomeConn SCContact _ -> - Right <$> DB.execute db "DELETE FROM conn_invitations WHERE contact_conn_id = ? AND invitation_id = ?" (contactConnId, Binary invId) - _ -> pure $ Left SEConnNotFound +deleteInvitation :: DB.Connection -> InvitationId -> IO () +deleteInvitation db invId = + DB.execute db "DELETE FROM conn_invitations WHERE invitation_id = ?" (Only (Binary invId)) getInvShortLink :: DB.Connection -> SMPServer -> LinkId -> IO (Maybe InvShortLink) getInvShortLink db server linkId = diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs index e6e6efaf8..565a06760 100644 --- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs @@ -7,13 +7,15 @@ import Data.Text (Text) import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links +import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] schemaMigrations = [ ("20241210_initial", m20241210_initial, Nothing), ("20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies), - ("20250322_short_links", m20250322_short_links, Just down_m20250322_short_links) + ("20250322_short_links", m20250322_short_links, Just down_m20250322_short_links), + ("20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20250702_conn_invitations_remove_cascade_delete.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20250702_conn_invitations_remove_cascade_delete.hs new file mode 100644 index 000000000..a61a60d5d --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20250702_conn_invitations_remove_cascade_delete.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete where + +import Data.Text (Text) +import qualified Data.Text as T +import Text.RawString.QQ (r) + +m20250702_conn_invitations_remove_cascade_delete :: Text +m20250702_conn_invitations_remove_cascade_delete = + T.pack + [r| +ALTER TABLE conn_invitations DROP CONSTRAINT conn_invitations_contact_conn_id_fkey; + +ALTER TABLE conn_invitations ALTER COLUMN contact_conn_id DROP NOT NULL; + +ALTER TABLE conn_invitations + ADD CONSTRAINT conn_invitations_contact_conn_id_fkey + FOREIGN KEY (contact_conn_id) + REFERENCES connections(conn_id) + ON DELETE SET NULL; +|] + +down_m20250702_conn_invitations_remove_cascade_delete :: Text +down_m20250702_conn_invitations_remove_cascade_delete = + T.pack + [r| +ALTER TABLE conn_invitations DROP CONSTRAINT conn_invitations_contact_conn_id_fkey; + +ALTER TABLE conn_invitations ALTER COLUMN contact_conn_id SET NOT NULL; + +ALTER TABLE conn_invitations + ADD CONSTRAINT conn_invitations_contact_conn_id_fkey + FOREIGN KEY (contact_conn_id) + REFERENCES connections(conn_id) + ON DELETE CASCADE; +|] diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs index eea7db3ca..9d5d65ea7 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs @@ -43,6 +43,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links +import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -85,7 +86,8 @@ schemaMigrations = ("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts), ("m20241224_ratchet_e2e_snd_params", m20241224_ratchet_e2e_snd_params, Just down_m20241224_ratchet_e2e_snd_params), ("m20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies), - ("m20250322_short_links", m20250322_short_links, Just down_m20250322_short_links) + ("m20250322_short_links", m20250322_short_links, Just down_m20250322_short_links), + ("m20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250517_service_certs.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250517_service_certs.hs index 48f847091..7708fd6d2 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250517_service_certs.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250517_service_certs.hs @@ -5,6 +5,7 @@ module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250517_service_certs w import Database.SQLite.Simple (Query) import Database.SQLite.Simple.QQ (sql) +-- TODO move date forward, create migration for postgres m20250517_service_certs :: Query m20250517_service_certs = [sql| diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250702_conn_invitations_remove_cascade_delete.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250702_conn_invitations_remove_cascade_delete.hs new file mode 100644 index 000000000..9abccb476 --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20250702_conn_invitations_remove_cascade_delete.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20250702_conn_invitations_remove_cascade_delete :: Query +m20250702_conn_invitations_remove_cascade_delete = + [sql| +PRAGMA writable_schema=1; + +UPDATE sqlite_master +SET sql = replace( + sql, + 'contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE', + 'contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL' + ) +WHERE name = 'conn_invitations' AND type = 'table'; + +PRAGMA writable_schema=0; +|] + +down_m20250702_conn_invitations_remove_cascade_delete :: Query +down_m20250702_conn_invitations_remove_cascade_delete = + [sql| +PRAGMA writable_schema=1; + +UPDATE sqlite_master +SET sql = replace( + sql, + 'contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL', + 'contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE' + ) +WHERE name = 'conn_invitations' AND type = 'table'; + +PRAGMA writable_schema=0; +|] 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 fde671d7a..ad39937cd 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -154,7 +154,7 @@ CREATE TABLE conn_confirmations( ) WITHOUT ROWID; CREATE TABLE conn_invitations( invitation_id BLOB NOT NULL PRIMARY KEY, - contact_conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE, + contact_conn_id BLOB REFERENCES connections ON DELETE SET NULL, cr_invitation BLOB NOT NULL, recipient_conn_info BLOB NOT NULL, accepted INTEGER NOT NULL DEFAULT 0, diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 6af1f585a..445d087cb 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -888,8 +888,8 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` reqPQSupport - bobId <- A.prepareConnectionToAccept alice True invId (CR.connPQEncryption aPQ) - (sqSecured', Nothing) <- acceptContact alice bobId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe + bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ) + (sqSecured', Nothing) <- 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 liftIO $ pqSup'' `shouldBe` bPQ @@ -939,8 +939,8 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn - bId <- A.prepareConnectionToAccept alice True invId (CR.connPQEncryption aPQ) - (sqSecuredAccept, Nothing) <- acceptContact alice bId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe + bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ) + (sqSecuredAccept, Nothing) <- acceptContact alice 1 bId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe liftIO $ sqSecuredAccept `shouldBe` False -- agent cfg is v8 ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b liftIO $ pqSup'' `shouldBe` pq @@ -979,13 +979,12 @@ noMessages_ ingoreQCONT c err = tryGet `shouldReturn` () testRejectContactRequest :: HasCallStack => IO () testRejectContactRequest = withAgentClients2 $ \alice bob -> runRight_ $ do - (addrConnId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing IKPQOn SMSubscribe + (_addrConnId, (CCLink qInfo Nothing, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn (sqSecured, Nothing) <- A.joinConnection bob 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 - liftIO $ runExceptT (rejectContact alice "abcd" invId) `shouldReturn` Left (CONN NOT_FOUND "") - rejectContact alice addrConnId invId + rejectContact alice invId liftIO $ noMessages bob "nothing delivered to bob" testUpdateConnectionUserId :: HasCallStack => IO () @@ -1248,12 +1247,12 @@ testContactErrors ps restart = do ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get a pure invId ("", "", DOWN _ [_]) <- nGet a - bId <- runRight $ A.prepareConnectionToAccept a True invId PQSupportOn + bId <- runRight $ A.prepareConnectionToAccept a 1 True invId PQSupportOn withServer2 ps $ do ("", "", UP _ [_]) <- nGet b'' let loopSecure = do -- secures the queue on testPort2, but fails to create reply queue on testPort - BROKER srv NETWORK <- runLeft $ acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe + BROKER srv NETWORK <- runLeft $ acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe unless (testPort `isSuffixOf` srv) $ putStrLn "retrying secure" >> threadDelay 200000 >> loopSecure loopSecure ("", "", DOWN _ [_]) <- nGet b'' @@ -1261,7 +1260,7 @@ testContactErrors ps restart = do ("", "", UP _ [_]) <- nGet a let loopCreate = do -- creates the reply queue on testPort, but fails to send confirmation to testPort2 - BROKER srv2' NETWORK <- runLeft $ acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe + BROKER srv2' NETWORK <- runLeft $ acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe unless (testPort2 `isSuffixOf` srv2') $ putStrLn "retrying create" >> threadDelay 200000 >> loopCreate loopCreate restartAgentA restart a [contactId, bId] @@ -1269,7 +1268,7 @@ testContactErrors ps restart = do (n, confId) <- withServer2 ps $ do ("", "", UP _ [_]) <- nGet b'' let loopConfirm n = - runExceptT (acceptContact a' bId True invId "alice's connInfo" PQSupportOn SMSubscribe) >>= \case + runExceptT (acceptContact a' 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe) >>= \case Right (True, Nothing) -> pure n Right r -> error $ "unexpected result " <> show r Left _ -> putStrLn "retrying accept confirm" >> threadDelay 200000 >> loopConfirm (n + 1) @@ -1384,8 +1383,8 @@ 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 True invId PQSupportOn - (sndSecure', Nothing) <- acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe + bId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn + (sndSecure', Nothing) <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe liftIO $ sndSecure' `shouldBe` True ("", _, CONF confId _ "alice's connInfo") <- get b allowConnection b aId confId "bob's connInfo" @@ -1431,8 +1430,8 @@ 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 True invId PQSupportOn - (sndSecure', Nothing) <- acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe + bId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn + (sndSecure', Nothing) <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe liftIO $ sndSecure' `shouldBe` True ("", _, CONF confId _ "alice's connInfo") <- get b allowConnection b aId confId "bob's connInfo" @@ -2573,7 +2572,7 @@ testAcceptContactAsync sqSecured 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 <- acceptContactAsync alice "1" True invId "alice's connInfo" PQSupportOn SMSubscribe + bobId <- acceptContactAsync alice 1 "1" True invId "alice's connInfo" PQSupportOn SMSubscribe get alice =##> \case ("1", c, JOINED sqSecured') -> c == bobId && sqSecured' == sqSecured; _ -> False ("", _, CONF confId _ "alice's connInfo") <- get bob allowConnection bob aliceId confId "bob's connInfo"