mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-05-24 21:15:22 +00:00
agent: allow to accept contact requests after address is deleted (#1580)
This commit is contained in:
spaced4ndy
+3
-1
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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
|
||||
|
||||
+37
@@ -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;
|
||||
|]
|
||||
@@ -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
|
||||
|
||||
@@ -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|
|
||||
|
||||
+38
@@ -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;
|
||||
|]
|
||||
@@ -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,
|
||||
|
||||
@@ -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"
|
||||
|
||||
Reference in New Issue
Block a user