core, ui: chat relay test (#6736)

src/Simplex/Chat/Store/Direct.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
@@ -31,6 +32,7 @@ module Simplex.Chat.Store.Direct
     createIncognitoProfile,
     createConnReqConnection,
     createRelayMemberConnectionAsync,
+    createRelayTestConnection,
     updateConnLinkData,
     setPreparedGroupStartedConnection,
     getProfileById,
@@ -112,7 +114,7 @@ import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedCon
 import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
 import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
 import qualified Simplex.Messaging.Agent.Store.DB as DB
-import Simplex.Messaging.Crypto.Ratchet (PQSupport)
+import Simplex.Messaging.Crypto.Ratchet (PQSupport, pattern PQSupportOff)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
 #if defined(dbPostgres)
@@ -241,6 +243,26 @@ createRelayMemberConnectionAsync db user@User {userId} gInfo GroupMember {groupM
   where
     customUserProfileId_ = localProfileId <$> incognitoMembershipProfile gInfo
 
+createRelayTestConnection :: DB.Connection -> VersionRangeChat -> User -> ConnId -> ConnStatus -> VersionChat -> SubscriptionMode -> ExceptT StoreError IO Connection
+createRelayTestConnection db vr user@User {userId} agentConnId connStatus chatV subMode = do
+  currentTs <- liftIO getCurrentTime
+  liftIO $
+    DB.execute
+      db
+      [sql|
+        INSERT INTO connections (
+          user_id, agent_conn_id, conn_level, conn_status, conn_type,
+          conn_chat_version, to_subscribe, pq_support, pq_encryption,
+          relay_test, created_at, updated_at
+        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
+      |]
+      ( (userId, agentConnId, 0 :: Int, connStatus, ConnContact)
+          :. (chatV, BI (subMode == SMOnlyCreate), PQSupportOff, PQSupportOff)
+          :. (BI True, currentTs, currentTs)
+      )
+  connId <- liftIO $ insertedRowId db
+  getConnectionById db vr user connId
+
 updateConnLinkData :: DB.Connection -> User -> Connection -> ConnReqContact -> ConnReqUriHash -> Maybe GroupLinkId -> VersionChat -> PQSupport -> IO ()
 updateConnLinkData db User {userId} Connection {connId} cReq cReqHash groupLinkId_ chatV pqSup = do
   currentTs <- getCurrentTime

src/Simplex/Chat/Store/Groups.hs

@@ -1335,11 +1335,11 @@ groupRelayQuery =
 
 toGroupRelay :: (Int64, GroupMemberId, DBEntityId, ShortLinkContact, Text, Text, BoolInt, Maybe BoolInt, BoolInt, BoolInt, RelayStatus, Maybe ShortLinkContact) -> GroupRelay
 toGroupRelay (groupRelayId, groupMemberId, chatRelayId, address, name, domains, BI preset, tested, BI enabled, BI deleted, relayStatus, relayLink) =
-  let userChatRelay = UserChatRelay {chatRelayId, address, name, domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted}
+  let userChatRelay = UserChatRelay {chatRelayId, address, relayProfile = RelayProfile {name}, domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted}
    in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink}
 
 createRelayForOwner :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupInfo -> UserChatRelay -> ExceptT StoreError IO GroupMember
-createRelayForOwner db vr gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {name} = do
+createRelayForOwner db vr gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {name}} = do
   currentTs <- liftIO getCurrentTime
   let relayProfile = profileFromName name
   (localDisplayName, memProfileId) <- createNewMemberProfile_ db user relayProfile currentTs

src/Simplex/Chat/Store/Postgres/Migrations/M20260222_chat_relays.hs

@@ -72,6 +72,8 @@ ALTER TABLE messages ADD COLUMN msg_chat_binding TEXT;
 ALTER TABLE messages ADD COLUMN msg_signatures BYTEA;
 
 ALTER TABLE chat_items ADD COLUMN msg_signed TEXT;
+
+ALTER TABLE connections ADD COLUMN relay_test SMALLINT NOT NULL DEFAULT 0;
 |]
 
 down_m20260222_chat_relays :: Text
@@ -120,4 +122,6 @@ ALTER TABLE messages DROP COLUMN msg_chat_binding;
 ALTER TABLE messages DROP COLUMN msg_signatures;
 
 ALTER TABLE chat_items DROP COLUMN msg_signed;
+
+ALTER TABLE connections DROP COLUMN relay_test;
 |]

src/Simplex/Chat/Store/Profiles.hs

@@ -634,7 +634,7 @@ getChatRelays db User {userId} =
 
 toChatRelay :: (DBEntityId, ShortLinkContact, Text, Text, BoolInt, Maybe BoolInt, BoolInt) -> UserChatRelay
 toChatRelay (chatRelayId, address, name, domains, BI preset, tested, BI enabled) =
-  UserChatRelay {chatRelayId, address, name, domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted = False}
+  UserChatRelay {chatRelayId, address, relayProfile = RelayProfile {name}, domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted = False}
 
 getChatRelayById :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO UserChatRelay
 getChatRelayById db User {userId} relayId =
@@ -649,7 +649,7 @@ getChatRelayById db User {userId} relayId =
       (userId, relayId)
 
 insertChatRelay :: DB.Connection -> User -> UTCTime -> NewUserChatRelay -> IO UserChatRelay
-insertChatRelay db User {userId} ts relay@UserChatRelay {address, name, domains, preset, tested, enabled} = do
+insertChatRelay db User {userId} ts relay@UserChatRelay {address, relayProfile = RelayProfile {name}, domains, preset, tested, enabled} = do
   crId <-
     fromOnly . head
       <$> DB.query
@@ -664,7 +664,7 @@ insertChatRelay db User {userId} ts relay@UserChatRelay {address, name, domains,
   pure (relay :: NewUserChatRelay) {chatRelayId = DBEntityId crId}
 
 updateChatRelay :: DB.Connection -> UTCTime -> UserChatRelay -> IO ()
-updateChatRelay db ts UserChatRelay {chatRelayId, address, name, domains, preset, tested, enabled} =
+updateChatRelay db ts UserChatRelay {chatRelayId, address, relayProfile = RelayProfile {name}, domains, preset, tested, enabled} =
   DB.execute
     db
     [sql|
@@ -948,7 +948,7 @@ setUserServers' db user@User {userId} ts UpdatedUserOperatorServers {operator, s
         | otherwise -> Just relay <$ updateChatRelay db ts relay
     -- Un-delete soft-deleted relay, updating name and settings but keeping the address unchanged.
     undeleteRelay :: Int64 -> NewUserChatRelay -> IO ()
-    undeleteRelay existingId UserChatRelay {name = nm, domains, preset, tested, enabled} =
+    undeleteRelay existingId UserChatRelay {relayProfile = RelayProfile {name = nm}, domains, preset, tested, enabled} =
       DB.execute db
         [sql|
           UPDATE chat_relays

src/Simplex/Chat/Store/SQLite/Migrations/M20260222_chat_relays.hs

@@ -80,6 +80,8 @@ ALTER TABLE messages ADD COLUMN msg_chat_binding TEXT;
 ALTER TABLE messages ADD COLUMN msg_signatures BLOB;
 
 ALTER TABLE chat_items ADD COLUMN msg_signed TEXT;
+
+ALTER TABLE connections ADD COLUMN relay_test INTEGER NOT NULL DEFAULT 0;
 |]
 
 down_m20260222_chat_relays :: Query
@@ -124,4 +126,6 @@ ALTER TABLE messages DROP COLUMN msg_chat_binding;
 ALTER TABLE messages DROP COLUMN msg_signatures;
 
 ALTER TABLE chat_items DROP COLUMN msg_signed;
+
+ALTER TABLE connections DROP COLUMN relay_test;
 |]

src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt

@@ -1764,6 +1764,15 @@ Query:
 Plan:
 SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+        INSERT INTO connections (
+          user_id, agent_conn_id, conn_level, conn_status, conn_type,
+          conn_chat_version, to_subscribe, pq_support, pq_encryption,
+          relay_test, created_at, updated_at
+        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
+      
+Plan:
+
 Query: 
         INSERT INTO connections (
           user_id, agent_conn_id, conn_level, conn_status, conn_type,
@@ -3293,6 +3302,13 @@ Query:
 Plan:
 SEARCH connections USING INDEX idx_connections_contact_id (contact_id=?)
 
+Query: 
+        SELECT agent_conn_id FROM connections
+        WHERE user_id = ? AND relay_test = 1 AND created_at < ?
+      
+Plan:
+SEARCH connections USING INDEX idx_connections_to_subscribe (user_id=?)
+
 Query: 
         SELECT c.agent_conn_id
         FROM connections c

src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql

@@ -340,6 +340,7 @@ CREATE TABLE connections(
   short_link_inv BLOB,
   via_short_link_contact BLOB,
   via_contact_uri BLOB,
+  relay_test INTEGER NOT NULL DEFAULT 0,
   FOREIGN KEY(snd_file_id, connection_id)
   REFERENCES snd_files(file_id, connection_id)
   ON DELETE CASCADE

src/Simplex/Chat/Store/Shared.hs

@@ -899,3 +899,18 @@ setViaGroupLinkUri db groupId connId = do
 deleteConnectionRecord :: DB.Connection -> User -> Int64 -> IO ()
 deleteConnectionRecord db User {userId} cId = do
   DB.execute db "DELETE FROM connections WHERE user_id = ? AND connection_id = ?" (userId, cId)
+
+getStaleRelayTestConns :: DB.Connection -> User -> UTCTime -> IO [ConnId]
+getStaleRelayTestConns db User {userId} cutoffTs =
+  map fromOnly <$>
+    DB.query
+      db
+      [sql|
+        SELECT agent_conn_id FROM connections
+        WHERE user_id = ? AND relay_test = 1 AND created_at < ?
+      |]
+      (userId, cutoffTs)
+
+deleteConnectionByAgentConnId :: DB.Connection -> User -> ConnId -> IO ()
+deleteConnectionByAgentConnId db User {userId} acId =
+  DB.execute db "DELETE FROM connections WHERE user_id = ? AND agent_conn_id = ?" (userId, acId)