core: support deleting the last profile (always create user record in agent when user is created) (#3654)

* core: only skip creating agent user when app is first started

* firstTime

* prompt

* fix test

* if

* simplexmq

* ci timeout

* skip test

* add test timeout

* log test times

* simplexmq

* timeout

* simplexmq without new batching

* Revert "simplexmq without new batching"

This reverts commit 9879bcb57c.

* without new batching again

* with builder, without sized builder

* lazy bytestring, same batching logic

* fewer chunks

* remove lazy

* optimize batching in simplexmq

src/Simplex/Chat/Core.hs

@@ -1,17 +1,34 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
-module Simplex.Chat.Core where
+module Simplex.Chat.Core
+  ( simplexChatCore,
+    runSimplexChat,
+    sendChatCmdStr,
+    sendChatCmd,
+  )
+where
 
 import Control.Logger.Simple
+import Control.Monad
 import Control.Monad.Reader
+import Data.List (find)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
+import Data.Time.Clock (getCurrentTime)
+import Data.Time.LocalTime (getCurrentTimeZone)
 import Simplex.Chat
 import Simplex.Chat.Controller
 import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
+import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Types
+import Simplex.Chat.View (serializeChatResponse)
+import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore, withTransaction)
 import System.Exit (exitFailure)
+import System.IO (hFlush, stdout)
+import Text.Read (readMaybe)
 import UnliftIO.Async
 
 simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
@@ -27,8 +44,10 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {core
       putStrLn $ "Error opening database: " <> show e
       exitFailure
     run db@ChatDatabase {chatStore} = do
-      u <- getCreateActiveUser chatStore testView
-      cc <- newChatController db (Just u) cfg opts False
+      u_ <- getSelectActiveUser chatStore
+      cc <- newChatController db u_ cfg opts False
+      u <- maybe (createActiveUser cc) pure u_
+      unless testView $ putStrLn $ "Current user: " <> userStr u
       runSimplexChat opts u cc chat
 
 runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
@@ -44,3 +63,59 @@ sendChatCmdStr cc s = runReaderT (execChatCommand Nothing . encodeUtf8 $ T.pack
 
 sendChatCmd :: ChatController -> ChatCommand -> IO ChatResponse
 sendChatCmd cc cmd = runReaderT (execChatCommand' cmd) cc
+
+getSelectActiveUser :: SQLiteStore -> IO (Maybe User)
+getSelectActiveUser st = do
+  users <- withTransaction st getUsers
+  case find activeUser users of
+    Just u -> pure $ Just u
+    Nothing -> selectUser users
+  where
+    selectUser :: [User] -> IO (Maybe User)
+    selectUser = \case
+      [] -> pure Nothing
+      [user@User {userId}] -> do
+        withTransaction st (`setActiveUser` userId)
+        pure $ Just user
+      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) <> ")"
+            case readMaybe nStr :: Maybe Int of
+              Nothing -> putStrLn "not a number" >> loop
+              Just n
+                | n <= 0 || n > length users -> putStrLn "invalid user number" >> loop
+                | otherwise -> do
+                    let user@User {userId} = users !! (n - 1)
+                    withTransaction st (`setActiveUser` userId)
+                    pure $ Just user
+
+createActiveUser :: ChatController -> IO User
+createActiveUser cc = 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"
+      let profile = Just Profile {displayName, fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
+      execChatCommand' (CreateActiveUser NewUser {profile, sameServers = False, pastTimestamp = False}) `runReaderT` cc >>= \case
+        CRActiveUser user -> pure user
+        r -> do
+          ts <- getCurrentTime
+          tz <- getCurrentTimeZone
+          putStrLn $ serializeChatResponse (Nothing, Nothing) ts tz Nothing r
+          loop
+
+getWithPrompt :: String -> IO String
+getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine
+
+userStr :: User -> String
+userStr User {localDisplayName, profile = LocalProfile {fullName}} =
+  T.unpack $ localDisplayName <> if T.null fullName || localDisplayName == fullName then "" else " (" <> fullName <> ")"

src/Simplex/Chat/View.hs

@@ -1812,7 +1812,7 @@ viewChatError logLevel testView = \case
     CEUserNotHidden _ -> ["user is not hidden"]
     CEInvalidDisplayName {displayName, validName} ->
       map plain $
-        ["invalid display name: " <> viewName displayName]
+        [if T.null displayName then "display name can't be empty" else "invalid display name: " <> viewName displayName]
           <> ["you could use this one: " <> viewName validName | not (T.null validName)]
     CEChatNotStarted -> ["error: chat not started"]
     CEChatNotStopped -> ["error: chat not stopped"]
@@ -1925,6 +1925,8 @@ viewChatError logLevel testView = \case
     AGENT A_DUPLICATE -> [withConnEntity <> "error: AGENT A_DUPLICATE" | logLevel == CLLDebug]
     AGENT A_PROHIBITED -> [withConnEntity <> "error: AGENT A_PROHIBITED" | logLevel <= CLLWarning]
     CONN NOT_FOUND -> [withConnEntity <> "error: CONN NOT_FOUND" | logLevel <= CLLWarning]
+    CRITICAL restart e -> [plain $ "critical error: " <> e] <> ["please restart the app" | restart]
+    INTERNAL e -> [plain $ "internal error: " <> e]
     e -> [withConnEntity <> "smp agent error: " <> sShow e | logLevel <= CLLWarning]
     where
       withConnEntity = case entity_ of