cli: add --user-display-name option

Selects or creates the active user non-interactively:
- no active user: create one with the given display name
- active user with matching localDisplayName: continue
- active user with different name: exit with error

Mutually exclusive with --create-bot-display-name.

src/Simplex/Chat/Core.hs

@@ -19,6 +19,7 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import qualified Data.ByteString.Char8 as B
 import Data.List (find)
+import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (getCurrentTime)
@@ -43,7 +44,7 @@ import Text.Read (readMaybe)
 import UnliftIO.Async
 
 simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
-simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {dbOptions, logAgent, yesToUpMigrations, migrationBackupPath, maintenance}, createBot} chat =
+simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {dbOptions, logAgent, yesToUpMigrations, migrationBackupPath, maintenance}, createBot, userDisplayName} chat =
   case logAgent of
     Just level -> do
       setLogLevel level
@@ -58,6 +59,10 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha
     run db@ChatDatabase {chatStore} = do
       users <- withTransaction chatStore getUsers
       u_ <- selectActiveUser coreOptions chatStore users
+      forM_ ((,) <$> userDisplayName <*> u_) $ \(name, User {localDisplayName}) ->
+        when (localDisplayName /= name) $ do
+          putStrLn $ "Active user display name " <> show localDisplayName <> " does not match --user-display-name " <> show name
+          exitFailure
       let backgroundMode = maintenance
       newChatController db u_ cfg opts backgroundMode >>= \case
         Left e -> do
@@ -65,7 +70,7 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha
           exitFailure
         Right cc -> do
           forM_ (preStartHook chatHooks) ($ cc)
-          u <- maybe (noMaintenance >> createActiveUser cc coreOptions createBot) pure u_
+          u <- maybe (noMaintenance >> createActiveUser cc coreOptions createBot userDisplayName) pure u_
           unless testView $ putStrLn $ "Current user: " <> userStr u
           runSimplexChat cfg opts u cc chat
     noMaintenance = when maintenance $ do
@@ -120,25 +125,27 @@ selectActiveUser CoreChatOpts {chatRelay} st users
                     let user = users !! (n - 1)
                      in Just <$> withTransaction st (`setActiveUser` user)
 
-createActiveUser :: ChatController -> CoreChatOpts -> Maybe CreateBotOpts -> IO User
-createActiveUser cc CoreChatOpts {chatRelay} = \case
+createActiveUser :: ChatController -> CoreChatOpts -> Maybe CreateBotOpts -> Maybe Text -> IO User
+createActiveUser cc CoreChatOpts {chatRelay} createBot_ userDisplayName_ = case createBot_ of
   Just CreateBotOpts {botDisplayName, allowFiles, clientService} -> do
     let preferences = if allowFiles then Nothing else Just emptyChatPrefs {files = Just FilesPreference {allow = FANo}}
     createUser exitFailure clientService $ (mkProfile botDisplayName) {peerType = Just CPTBot, preferences}
-  Nothing -> putStrLn noProfile >> loop
-    where
-      noProfile
-        | chatRelay =
-            "No chat relay user profile found, it will be created now.\n\
-            \Please choose chat relay display name."
-        | otherwise =
-            "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 = do
-        displayName <- T.pack <$> withPrompt "display name" getLine
-        createUser loop False $ mkProfile displayName
+  Nothing -> case userDisplayName_ of
+    Just displayName -> createUser exitFailure False $ mkProfile displayName
+    Nothing -> putStrLn noProfile >> loop
+      where
+        noProfile
+          | chatRelay =
+              "No chat relay user profile found, it will be created now.\n\
+              \Please choose chat relay display name."
+          | otherwise =
+              "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 = do
+          displayName <- T.pack <$> withPrompt "display name" getLine
+          createUser loop False $ mkProfile displayName
   where
     mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
     createUser onError clientService p =

src/Simplex/Chat/Mobile.hs

@@ -279,7 +279,8 @@ mobileChatOpts dbOptions =
       autoAcceptFileSize = 0,
       muteNotifications = True,
       markRead = False,
-      createBot = Nothing
+      createBot = Nothing,
+      userDisplayName = Nothing
     }
 
 defaultMobileConfig :: ChatConfig

src/Simplex/Chat/Options.hs

@@ -22,7 +22,7 @@ where
 import Control.Logger.Simple (LogLevel (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -50,7 +50,8 @@ data ChatOpts = ChatOpts
     autoAcceptFileSize :: Integer,
     muteNotifications :: Bool,
     markRead :: Bool,
-    createBot :: Maybe CreateBotOpts
+    createBot :: Maybe CreateBotOpts,
+    userDisplayName :: Maybe Text
   }
 
 data CoreChatOpts = CoreChatOpts
@@ -450,6 +451,13 @@ chatOptsP appDir defaultDbName = do
       ( long "create-bot-client-service"
           <> help "Flag for created bot to use client service certificate"
       )
+  userDisplayName <-
+    optional $
+      strOption
+        ( long "user-display-name"
+            <> metavar "NAME"
+            <> help "Use existing active user with this display name, or create one on the first start (incompatible with --create-bot-display-name)"
+        )
   pure
     ChatOpts
       { coreOptions,
@@ -465,11 +473,14 @@ chatOptsP appDir defaultDbName = do
         muteNotifications,
         markRead,
         createBot = case createBotDisplayName of
-          Just botDisplayName -> Just CreateBotOpts {botDisplayName, allowFiles = createBotAllowFiles, clientService = createBotClientService}
+          Just botDisplayName
+            | isJust userDisplayName -> error "--user-display-name and --create-bot-display-name are mutually exclusive"
+            | otherwise -> Just CreateBotOpts {botDisplayName, allowFiles = createBotAllowFiles, clientService = createBotClientService}
           Nothing
             | createBotAllowFiles -> error "--create-bot-allow-files option requires --create-bot-name option"
             | createBotClientService -> error "--create-bot-client-service option requires --create-bot-name option"
-            | otherwise -> Nothing
+            | otherwise -> Nothing,
+        userDisplayName
       }
 
 parseProtocolServers :: ProtocolTypeI p => ReadM [ProtoServerWithAuth p]