agent: allow to accept contact requests after address is deleted (#1580)

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

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,

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 =

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

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;
+|]

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

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|

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;
+|]

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,