Merge branch 'chat-relays' into f/chat-relays-protocol

2026-04-26 15:18:01 +00:00 · 2025-10-27 16:31:08 +04:00
parent dea4d2ddb0 5ddc454049
commit f38d1bd747
14 changed files with 240 additions and 61 deletions
--- a/bots/src/API/Docs/Commands.hs
+++ b/bots/src/API/Docs/Commands.hs
@@ -434,6 +434,7 @@ undocumentedCommands =
    "GetChatItemTTL",
    "GetRemoteFile",
    "GetUserProtoServers",
+    "GetUserChatRelays",
    "ListRemoteCtrls",
    "ListRemoteHosts",
    "ReconnectAllServers",
@@ -451,6 +452,7 @@ undocumentedCommands =
    "SetServerOperators",
    "SetTempFolder",
    "SetUserProtoServers",
+    "SetUserChatRelays",
    "SlowSQLQueries",
    "StartChat",
    "StartRemoteHost",
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -533,6 +533,7 @@ test-suite simplex-chat-test
      ChatClient
      ChatTests
      ChatTests.ChatList
+      ChatTests.ChatRelays
      ChatTests.Direct
      ChatTests.DBUtils
      ChatTests.Files
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -389,6 +389,11 @@ data ChatCommand
  | SetUserProtoServers AProtocolType [AProtoServerWithAuth]
  | APITestProtoServer UserId AProtoServerWithAuth
  | TestProtoServer AProtoServerWithAuth
+  | GetUserChatRelays
+  | SetUserChatRelays [CLINewRelay]
+  -- TODO [chat relays] commands to test chat relay
+  -- | APITestChatRelay UserId ConnLinkContact
+  -- | TestChatRelay ConnLinkContact
  | APIGetServerOperators
  | APISetServerOperators (NonEmpty ServerOperator)
  | SetServerOperators (NonEmpty ServerOperatorRoles)
--- a/src/Simplex/Chat/Core.hs
+++ b/src/Simplex/Chat/Core.hs
@@ -15,7 +15,9 @@ where

 import Control.Logger.Simple
 import Control.Monad
+import Control.Monad.Except
 import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as B
 import Data.List (find)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -27,18 +29,21 @@ import Simplex.Chat.Library.Commands
 import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..), CreateBotOpts (..))
 import Simplex.Chat.Remote.Types (RemoteHostId)
 import Simplex.Chat.Store.Profiles
+import Simplex.Chat.Store.Shared (StoreError (..))
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences (FeatureAllowed (..), FilesPreference (..), Preferences (..), emptyChatPrefs)
-import Simplex.Chat.View (ChatResponseEvent, serializeChatError, serializeChatResponse)
+import Simplex.Chat.View (ChatResponseEvent, serializeChatError, serializeChatResponse, simplexChatContact)
+import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationConfirmation (..))
 import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
+import Simplex.Messaging.Encoding.String
 import System.Exit (exitFailure)
 import System.IO (hFlush, stdout)
 import Text.Read (readMaybe)
 import UnliftIO.Async

 simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
-simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@ChatOpts {coreOptions = CoreChatOpts {dbOptions, logAgent, yesToUpMigrations, migrationBackupPath}, createBot, maintenance} chat =
+simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {dbOptions, logAgent, yesToUpMigrations, migrationBackupPath}, createBot, maintenance} chat =
  case logAgent of
    Just level -> do
      setLogLevel level
@@ -51,19 +56,21 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha
      putStrLn $ "Error opening database: " <> show e
      exitFailure
    run db@ChatDatabase {chatStore} = do
-      u_ <- getSelectActiveUser chatStore
+      users <- withTransaction chatStore getUsers
+      u_ <- selectActiveUser coreOptions chatStore users
      let backgroundMode = not maintenance
      cc <- newChatController db u_ cfg opts backgroundMode
-      u <- maybe (createActiveUser cc createBot) pure u_
+      u <- maybe (createActiveUser cc coreOptions createBot) pure u_
      unless testView $ putStrLn $ "Current user: " <> userStr u
      unless maintenance $ forM_ (preStartHook chatHooks) ($ cc)
-      runSimplexChat opts u cc chat
+      runSimplexChat cfg opts u cc chat

-runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
-runSimplexChat ChatOpts {maintenance} u cc@ChatController {config = ChatConfig {chatHooks}} chat
+runSimplexChat :: ChatConfig -> ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
+runSimplexChat ChatConfig {testView} ChatOpts {coreOptions = CoreChatOpts {chatRelay}, maintenance} u cc@ChatController {config = ChatConfig {chatHooks}} chat
  | maintenance = wait =<< async (chat u cc)
  | otherwise = do
      a1 <- runReaderT (startChatController True True) cc
+      when (chatRelay && not testView) $ askCreateRelayAddress cc u
      forM_ (postStartHook chatHooks) ($ cc)
      a2 <- async $ chat u cc
      waitEither_ a1 a2
@@ -74,24 +81,30 @@ sendChatCmdStr cc s = runReaderT (execChatCommand Nothing (encodeUtf8 $ T.pack s
 sendChatCmd :: ChatController -> ChatCommand -> IO (Either ChatError ChatResponse)
 sendChatCmd cc cmd = runReaderT (execChatCommand' cmd 0) cc

-getSelectActiveUser :: DBStore -> IO (Maybe User)
-getSelectActiveUser st = do
-  users <- withTransaction st getUsers
-  case find activeUser users of
-    Just u -> pure $ Just u
-    Nothing -> selectUser users
+selectActiveUser :: CoreChatOpts -> DBStore -> [User] -> IO (Maybe User)
+selectActiveUser CoreChatOpts {chatRelay} st users
+  | chatRelay =
+      case find (\User {userChatRelay} -> isTrue userChatRelay) users of
+        Just u
+          | activeUser u -> pure $ Just u
+          | otherwise -> Just <$> withTransaction st (`setActiveUser` u)
+        Nothing -> pure Nothing
+  | otherwise =
+      case find activeUser users of
+        Just u -> pure $ Just u
+        Nothing -> selectUser
  where
-    selectUser :: [User] -> IO (Maybe User)
-    selectUser = \case
+    selectUser :: IO (Maybe User)
+    selectUser = case users of
      [] -> pure Nothing
      [user] -> Just <$> withTransaction st (`setActiveUser` user)
-      users -> do
+      _users -> do
        putStrLn "Select user profile:"
        forM_ (zip [1 :: Int ..] users) $ \(n, user) -> putStrLn $ show n <> ": " <> userStr user
        loop
        where
          loop = do
-            nStr <- getWithPrompt $ "user number (1 .. " <> show (length users) <> ")"
+            nStr <- withPrompt ("user number (1 .. " <> show (length users) <> "): ") getLine
            case readMaybe nStr :: Maybe Int of
              Nothing -> putStrLn "not a number" >> loop
              Just n
@@ -100,39 +113,79 @@ getSelectActiveUser st = do
                    let user = users !! (n - 1)
                     in Just <$> withTransaction st (`setActiveUser` user)

-createActiveUser :: ChatController -> Maybe CreateBotOpts -> IO User
-createActiveUser cc = \case
+createActiveUser :: ChatController -> CoreChatOpts -> Maybe CreateBotOpts -> IO User
+createActiveUser cc CoreChatOpts {chatRelay} = \case
  Just CreateBotOpts {botDisplayName, allowFiles} -> do
    let preferences = if allowFiles then Nothing else Just emptyChatPrefs {files = Just FilesPreference {allow = FANo}}
    createUser exitFailure $ (mkProfile botDisplayName) {peerType = Just CPTBot, preferences}
-  Nothing -> do
-    putStrLn
-      "No user profiles found, it will be created now.\n\
-      \Please choose your display name.\n\
-      \It will be sent to your contacts when you connect.\n\
-      \It is only stored on your device and you can change it later."
-    loop
+  Nothing
+    | chatRelay -> do
+        putStrLn
+          "No chat relay user profile found, it will be created now.\n\
+          \Please choose chat relay display name."
+        loop
+    | otherwise -> do
+        putStrLn
+          "No user profiles found, it will be created now.\n\
+          \Please choose your display name.\n\
+          \It will be sent to your contacts when you connect.\n\
+          \It is only stored on your device and you can change it later."
+        loop
  where
    loop = do
-      displayName <- T.pack <$> getWithPrompt "display name"
+      displayName <- T.pack <$> withPrompt "display name: " getLine
      createUser loop $ mkProfile displayName
    mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing}
    createUser onError p =
-      execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False, userChatRelay = False}) 0 `runReaderT` cc >>= \case
+      execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False, userChatRelay = chatRelay}) 0 `runReaderT` cc >>= \case
        Right (CRActiveUser user) -> pure user
        r -> printResponseEvent (Nothing, Nothing) (config cc) r >> onError

+askCreateRelayAddress :: ChatController -> User -> IO ()
+askCreateRelayAddress cc@ChatController {chatStore} user =
+  withTransaction chatStore (\db -> runExceptT $ getUserAddress db user) >>= \case
+    Right _ -> pure ()
+    Left SEUserContactLinkNotFound -> promptCreate
+    Left e -> printChatError (config cc) $ ChatErrorStore e
+  where
+    promptCreate :: IO ()
+    promptCreate = do
+      ok <- onOffPrompt "Create relay address" True
+      when ok $
+        execChatCommand' CreateMyAddress 0 `runReaderT` cc >>= \case
+          Right (CRUserContactLinkCreated _ address) -> do
+            putStrLn "Chat relay address is created:"
+            putStrLn $ addressStr address
+          r -> printResponseEvent (Nothing, Nothing) (config cc) r
+    addressStr :: CreatedLinkContact -> String
+    addressStr (CCLink cReq shortLink) = B.unpack $ maybe cReqStr strEncode shortLink
+      where
+        cReqStr = strEncode $ simplexChatContact cReq
+
 printResponseEvent :: ChatResponseEvent r => (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Either ChatError r -> IO ()
 printResponseEvent hu cfg = \case
  Right r -> do
    ts <- getCurrentTime
    tz <- getCurrentTimeZone
    putStrLn $ serializeChatResponse hu cfg ts tz (fst hu) r
-  Left e -> do
-    putStrLn $ serializeChatError True cfg e
+  Left e -> printChatError cfg e

-getWithPrompt :: String -> IO String
-getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine
+printChatError :: ChatConfig -> ChatError -> IO ()
+printChatError cfg e = putStrLn $ serializeChatError True cfg e
+
+withPrompt :: String -> IO a -> IO a
+withPrompt s a = putStr s >> hFlush stdout >> a
+
+onOffPrompt :: String -> Bool -> IO Bool
+onOffPrompt prompt def =
+  withPrompt (prompt <> if def then " (Yn): " else " (yN): ") $
+    getLine >>= \case
+      "" -> pure def
+      "y" -> pure True
+      "Y" -> pure True
+      "n" -> pure False
+      "N" -> pure False
+      _ -> putStrLn "Invalid input, please enter 'y' or 'n'" >> onOffPrompt prompt def

 userStr :: User -> String
 userStr User {localDisplayName, profile = LocalProfile {fullName}} =
--- a/src/Simplex/Chat/Library/Commands.hs
+++ b/src/Simplex/Chat/Library/Commands.hs
@@ -1442,7 +1442,7 @@ processChatCommand vr nm = \case
    pure $ CRConnNtfMessages ntfMsgs
  GetUserProtoServers (AProtocolType p) -> withUser $ \user -> withServerProtocol p $ do
    srvs <- withFastStore (`getUserServers` user)
-    liftIO $ CRUserServers user <$> groupByOperator (protocolServers p srvs)
+    liftIO $ CRUserServers user <$> groupByOperator (onlyProtocolServers p srvs)
  SetUserProtoServers (AProtocolType (p :: SProtocolType p)) srvs -> withUser $ \user@User {userId} -> withServerProtocol p $ do
    userServers_ <- liftIO . groupByOperator =<< withFastStore (`getUserServers` user)
    case L.nonEmpty userServers_ of
@@ -1461,6 +1461,21 @@ processChatCommand vr nm = \case
    lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a nm (aUserId user) server)
  TestProtoServer srv -> withUser $ \User {userId} ->
    processChatCommand vr nm $ APITestProtoServer userId srv
+  GetUserChatRelays -> withUser $ \user -> do
+    srvs <- withFastStore (`getUserServers` user)
+    liftIO $ CRUserServers user <$> groupByOperator (onlyRelays srvs)
+  SetUserChatRelays relays -> withUser $ \user@User {userId} -> do
+    userServers_ <- liftIO . groupByOperator =<< withFastStore (`getUserServers` user)
+    case L.nonEmpty userServers_ of
+      Nothing -> throwCmdError "no relays"
+      Just userServers -> case relays of
+        [] -> throwCmdError "no relays"
+        _ -> do
+          let relays' = map aUserRelay relays
+          processChatCommand vr nm $ APISetUserServers userId $ L.map (updatedRelays relays') userServers
+    where
+      aUserRelay :: CLINewRelay -> AUserChatRelay
+      aUserRelay CLINewRelay {address, name} = AUCR SDBNew $ newChatRelay name [""] address
  APIGetServerOperators -> CRServerOperatorConditions <$> withFastStore getServerOperators
  APISetServerOperators operators -> do
    as <- asks randomAgentServers
@@ -2017,6 +2032,7 @@ processChatCommand vr nm = \case
      Left e -> throwError $ ChatErrorStore e
      Right _ -> throwError $ ChatErrorStore SEDuplicateContactLink
    subMode <- chatReadVar subscriptionMode
+    -- TODO [chat relays] add relay key, identity to link data
    let userData = contactShortLinkData (userProfileDirect user Nothing Nothing True) Nothing
    -- TODO [certs rcv]
    (connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a nm (aUserId user) True True SCMContact (Just userData) Nothing IKPQOn subMode
@@ -4041,9 +4057,8 @@ data ConnectViaContactResult
  = CVRConnectedContact Contact
  | CVRSentInvitation Connection (Maybe Profile)

-- TODO [chat relays] used for CLI specific APIs (same for `updatedServers` below) - add similar APIs for chat relays?
-protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay])
-protocolServers p (operators, smpServers, xftpServers, _chatRelays) = case p of
+onlyProtocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay])
+onlyProtocolServers p (operators, smpServers, xftpServers, _chatRelays) = case p of
  SPSMP -> (operators, smpServers, [], [])
  SPXFTP -> (operators, [], xftpServers, [])

@@ -4061,6 +4076,19 @@ updatedServers p' srvs UserOperatorServers {operator, smpServers, xftpServers, c
    disableSrv srv@UserServer {preset} =
      AUS SDBStored $ if preset then srv {enabled = False} else srv {deleted = True}

+onlyRelays :: ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay])
+onlyRelays (operators, _smpServers, _xftpServers, chatRelays) = (operators, [], [], chatRelays)
+
+-- disable preset and replace custom chat relays (groupByOperator always adds custom)
+updatedRelays :: [AUserChatRelay] -> UserOperatorServers -> UpdatedUserOperatorServers
+updatedRelays relays UserOperatorServers {operator, smpServers, xftpServers, chatRelays} =
+  UpdatedUserOperatorServers operator (map (AUS SDBStored) smpServers) (map (AUS SDBStored) xftpServers) (updateRelays chatRelays)
+  where
+    updateRelays :: [UserChatRelay] -> [AUserChatRelay]
+    updateRelays pRelays = map disableRelay pRelays <> maybe relays (const []) operator
+    disableRelay relay@UserChatRelay {preset} =
+      AUCR SDBStored $ if preset then relay {enabled = False} else relay {deleted = True}
+
 type ComposedMessageReq = (ComposedMessage, Maybe CIForwardedFrom, (Text, Maybe MarkdownList), Map MemberName CIMention)

 composedMessage :: Maybe CryptoFile -> MsgContent -> ComposedMessage
@@ -4436,6 +4464,8 @@ chatCommandP =
      "/xftp " *> (SetUserProtoServers (AProtocolType SPXFTP) . map (AProtoServerWithAuth SPXFTP) <$> protocolServersP),
      "/smp" $> GetUserProtoServers (AProtocolType SPSMP),
      "/xftp" $> GetUserProtoServers (AProtocolType SPXFTP),
+      "/relays " *> (SetUserChatRelays <$> chatRelaysP),
+      "/relays" $> GetUserChatRelays,
      "/_operators" $> APIGetServerOperators,
      "/_operators " *> (APISetServerOperators <$> jsonP),
      "/operators " *> (SetServerOperators . L.fromList <$> operatorRolesP `A.sepBy1` A.char ','),
@@ -4848,6 +4878,11 @@ chatCommandP =
      optional ("yes" *> A.space) *> (TMEEnableSetTTL <$> timedTTLP)
        <|> ("yes" $> TMEEnableKeepTTL)
        <|> ("no" $> TMEDisableKeepTTL)
+    chatRelaysP = chatRelayP `A.sepBy1` A.char ' '
+    chatRelayP = do
+      name <- "name=" *> text1P
+      address <- _strP
+      pure CLINewRelay {name, address}
    operatorRolesP = do
      operatorId' <- A.decimal
      enabled' <- A.char ':' *> onOffP
--- a/src/Simplex/Chat/Mobile.hs
+++ b/src/Simplex/Chat/Mobile.hs
@@ -253,6 +253,7 @@ mobileChatOpts dbOptions =
            logFile = Nothing,
            tbqSize = 4096,
            deviceName = Nothing,
+            chatRelay = False,
            highlyAvailable = False,
            yesToUpMigrations = False,
            migrationBackupPath = Just ""
--- a/src/Simplex/Chat/Operators.hs
+++ b/src/Simplex/Chat/Operators.hs
@@ -271,6 +271,13 @@ data UserChatRelay' s = UserChatRelay
  }
  deriving (Show)

+-- for setting chat relays via CLI API
+data CLINewRelay = CLINewRelay
+  { address :: ConnLinkContact,
+    name :: Text
+  }
+  deriving (Show)
+
 data PresetOperator = PresetOperator
  { operator :: Maybe NewServerOperator,
    smp :: [NewUserServer 'PSMP],
@@ -503,16 +510,16 @@ validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs other
    userServers :: (UserServersClass u, UserProtocol p) => SProtocolType p -> [u] -> [AUserServer p]
    userServers p = map aUserServer' . concatMap (servers' p)
    chatRelayErrs :: UserServersClass u => [u] -> [UserServersError]
-    chatRelayErrs uss = concatMap duplicateErrs_ speers
+    chatRelayErrs uss = concatMap duplicateErrs_ cRelays
      where
-        speers = filter (\(AUCR _ UserChatRelay {deleted}) -> not deleted) $ userChatRelays uss
+        cRelays = filter (\(AUCR _ UserChatRelay {deleted}) -> not deleted) $ userChatRelays uss
        duplicateErrs_ (AUCR _ UserChatRelay {name, address}) =
          [USEDuplicateChatRelayName name | name `elem` duplicateNames]
            <> [USEDuplicateChatRelayAddress name address | address `elem` duplicateAddresses]
        duplicateNames = snd $ foldl' addDuplicate (S.empty, S.empty) allNames
-        allNames = map (\(AUCR _ speer) -> name speer) speers
+        allNames = map (\(AUCR _ UserChatRelay {name}) -> name) cRelays
        duplicateAddresses = snd $ foldl' addAddress ([], []) allAddresses
-        allAddresses = map (\(AUCR _ speer) -> address speer) speers
+        allAddresses = map (\(AUCR _ UserChatRelay {address}) -> address) cRelays
        addAddress :: ([ConnLinkContact], [ConnLinkContact]) -> ConnLinkContact -> ([ConnLinkContact], [ConnLinkContact])
        addAddress (xs, dups) x
          | any (sameConnLinkContact x) xs = (xs, x : dups)
@@ -524,8 +531,8 @@ validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs other
      | noChatRelays opEnabled = [USWNoChatRelays user]
      | otherwise = []
      where
-        noChatRelays cond = not $ any speerEnabled $ userChatRelays $ filter cond uss
-        speerEnabled (AUCR _ UserChatRelay {deleted, enabled}) = enabled && not deleted
+        noChatRelays cond = not $ any relayEnabled $ userChatRelays $ filter cond uss
+        relayEnabled (AUCR _ UserChatRelay {deleted, enabled}) = enabled && not deleted
    userChatRelays :: UserServersClass u => [u] -> [AUserChatRelay]
    userChatRelays = map aUserChatRelay' . concatMap chatRelays'
    opEnabled :: UserServersClass u => u -> Bool
--- a/src/Simplex/Chat/Options.hs
+++ b/src/Simplex/Chat/Options.hs
@@ -66,6 +66,7 @@ data CoreChatOpts = CoreChatOpts
    logFile :: Maybe FilePath,
    tbqSize :: Natural,
    deviceName :: Maybe Text,
+    chatRelay :: Bool,
    highlyAvailable :: Bool,
    yesToUpMigrations :: Bool,
    migrationBackupPath :: Maybe FilePath
@@ -233,6 +234,11 @@ coreChatOptsP appDir defaultDbName = do
            <> metavar "DEVICE"
            <> help "Device name to use in connections with remote hosts and controller"
        )
+  chatRelay <-
+    switch
+      ( long "relay"
+          <> help "Run as a chat relay client"
+      )
  highlyAvailable <-
    switch
      ( long "ha"
@@ -269,6 +275,7 @@ coreChatOptsP appDir defaultDbName = do
        logFile,
        tbqSize,
        deviceName,
+        chatRelay,
        highlyAvailable,
        yesToUpMigrations,
        migrationBackupPath
--- a/src/Simplex/Chat/Store/Profiles.hs
+++ b/src/Simplex/Chat/Store/Profiles.hs
@@ -140,8 +140,10 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, shortDe
    order <- getNextActiveOrder db
    DB.execute
      db
-      "INSERT INTO users (agent_user_id, local_display_name, active_user, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, auto_accept_member_contacts, created_at, updated_at) VALUES (?,?,?,?,0,?,?,?,?,?,?)"
-      (auId, displayName, BI activeUser, order, BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, currentTs, currentTs)
+      "INSERT INTO users (agent_user_id, local_display_name, active_user, is_user_chat_relay, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, auto_accept_member_contacts, created_at, updated_at) VALUES (?,?,?,?,?,0,?,?,?,?,?,?)"
+      ( (auId, displayName, BI activeUser, BI userChatRelay, order)
+          :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, currentTs, currentTs)
+      )
    userId <- insertedRowId db
    DB.execute
      db
@@ -628,7 +630,7 @@ getChatRelays db User {userId} =
      UserChatRelay {chatRelayId, address, name, domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted = False}

 insertChatRelay :: DB.Connection -> User -> UTCTime -> NewUserChatRelay -> IO UserChatRelay
-insertChatRelay db User {userId} ts speer@UserChatRelay {address, name, domains, preset, tested, enabled} = do
+insertChatRelay db User {userId} ts relay@UserChatRelay {address, name, domains, preset, tested, enabled} = do
  crId <-
    fromOnly . head
      <$> DB.query
@@ -640,7 +642,7 @@ insertChatRelay db User {userId} ts speer@UserChatRelay {address, name, domains,
          RETURNING chat_relay_id
        |]
        (address, name, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, userId, ts, ts)
-  pure speer {chatRelayId = DBEntityId crId}
+  pure relay {chatRelayId = DBEntityId crId}

 updateChatRelay :: DB.Connection -> UTCTime -> UserChatRelay -> IO ()
 updateChatRelay db ts UserChatRelay {chatRelayId, address, name, domains, preset, tested, enabled} =
@@ -900,13 +902,13 @@ setUserServers' db user@User {userId} ts UpdatedUserOperatorServers {operator, s
        | deleted -> Nothing <$ DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND smp_server_id = ? AND preset = ?" (userId, srvId, BI False)
        | otherwise -> Just s <$ updateProtocolServer db p ts s
    upsertOrDeleteCRelay :: AUserChatRelay -> IO (Maybe UserChatRelay)
-    upsertOrDeleteCRelay (AUCR _ speer@UserChatRelay {chatRelayId, deleted}) = case chatRelayId of
+    upsertOrDeleteCRelay (AUCR _ relay@UserChatRelay {chatRelayId, deleted}) = case chatRelayId of
      DBNewEntity
        | deleted -> pure Nothing
-        | otherwise -> Just <$> insertChatRelay db user ts speer
-      DBEntityId speerId
-        | deleted -> Nothing <$ DB.execute db "DELETE FROM chat_relays WHERE user_id = ? AND chat_relay_id = ? AND preset = ?" (userId, speerId, BI False)
-        | otherwise -> Just speer <$ updateChatRelay db ts speer
+        | otherwise -> Just <$> insertChatRelay db user ts relay
+      DBEntityId relayId
+        | deleted -> Nothing <$ DB.execute db "DELETE FROM chat_relays WHERE user_id = ? AND chat_relay_id = ? AND preset = ?" (userId, relayId, BI False)
+        | otherwise -> Just relay <$ updateChatRelay db ts relay

 createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
 createCall db user@User {userId} Call {contactId, callId, callUUID, chatItemId, callState} callTs = do
--- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
+++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
@@ -962,6 +962,14 @@ Query:
        
 Plan:

+Query: 
+          INSERT INTO chat_relays
+            (address, name, domains, preset, tested, enabled, user_id, created_at, updated_at)
+          VALUES (?,?,?,?,?,?,?,?,?)
+          RETURNING chat_relay_id
+        
+Plan:
+
 Query: 
          INSERT INTO group_members
            ( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
@@ -5667,6 +5675,10 @@ SEARCH chat_items USING COVERING INDEX idx_chat_items_fwd_from_chat_item_id (fwd
 SEARCH files USING COVERING INDEX idx_files_chat_item_id (chat_item_id=?)
 SEARCH groups USING COVERING INDEX idx_groups_chat_item_id (chat_item_id=?)

+Query: DELETE FROM chat_relays WHERE user_id = ? AND chat_relay_id = ? AND preset = ?
+Plan:
+SEARCH chat_relays USING INTEGER PRIMARY KEY (rowid=?)
+
 Query: DELETE FROM commands WHERE user_id = ? AND command_id = ?
 Plan:
 SEARCH commands USING INTEGER PRIMARY KEY (rowid=?)
@@ -6058,7 +6070,7 @@ Plan:
 Query: INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
 Plan:

-Query: INSERT INTO users (agent_user_id, local_display_name, active_user, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, auto_accept_member_contacts, created_at, updated_at) VALUES (?,?,?,?,0,?,?,?,?,?,?)
+Query: INSERT INTO users (agent_user_id, local_display_name, active_user, is_user_chat_relay, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, auto_accept_member_contacts, created_at, updated_at) VALUES (?,?,?,?,?,0,?,?,?,?,?,?)
 Plan:

 Query: INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -24,7 +24,6 @@ import Data.Function (on)
 import Data.Int (Int64)
 import Data.List (groupBy, intercalate, intersperse, sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
@@ -1506,14 +1505,14 @@ viewUserServers UserOperatorServers {operator, smpServers, xftpServers, chatRela
    viewChatRelays [] = []
    viewChatRelays cRelays
      | maybe True (\ServerOperator {enabled} -> enabled) operator =
-          ["Chat relays"] <> map (plain . ("    " <>) . viewChatRelay) cRelays
+          ["  Chat relays"] <> map (plain . ("    " <>) . viewChatRelay) cRelays
      | otherwise = []
      where
-        viewChatRelay UserChatRelay {name, address, preset, tested, enabled} = name <> chatrelayAddress <> chatrelayInfo
+        viewChatRelay UserChatRelay {name, address, preset, tested, enabled} = name <> relayAddress <> relayInfo
          where
-            chatrelayAddress = "(" <> safeDecodeUtf8 (strEncode address) <> ")"
-            chatrelayInfo = if null chatrelayInfo_ then "" else parens $ T.intercalate ", " chatrelayInfo_
-            chatrelayInfo_ = ["preset" | preset] <> testedInfo <> ["disabled" | not enabled]
+            relayAddress = ": " <> safeDecodeUtf8 (strEncode address)
+            relayInfo = if null relayInfo_ then "" else parens $ T.intercalate ", " relayInfo_
+            relayInfo_ = ["preset" | preset] <> testedInfo <> ["disabled" | not enabled]
            testedInfo = maybe [] (\t -> ["test: " <> if t then "passed" else "failed"]) tested

 serversUserHelp :: [StyledString]
--- a/tests/ChatClient.hs
+++ b/tests/ChatClient.hs
@@ -150,11 +150,15 @@ testCoreOpts =
      logFile = Nothing,
      tbqSize = 16,
      deviceName = Nothing,
+      chatRelay = False,
      highlyAvailable = False,
      yesToUpMigrations = False,
      migrationBackupPath = Nothing
    }

+relayTestOpts :: ChatOpts
+relayTestOpts = testOpts {coreOptions = testCoreOpts {chatRelay = True}}
+
 #if !defined(dbPostgres)
 getTestOpts :: Bool -> ScrubbedBytes -> ChatOpts
 getTestOpts maintenance dbKey = testOpts {maintenance, coreOptions = testCoreOpts {dbOptions = (dbOptions testCoreOpts) {dbKey}}}
@@ -283,10 +287,10 @@ nextVersion :: Version v -> Version v
 nextVersion (Version v) = Version (v + 1)

 createTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
-createTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix profile = do
+createTestChat ps cfg opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {chatRelay}} dbPrefix profile = do
  Right db@ChatDatabase {chatStore, agentStore} <- createDatabase ps coreOptions dbPrefix
  insertUser agentStore
-  Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile False True
+  Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile chatRelay True
  startTestChat_ ps db cfg opts user

 startTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> IO TestCC
@@ -316,7 +320,7 @@ startTestChat_ TestParams {printOutput} db cfg opts@ChatOpts {maintenance} user
  ct <- newChatTerminal t opts
  cc <- newChatController db (Just user) cfg opts False
  void $ execChatCommand' (SetTempFolder "tests/tmp/tmp") 0 `runReaderT` cc
-  chatAsync <- async $ runSimplexChat opts user cc $ \_u cc' -> runChatTerminal ct cc' opts
+  chatAsync <- async $ runSimplexChat cfg opts user cc $ \_u cc' -> runChatTerminal ct cc' opts
  unless maintenance $ atomically $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry
  termQ <- newTQueueIO
  termAsync <- async $ readTerminalOutput t termQ
--- a/tests/ChatTests.hs
+++ b/tests/ChatTests.hs
@@ -1,6 +1,7 @@
 module ChatTests where

 import ChatTests.ChatList
+import ChatTests.ChatRelays
 import ChatTests.DBUtils
 import ChatTests.Direct
 import ChatTests.Files
@@ -15,6 +16,7 @@ chatTests = do
  describe "direct tests" chatDirectTests
  describe "forward tests" chatForwardTests
  describe "group tests" chatGroupTests
+  describe "chat relay tests" chatRelayTests
  describe "local chats tests" chatLocalChatsTests
  describe "file tests" chatFileTests
  describe "profile tests" chatProfileTests
--- a/tests/ChatTests/ChatRelays.hs
+++ b/tests/ChatTests/ChatRelays.hs
@@ -0,0 +1,49 @@
+module ChatTests.ChatRelays where
+
+import ChatClient
+import ChatTests.DBUtils
+import ChatTests.Utils
+import Test.Hspec hiding (it)
+
+chatRelayTests :: SpecWith TestParams
+chatRelayTests = do
+  describe "configure chat relays" $ do
+    it "get and set chat relays" testGetSetChatRelays
+
+testGetSetChatRelays :: HasCallStack => TestParams -> IO ()
+testGetSetChatRelays ps =
+  withNewTestChat ps "alice" aliceProfile $ \alice ->
+    withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> do
+      withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> do
+        bob ##> "/ad"
+        (bobSLink, _cLink) <- getContactLinks bob True
+
+        cath ##> "/ad"
+        (cathSLink, _cLink) <- getContactLinks cath True
+
+        alice ##> ("/relays name=bob_relay " <> bobSLink)
+        alice <## "ok"
+
+        alice ##> "/relays"
+        alice <## "Your servers"
+        alice <## "  Chat relays"
+        alice <## ("    bob_relay: " <> bobSLink)
+
+        alice ##> ("/relays name=cath_relay " <> cathSLink)
+        alice <## "ok"
+
+        alice ##> "/relays"
+        alice <## "Your servers"
+        alice <## "  Chat relays"
+        alice <## ("    cath_relay: " <> cathSLink)
+
+        alice ##> ("/relays name=bob_relay " <> bobSLink <> " name=cath_relay " <> cathSLink)
+        alice <## "ok"
+
+        alice ##> "/relays"
+        alice <## "Your servers"
+        alice <## "  Chat relays"
+        alice
+          <### [ ConsoleString $ "    bob_relay: " <> bobSLink,
+                 ConsoleString $ "    cath_relay: " <> cathSLink
+               ]