core: connection plan api; check connection plan before connecting in terminal api (#3176)

src/Simplex/Chat/Store/Connections.hs

@@ -9,6 +9,7 @@
 
 module Simplex.Chat.Store.Connections
   ( getConnectionEntity,
+    getConnectionEntityByConnReq,
     getConnectionsToSubscribe,
     unsetConnectionToSubscribe,
   )
@@ -31,7 +32,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol (ConnId)
-import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow')
+import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Util (eitherToMaybe)
 
@@ -152,6 +153,12 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
         userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
         userContact_ _ = Left SEUserContactLinkNotFound
 
+getConnectionEntityByConnReq :: DB.Connection -> User -> ConnReqInvitation -> IO (Maybe ConnectionEntity)
+getConnectionEntityByConnReq db user cReq = do
+  connId_ <- maybeFirstRow fromOnly $
+    DB.query db "SELECT agent_conn_id FROM connections WHERE conn_req_inv = ? LIMIT 1" (Only cReq)
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db user) connId_
+
 getConnectionsToSubscribe :: DB.Connection -> IO ([ConnId], [ConnectionEntity])
 getConnectionsToSubscribe db = do
   aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1"

src/Simplex/Chat/Store/Direct.hs

@@ -25,6 +25,7 @@ module Simplex.Chat.Store.Direct
     createConnReqConnection,
     getProfileById,
     getConnReqContactXContactId,
+    getContactByConnReqHash,
     createDirectContact,
     deleteContactConnectionsAndFiles,
     deleteContact,
@@ -137,32 +138,10 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
 
 getConnReqContactXContactId :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
 getConnReqContactXContactId db user@User {userId} cReqHash = do
-  getContact' >>= \case
+  getContactByConnReqHash db user cReqHash >>= \case
     c@(Just _) -> pure (c, Nothing)
     Nothing -> (Nothing,) <$> getXContactId
   where
-    getContact' :: IO (Maybe Contact)
-    getContact' =
-      maybeFirstRow (toContact user) $
-        DB.query
-          db
-          [sql|
-            SELECT
-              -- Contact
-              ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
-              cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-              -- Connection
-              c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
-              c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
-              c.peer_chat_min_version, c.peer_chat_max_version
-            FROM contacts ct
-            JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
-            JOIN connections c ON c.contact_id = ct.contact_id
-            WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.deleted = 0
-            ORDER BY c.created_at DESC
-            LIMIT 1
-          |]
-          (userId, cReqHash)
     getXContactId :: IO (Maybe XContactId)
     getXContactId =
       maybeFirstRow fromOnly $
@@ -171,6 +150,29 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
           "SELECT xcontact_id FROM connections WHERE user_id = ? AND via_contact_uri_hash = ? LIMIT 1"
           (userId, cReqHash)
 
+getContactByConnReqHash :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact)
+getContactByConnReqHash db user@User {userId} cReqHash =
+  maybeFirstRow (toContact user) $
+    DB.query
+      db
+      [sql|
+        SELECT
+          -- Contact
+          ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
+          cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
+          -- Connection
+          c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
+          c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
+          c.peer_chat_min_version, c.peer_chat_max_version
+        FROM contacts ct
+        JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
+        JOIN connections c ON c.contact_id = ct.contact_id
+        WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.contact_status = ? AND ct.deleted = 0
+        ORDER BY c.created_at DESC
+        LIMIT 1
+      |]
+      (userId, cReqHash, CSActive)
+
 createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> IO PendingContactConnection
 createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode = do
   createdAt <- getCurrentTime

src/Simplex/Chat/Store/Groups.hs

@@ -31,9 +31,12 @@ module Simplex.Chat.Store.Groups
     getGroupAndMember,
     createNewGroup,
     createGroupInvitation,
+    setViaGroupLinkHash,
     setGroupInvitationChatItemId,
     getGroup,
     getGroupInfo,
+    getGroupInfoByUserContactLinkConnReq,
+    getGroupInfoByGroupLinkHash,
     updateGroupProfile,
     getGroupIdByName,
     getGroupMemberIdByName,
@@ -405,6 +408,17 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
           )
         pure $ Right incognitoLdn
 
+setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO ()
+setViaGroupLinkHash db groupId connId =
+  DB.execute
+    db
+    [sql|
+      UPDATE groups
+      SET via_group_link_uri_hash = (SELECT via_contact_uri_hash FROM connections WHERE connection_id = ?)
+      WHERE group_id = ?
+    |]
+    (connId, groupId)
+
 setGroupInvitationChatItemId :: DB.Connection -> User -> GroupId -> ChatItemId -> IO ()
 setGroupInvitationChatItemId db User {userId} groupId chatItemId = do
   currentTs <- getCurrentTime
@@ -1102,6 +1116,35 @@ getGroupInfo db User {userId, userContactId} groupId =
       |]
       (groupId, userId, userContactId)
 
+getGroupInfoByUserContactLinkConnReq :: DB.Connection -> User -> ConnReqContact -> IO (Maybe GroupInfo)
+getGroupInfoByUserContactLinkConnReq db user cReq = do
+  groupId_ <- maybeFirstRow fromOnly $
+    DB.query
+      db
+      [sql|
+        SELECT group_id
+        FROM user_contact_links
+        WHERE conn_req_contact = ?
+      |]
+      (Only cReq)
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_
+
+getGroupInfoByGroupLinkHash :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe GroupInfo)
+getGroupInfoByGroupLinkHash db user@User {userId, userContactId} groupLinkHash = do
+  groupId_ <- maybeFirstRow fromOnly $
+    DB.query
+      db
+      [sql|
+        SELECT g.group_id
+        FROM groups g
+        JOIN group_members mu ON mu.group_id = g.group_id
+        WHERE g.user_id = ? AND g.via_group_link_uri_hash = ?
+          AND mu.contact_id = ? AND mu.member_status NOT IN (?,?,?)
+        LIMIT 1
+      |]
+      (userId, groupLinkHash, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted)
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_
+
 getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId
 getGroupIdByName db User {userId} gName =
   ExceptT . firstRow fromOnly (SEGroupNotFoundByName gName) $

src/Simplex/Chat/Store/Migrations.hs

@@ -83,6 +83,7 @@ import Simplex.Chat.Migrations.M20230913_member_contacts
 import Simplex.Chat.Migrations.M20230914_member_probes
 import Simplex.Chat.Migrations.M20230926_contact_status
 import Simplex.Chat.Migrations.M20231002_conn_initiated
+import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -165,7 +166,8 @@ schemaMigrations =
     ("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts),
     ("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes),
     ("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status),
-    ("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated)
+    ("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated),
+    ("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Store/Profiles.hs

@@ -42,6 +42,7 @@ module Simplex.Chat.Store.Profiles
     deleteUserAddress,
     getUserAddress,
     getUserContactLinkById,
+    getUserContactLinkByConnReq,
     updateUserAddressAutoAccept,
     getProtocolServers,
     overwriteProtocolServers,
@@ -86,7 +87,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (safeDecodeUtf8)
+import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
 
 createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User
 createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
@@ -440,6 +441,18 @@ getUserContactLinkById db userId userContactLinkId =
       |]
       (userId, userContactLinkId)
 
+getUserContactLinkByConnReq :: DB.Connection -> ConnReqContact -> IO (Maybe UserContactLink)
+getUserContactLinkByConnReq db cReq =
+  maybeFirstRow toUserContactLink $
+    DB.query
+      db
+      [sql|
+        SELECT conn_req_contact, auto_accept, auto_accept_incognito, auto_reply_msg_content
+        FROM user_contact_links
+        WHERE conn_req_contact = ?
+      |]
+      (Only cReq)
+
 updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink
 updateUserAddressAutoAccept db user@User {userId} autoAccept = do
   link <- getUserAddress db user