core: option to reuse servers for new user; support for users to configure same smp servers (add user_id to smp_servers UNIQUE constraint) (#1792)

simplex-chat.cabal

@@ -81,6 +81,7 @@ library
       Simplex.Chat.Migrations.M20230107_connections_auth_err_counter
       Simplex.Chat.Migrations.M20230111_users_agent_user_id
       Simplex.Chat.Migrations.M20230117_fkey_indexes
+      Simplex.Chat.Migrations.M20230118_recreate_smp_servers
       Simplex.Chat.Mobile
       Simplex.Chat.Options
       Simplex.Chat.ProfileGenerator

src/Simplex/Chat.hs

@@ -271,18 +271,32 @@ toView event = do
 processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse
 processChatCommand = \case
   ShowActiveUser -> withUser' $ pure . CRActiveUser
-  CreateActiveUser p -> do
+  CreateActiveUser p sameServers -> do
     u <- asks currentUser
-    -- TODO option to choose current user servers
-    DefaultAgentServers {smp} <- asks $ defaultServers . config
+    (smp, smpServers) <- chooseServers
     auId <-
       withStore' getUsers >>= \case
         [] -> pure 1
         _ -> withAgent (`createUser` smp)
     user <- withStore $ \db -> createUserRecord db (AgentUserId auId) p True
+    unless (null smpServers) $
+      withStore $ \db -> overwriteSMPServers db user smpServers
     setActive ActiveNone
     atomically . writeTVar u $ Just user
     pure $ CRActiveUser user
+    where
+      chooseServers :: m (NonEmpty SMPServerWithAuth, [ServerCfg])
+      chooseServers
+        | sameServers =
+          asks currentUser >>= readTVarIO >>= \case
+            Nothing -> throwChatError CENoActiveUser
+            Just user -> do
+              smpServers <- withStore' (`getSMPServers` user)
+              cfg <- asks config
+              pure (activeAgentServers cfg smpServers, smpServers)
+        | otherwise = do
+          DefaultAgentServers {smp} <- asks $ defaultServers . config
+          pure (smp, [])
   ListUsers -> CRUsersList <$> withStore' getUsersInfo
   APISetActiveUser userId -> do
     u <- asks currentUser
@@ -3814,7 +3828,12 @@ chatCommandP =
   choice
     [ "/mute " *> ((`ShowMessages` False) <$> chatNameP'),
       "/unmute " *> ((`ShowMessages` True) <$> chatNameP'),
-      "/create user " *> (CreateActiveUser <$> userProfile),
+      "/create user"
+        *> ( do
+               sameSmp <- (A.space *> "same_smp=" *> onOffP) <|> pure False
+               uProfile <- A.space *> userProfile
+               pure $ CreateActiveUser uProfile sameSmp
+           ),
       "/users" $> ListUsers,
       "/_user " *> (APISetActiveUser <$> A.decimal),
       ("/user " <|> "/u ") *> (SetActiveUser <$> displayName),

src/Simplex/Chat/Controller.hs

@@ -146,7 +146,7 @@ instance ToJSON HelpSection where
 
 data ChatCommand
   = ShowActiveUser
-  | CreateActiveUser Profile
+  | CreateActiveUser Profile Bool
   | ListUsers
   | APISetActiveUser UserId
   | SetActiveUser UserName

src/Simplex/Chat/Migrations/M20230118_recreate_smp_servers.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20230118_recreate_smp_servers where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- UNIQUE constraint includes user_id
+m20230118_recreate_smp_servers :: Query
+m20230118_recreate_smp_servers =
+  [sql|
+DROP INDEX idx_smp_servers_user_id;
+
+CREATE TABLE new_smp_servers (
+  smp_server_id INTEGER PRIMARY KEY,
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  key_hash BLOB NOT NULL,
+  basic_auth TEXT,
+  preset INTEGER NOT NULL DEFAULT 0,
+  tested INTEGER,
+  enabled INTEGER NOT NULL DEFAULT 1,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now')),
+  UNIQUE (user_id, host, port)
+);
+
+INSERT INTO new_smp_servers
+  (smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
+SELECT
+  smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at
+  FROM smp_servers;
+
+DROP TABLE smp_servers;
+ALTER TABLE new_smp_servers RENAME TO smp_servers;
+
+CREATE INDEX idx_smp_servers_user_id ON smp_servers(user_id);
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -386,20 +386,6 @@ CREATE INDEX idx_connections_via_contact_uri_hash ON connections(
 );
 CREATE INDEX idx_contact_requests_xcontact_id ON contact_requests(xcontact_id);
 CREATE INDEX idx_contacts_xcontact_id ON contacts(xcontact_id);
-CREATE TABLE smp_servers(
-  smp_server_id INTEGER PRIMARY KEY,
-  host TEXT NOT NULL,
-  port TEXT NOT NULL,
-  key_hash BLOB NOT NULL,
-  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
-  basic_auth TEXT,
-  preset INTEGER DEFAULT 0 CHECK(preset NOT NULL),
-  tested INTEGER,
-  enabled INTEGER DEFAULT 1 CHECK(enabled NOT NULL),
-  UNIQUE(host, port)
-);
 CREATE INDEX idx_messages_shared_msg_id ON messages(shared_msg_id);
 CREATE INDEX idx_chat_items_shared_msg_id ON chat_items(shared_msg_id);
 CREATE TABLE calls(
@@ -539,7 +525,6 @@ CREATE INDEX idx_received_probes_contact_id ON received_probes(contact_id);
 CREATE INDEX idx_sent_probe_hashes_user_id ON sent_probe_hashes(user_id);
 CREATE INDEX idx_sent_probe_hashes_contact_id ON sent_probe_hashes(contact_id);
 CREATE INDEX idx_settings_user_id ON settings(user_id);
-CREATE INDEX idx_smp_servers_user_id ON smp_servers(user_id);
 CREATE INDEX idx_snd_file_chunks_file_id_connection_id ON snd_file_chunks(
   file_id,
   connection_id
@@ -547,3 +532,18 @@ CREATE INDEX idx_snd_file_chunks_file_id_connection_id ON snd_file_chunks(
 CREATE INDEX idx_snd_files_group_member_id ON snd_files(group_member_id);
 CREATE INDEX idx_snd_files_connection_id ON snd_files(connection_id);
 CREATE INDEX idx_snd_files_file_id ON snd_files(file_id);
+CREATE TABLE IF NOT EXISTS "smp_servers"(
+  smp_server_id INTEGER PRIMARY KEY,
+  host TEXT NOT NULL,
+  port TEXT NOT NULL,
+  key_hash BLOB NOT NULL,
+  basic_auth TEXT,
+  preset INTEGER NOT NULL DEFAULT 0,
+  tested INTEGER,
+  enabled INTEGER NOT NULL DEFAULT 1,
+  user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
+  UNIQUE(user_id, host, port)
+);
+CREATE INDEX idx_smp_servers_user_id ON smp_servers(user_id);

src/Simplex/Chat/Store.hs

@@ -333,6 +333,7 @@ import Simplex.Chat.Migrations.M20221230_idxs
 import Simplex.Chat.Migrations.M20230107_connections_auth_err_counter
 import Simplex.Chat.Migrations.M20230111_users_agent_user_id
 import Simplex.Chat.Migrations.M20230117_fkey_indexes
+import Simplex.Chat.Migrations.M20230118_recreate_smp_servers
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Util (week)
@@ -395,7 +396,8 @@ schemaMigrations =
     ("20221230_idxs", m20221230_idxs),
     ("20230107_connections_auth_err_counter", m20230107_connections_auth_err_counter),
     ("20230111_users_agent_user_id", m20230111_users_agent_user_id),
-    ("20230117_fkey_indexes", m20230117_fkey_indexes)
+    ("20230117_fkey_indexes", m20230117_fkey_indexes),
+    ("20230118_recreate_smp_servers", m20230118_recreate_smp_servers)
   ]
 
 -- | The list of migrations in ascending order by date

tests/ChatTests.hs

@@ -177,6 +177,8 @@ chatTests = do
   describe "multiple users" $ do
     it "create second user" testCreateSecondUser
     it "both users have contact link" testMultipleUserAddresses
+    it "create user with default servers" testCreateUserDefaultServers
+    it "create user with same servers" testCreateUserSameServers
     it "delete user" testDeleteUser
   describe "chat item expiration" $ do
     it "set chat item TTL" testSetChatItemTTL
@@ -4511,6 +4513,40 @@ testMultipleUserAddresses =
       showActiveUser alice "alice (Alice)"
       alice @@@ [("@bob", "hey alice")]
 
+testCreateUserDefaultServers :: IO ()
+testCreateUserDefaultServers =
+  testChat2 aliceProfile bobProfile $
+    \alice _ -> do
+      alice #$> ("/smp smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224", id, "ok")
+      alice #$> ("/smp", id, "smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224")
+
+      alice ##> "/create user alisa"
+      showActiveUser alice "alisa"
+
+      alice #$> ("/smp", id, "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:5001")
+
+      -- with same_smp=off
+      alice ##> "/user alice"
+      showActiveUser alice "alice (Alice)"
+      alice #$> ("/smp", id, "smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224")
+
+      alice ##> "/create user same_smp=off alisa2"
+      showActiveUser alice "alisa2"
+
+      alice #$> ("/smp", id, "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:5001")
+
+testCreateUserSameServers :: IO ()
+testCreateUserSameServers =
+  testChat2 aliceProfile bobProfile $
+    \alice _ -> do
+      alice #$> ("/smp smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224", id, "ok")
+      alice #$> ("/smp", id, "smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224")
+
+      alice ##> "/create user same_smp=on alisa"
+      showActiveUser alice "alisa"
+
+      alice #$> ("/smp", id, "smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224")
+
 testDeleteUser :: IO ()
 testDeleteUser =
   testChat3 aliceProfile bobProfile cathProfile $