core: postgres migration for short links, postgres schema dump, fix query to be compatible (#6025)

* core: postgres migration for short links, postgres schema dump, fix query to be compatible

* rename fields

simplex-chat.cabal

@@ -107,6 +107,7 @@ library
           Simplex.Chat.Store.Postgres.Migrations.M20250402_short_links
           Simplex.Chat.Store.Postgres.Migrations.M20250512_member_admission
           Simplex.Chat.Store.Postgres.Migrations.M20250513_group_scope
+          Simplex.Chat.Store.Postgres.Migrations.M20250526_short_links
   else
       exposed-modules:
           Simplex.Chat.Archive
@@ -517,6 +518,7 @@ test-suite simplex-chat-test
   if flag(client_postgres)
       other-modules:
           ChatTests.DBUtils.Postgres
+          PostgresSchemaDump
   else
       other-modules:
           ChatTests.DBUtils.SQLite

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

@@ -8,6 +8,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20241220_initial
 import Simplex.Chat.Store.Postgres.Migrations.M20250402_short_links
 import Simplex.Chat.Store.Postgres.Migrations.M20250512_member_admission
 import Simplex.Chat.Store.Postgres.Migrations.M20250513_group_scope
+import Simplex.Chat.Store.Postgres.Migrations.M20250526_short_links
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Text, Maybe Text)]
@@ -15,7 +16,8 @@ schemaMigrations =
   [ ("20241220_initial", m20241220_initial, Nothing),
     ("20250402_short_links", m20250402_short_links, Just down_m20250402_short_links),
     ("20250512_member_admission", m20250512_member_admission, Just down_m20250512_member_admission),
-    ("20250513_group_scope", m20250513_group_scope, Just down_m20250513_group_scope)
+    ("20250513_group_scope", m20250513_group_scope, Just down_m20250513_group_scope),
+    ("20250526_short_links", m20250526_short_links, Just down_m20250526_short_links)
   ]
 
 -- | The list of migrations in ascending order by date

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

@@ -0,0 +1,81 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.Postgres.Migrations.M20250526_short_links where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.RawString.QQ (r)
+
+m20250526_short_links :: Text
+m20250526_short_links =
+  T.pack
+    [r|
+ALTER TABLE contacts
+  ADD COLUMN conn_full_link_to_connect BYTEA,
+  ADD COLUMN conn_short_link_to_connect BYTEA,
+  ADD COLUMN welcome_shared_msg_id BYTEA,
+  ADD COLUMN request_shared_msg_id BYTEA,
+  ADD COLUMN contact_request_id BIGINT REFERENCES contact_requests ON DELETE SET NULL;
+CREATE INDEX idx_contacts_contact_request_id ON contacts(contact_request_id);
+
+ALTER TABLE contact_requests
+  ADD COLUMN business_group_id BIGINT REFERENCES groups(group_id) ON DELETE CASCADE,
+  ADD COLUMN welcome_shared_msg_id BYTEA,
+  ADD COLUMN request_shared_msg_id BYTEA;
+CREATE INDEX idx_contact_requests_business_group_id ON contact_requests(business_group_id);
+
+ALTER TABLE group_members
+  ADD COLUMN member_xcontact_id BYTEA,
+  ADD COLUMN member_welcome_shared_msg_id BYTEA;
+
+ALTER TABLE user_contact_links
+  ADD COLUMN short_link_data_set SMALLINT NOT NULL DEFAULT 0,
+  ADD COLUMN short_link_large_data_set SMALLINT NOT NULL DEFAULT 0;
+
+ALTER TABLE groups
+  ADD COLUMN conn_full_link_to_connect BYTEA,
+  ADD COLUMN conn_short_link_to_connect BYTEA,
+  ADD COLUMN conn_link_started_connection SMALLINT NOT NULL DEFAULT 0,
+  ADD COLUMN welcome_shared_msg_id BYTEA,
+  ADD COLUMN request_shared_msg_id BYTEA;
+
+ALTER TABLE chat_items ADD COLUMN show_group_as_sender SMALLINT NOT NULL DEFAULT 0;
+|]
+
+down_m20250526_short_links :: Text
+down_m20250526_short_links =
+  T.pack
+    [r|
+DROP INDEX idx_contacts_contact_request_id;
+
+ALTER TABLE contacts
+  DROP COLUMN conn_full_link_to_connect,
+  DROP COLUMN conn_short_link_to_connect,
+  DROP COLUMN welcome_shared_msg_id,
+  DROP COLUMN request_shared_msg_id,
+  DROP COLUMN contact_request_id;
+
+DROP INDEX idx_contact_requests_business_group_id;
+
+ALTER TABLE contact_requests
+  DROP COLUMN business_group_id,
+  DROP COLUMN welcome_shared_msg_id,
+  DROP COLUMN request_shared_msg_id;
+
+ALTER TABLE group_members
+  DROP COLUMN member_xcontact_id,
+  DROP COLUMN member_welcome_shared_msg_id;
+
+ALTER TABLE user_contact_links
+  DROP COLUMN short_link_data_set,
+  DROP COLUMN short_link_large_data_set;
+
+ALTER TABLE groups
+  DROP COLUMN conn_full_link_to_connect,
+  DROP COLUMN conn_short_link_to_connect,
+  DROP COLUMN conn_link_started_connection,
+  DROP COLUMN welcome_shared_msg_id,
+  DROP COLUMN request_shared_msg_id;
+
+ALTER TABLE chat_items DROP COLUMN show_group_as_sender;
+|]

src/Simplex/Chat/Store/Profiles.hs

@@ -568,7 +568,7 @@ updateUserAddressSettings db userContactLinkId AddressSettings {businessAddress,
       SET auto_accept = ?, auto_accept_incognito = ?, business_address = ?, auto_reply_msg_content = ?
       WHERE user_contact_link_id = ?
     |]
-    (autoAcceptValues :. (businessAddress, autoReply, userContactLinkId))
+    (autoAcceptValues :. (BI businessAddress, autoReply, userContactLinkId))
   where
     autoAcceptValues = case autoAccept of
       Just AutoAccept {acceptIncognito} -> (BI True, BI acceptIncognito)

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

@@ -25,6 +25,7 @@ ALTER TABLE group_members ADD COLUMN member_xcontact_id BLOB;
 ALTER TABLE group_members ADD COLUMN member_welcome_shared_msg_id BLOB;
 
 ALTER TABLE user_contact_links ADD COLUMN short_link_data_set INTEGER NOT NULL DEFAULT 0;
+ALTER TABLE user_contact_links ADD COLUMN short_link_large_data_set INTEGER NOT NULL DEFAULT 0;
 
 ALTER TABLE groups ADD COLUMN conn_full_link_to_connect BLOB;
 ALTER TABLE groups ADD COLUMN conn_short_link_to_connect BLOB;
@@ -55,6 +56,7 @@ ALTER TABLE group_members DROP COLUMN member_xcontact_id;
 ALTER TABLE group_members DROP COLUMN member_welcome_shared_msg_id;
 
 ALTER TABLE user_contact_links DROP COLUMN short_link_data_set;
+ALTER TABLE user_contact_links DROP COLUMN short_link_large_data_set;
 
 ALTER TABLE groups DROP COLUMN conn_full_link_to_connect;
 ALTER TABLE groups DROP COLUMN conn_short_link_to_connect;

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

@@ -339,6 +339,7 @@ CREATE TABLE user_contact_links(
   business_address INTEGER DEFAULT 0,
   short_link_contact BLOB,
   short_link_data_set INTEGER NOT NULL DEFAULT 0,
+  short_link_large_data_set INTEGER NOT NULL DEFAULT 0,
   UNIQUE(user_id, local_display_name)
 );
 CREATE TABLE contact_requests(

tests/ChatClient.hs

@@ -21,6 +21,7 @@ import Control.Logger.Simple (LogLevel (..))
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.List (dropWhileEnd, find)
 import Data.Maybe (isNothing)
@@ -46,7 +47,7 @@ import Simplex.Messaging.Agent (disposeAgentClient)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol (currentSMPAgentVersion, duplexHandshakeSMPAgentVersion, pqdrSMPAgentVersion, supportedSMPAgentVRange)
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Agent.Store.Interface (closeDBStore)
+import Simplex.Messaging.Agent.Store.Interface (DBOpts (..), closeDBStore)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Client (ProtocolClientConfig (..))
@@ -77,6 +78,15 @@ import System.FilePath ((</>))
 #endif
 
 #if defined(dbPostgres)
+schemaDumpDBOpts :: DBOpts
+schemaDumpDBOpts =
+  DBOpts
+    { connstr = B.pack testDBConnstr,
+      schema = "test_chat_schema",
+      poolSize = 3,
+      createSchema = True
+    }
+
 testDBConnstr :: String
 testDBConnstr = "postgresql://test_chat_user@/test_chat_db"
 

tests/ChatTests/Profiles.hs

@@ -3324,11 +3324,8 @@ testBusinessAddressRequestMessage ps@TestParams {largeLinkData} = testChatCfg3 t
       biz <# "#bob bob_1> Hello!"
       biz <## "#bob (Bob): accepting business address request..."
       bob <## "#biz: joining the group..."
-      unless largeLinkData $ do
-        biz <# "#bob Welcome!"
-        bob <# "#biz biz_1> Welcome!"
-      biz <## "#bob: bob_1 joined the group"
-      bob <## "#biz: you joined the group"
+      biz <### (["#bob: bob_1 joined the group"] <> [WithTime "#bob Welcome!" | not largeLinkData])
+      bob <### (["#biz: you joined the group"] <> [WithTime "#biz biz_1> Welcome!" | not largeLinkData])
       -- Another member should receive history
       connectUsers biz alice
       biz ##> "/a bob alice"
@@ -3438,11 +3435,9 @@ testGroupShortLinkWelcome ps@TestParams {largeLinkData} = testChatCfg2 testCfg {
         [ alice <## "#team: bob joined the group",
           do
             bob <## "#team: joining the group..."
-            bob <## "#team: you joined the group"
+            bob <### (["#team: you joined the group"] <> [WithTime "#team alice> Welcome!" | not largeLinkData])
         ]
-      bob #$> ("/_get chat #1 count=100", chat, groupFeaturesNoE2E <> [(0, "Welcome!") | largeLinkData] <> [(0, e2eeInfoNoPQStr), (0, "connected")])
-      unless largeLinkData $
-        bob <# "#team alice> Welcome!"
+      bob #$> ("/_get chat #1 count=100", chat, groupFeaturesNoE2E <> [(0, "Welcome!"), (0, e2eeInfoNoPQStr), (0, "connected")])
       alice #> "#team 1"
       bob <# "#team alice> 1"
       bob #> "#team 2"

tests/ChatTests/Utils.hs

@@ -97,6 +97,9 @@ ifCI xrun run d t = do
   ci <- runIO $ lookupEnv "CI"
   (if ci == Just "true" then xrun else run) d t
 
+envCI :: IO Bool
+envCI = (Just "true" ==) <$> lookupEnv "CI"
+
 skip :: String -> SpecWith a -> SpecWith a
 skip = before_ . pendingWith
 

tests/PostgresSchemaDump.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module PostgresSchemaDump (postgresSchemaDumpTest) where
+
+import ChatTests.Utils hiding (it)
+import Control.Concurrent (threadDelay)
+import Control.DeepSeq
+import Control.Monad (unless, void)
+import qualified Data.ByteString.Char8 as B
+import Data.List (dropWhileEnd)
+import Data.Maybe (fromJust, isJust)
+import Simplex.Messaging.Agent.Store.Postgres (closeDBStore, createDBStore)
+import Simplex.Messaging.Agent.Store.Postgres.Common (DBOpts (..))
+import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
+import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
+import Simplex.Messaging.Util (ifM, whenM)
+import System.Directory (doesFileExist, removeFile)
+import System.Process (readCreateProcess, shell)
+import Test.Hspec
+
+testSchemaPath :: FilePath
+testSchemaPath = "tests/tmp/test_schema.sql"
+
+-- copied from simplexmq
+postgresSchemaDumpTest :: [Migration] -> [String] -> DBOpts -> FilePath -> Spec
+postgresSchemaDumpTest migrations skipComparisonForDownMigrations testDBOpts@DBOpts {connstr, schema = testDBSchema} srcSchemaPath = do
+  it "verify and overwrite schema dump" testVerifySchemaDump
+  it "verify schema down migrations" testSchemaMigrations
+  where
+    testVerifySchemaDump = do
+      savedSchema <- ifM (doesFileExist srcSchemaPath) (readFile srcSchemaPath) (pure "")
+      savedSchema `deepseq` pure ()
+      void $ createDBStore testDBOpts migrations MCConsole
+      getSchema srcSchemaPath `shouldReturn` savedSchema
+
+    testSchemaMigrations = do
+      let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) migrations
+      st <- createDBStore testDBOpts noDownMigrations MCYesUpDown >>= \case
+        Right st -> pure st
+        Left e -> error $ show e
+      mapM_ (testDownMigration st) $ drop (length noDownMigrations) migrations
+      closeDBStore st
+      whenM (doesFileExist testSchemaPath) $ removeFile testSchemaPath
+      where
+        testDownMigration st m = do
+          putStrLn $ "down migration " <> name m
+          let downMigr = fromJust $ toDownMigration m
+          schema <- getSchema testSchemaPath
+          Migrations.run st $ MTRUp [m]
+          schema' <- getSchema testSchemaPath
+          schema' `shouldNotBe` schema
+          Migrations.run st $ MTRDown [downMigr]
+          unless (name m `elem` skipComparisonForDownMigrations) $ do
+            schema'' <- getSchema testSchemaPath
+            schema'' `shouldBe` schema
+          Migrations.run st $ MTRUp [m]
+          schema''' <- getSchema testSchemaPath
+          schema''' `shouldBe` schema'
+
+    getSchema :: FilePath -> IO String
+    getSchema schemaPath = do
+      ci <- envCI
+      let cmd =
+            ("pg_dump " <> B.unpack connstr <> " --schema " <> B.unpack testDBSchema)
+              <> " --schema-only --no-owner --no-privileges --no-acl --no-subscriptions --no-tablespaces > "
+              <> schemaPath
+      void $ readCreateProcess (shell cmd) ""
+      threadDelay 20000
+      let sed = (if ci then "sed -i" else "sed -i ''")
+      void $ readCreateProcess (shell $ sed <> " '/^--/d' " <> schemaPath) ""
+      sch <- readFile schemaPath
+      sch `deepseq` pure sch

tests/Test.hs

@@ -9,6 +9,7 @@ import ChatClient
 import ChatTests
 import ChatTests.DBUtils
 import ChatTests.Utils (xdescribe'')
+import Control.Exception (bracket_)
 import Control.Logger.Simple
 import Data.Time.Clock.System
 import JSONTests
@@ -23,7 +24,10 @@ import UnliftIO.Temporary (withTempDirectory)
 import ValidNames
 import ViewTests
 #if defined(dbPostgres)
+import PostgresSchemaDump
+import Simplex.Chat.Store.Postgres.Migrations (migrations)
 import Simplex.Messaging.Agent.Store.Postgres.Util (createDBAndUserIfNotExists, dropAllSchemasExceptSystem, dropDatabaseAndUser)
+import System.Directory (createDirectory, removePathForcibly)
 #else
 import qualified Simplex.Messaging.TMap as TM
 import MobileTests
@@ -44,8 +48,15 @@ main = do
     . afterAll_ (dropDatabaseAndUser testDBConnectInfo)
 #endif
     $ do
--- TODO [postgres] schema dump for postgres
-#if !defined(dbPostgres)
+#if defined(dbPostgres)
+      around_ (bracket_ (createDirectory "tests/tmp") (removePathForcibly "tests/tmp")) $
+        describe "Postgres schema dump" $
+          postgresSchemaDumpTest
+            migrations
+            [] -- skipComparisonForDownMigrations
+            schemaDumpDBOpts
+            "src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql"
+#else
       describe "Schema dump" schemaDumpTest
       around tmpBracket $ describe "WebRTC encryption" webRTCTests
 #endif