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.hs

@@ -108,9 +108,9 @@ import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..))
 import Simplex.RemoteControl.Types (RCCtrlAddress (..))
-import System.Exit (ExitCode, exitFailure, exitSuccess)
+import System.Exit (ExitCode, exitSuccess)
 import System.FilePath (takeFileName, (</>))
-import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, stdout)
+import System.IO (Handle, IOMode (..), SeekMode (..), hFlush)
 import System.Random (randomRIO)
 import Text.Read (readMaybe)
 import UnliftIO.Async
@@ -454,17 +454,14 @@ processChatCommand' vr = \case
     u <- asks currentUser
     (smp, smpServers) <- chooseServers SPSMP
     (xftp, xftpServers) <- chooseServers SPXFTP
-    auId <-
-      withStore' getUsers >>= \case
-        [] -> pure 1
-        users -> do
-          forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} ->
-            when (n == displayName) . throwChatError $
-              if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""}
-          withAgent (\a -> createUser a smp xftp)
+    users <- withStore' getUsers
+    forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} ->
+      when (n == displayName) . throwChatError $
+        if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""}
+    auId <- withAgent (\a -> createUser a smp xftp)
     ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure
     user <- withStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts
-    when (auId == 1) $ withStore (\db -> createContact db user simplexContactProfile) `catchChatError` \_ -> pure ()
+    when (null users) $ withStore (\db -> createContact db user simplexContactProfile) `catchChatError` \_ -> pure ()
     withStore $ \db -> createNoteFolder db user
     storeServers user smpServers
     storeServers user xftpServers
@@ -2277,6 +2274,7 @@ processChatCommand' vr = \case
       pure $ CRGroupUpdated user g g' Nothing
     checkValidName :: GroupName -> m ()
     checkValidName displayName = do
+      when (T.null displayName) $ throwChatError CEInvalidDisplayName {displayName, validName = ""}
       let validName = T.pack $ mkValidName $ T.unpack displayName
       when (displayName /= validName) $ throwChatError CEInvalidDisplayName {displayName, validName}
     assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m ()
@@ -6290,68 +6288,6 @@ createLocalChatItem user cd content createdAt = do
       let smi_ = Just (SharedMsgId sharedMsgId)
        in createNewChatItem_ db user cd Nothing smi_ content (Nothing, Nothing, Nothing, Nothing, Nothing) Nothing False createdAt Nothing createdAt
 
-getCreateActiveUser :: SQLiteStore -> Bool -> IO User
-getCreateActiveUser st testView = do
-  user <-
-    withTransaction st getUsers >>= \case
-      [] -> newUser
-      users -> maybe (selectUser users) pure (find activeUser users)
-  unless testView $ putStrLn $ "Current user: " <> userStr user
-  pure user
-  where
-    newUser :: IO User
-    newUser = do
-      putStrLn
-        "No user profiles found, it will be created now.\n\
-        \Please choose your display name and your full name.\n\
-        \They will be sent to your contacts when you connect.\n\
-        \They are only stored on your device and you can change them later."
-      loop
-      where
-        loop = do
-          displayName <- getContactName
-          withTransaction st (\db -> runExceptT $ createUserRecord db (AgentUserId 1) (profileFromName displayName) True) >>= \case
-            Left SEDuplicateName -> do
-              putStrLn "chosen display name is already used by another profile on this device, choose another one"
-              loop
-            Left e -> putStrLn ("database error " <> show e) >> exitFailure
-            Right user -> do
-              void . withTransaction st $ \db -> runExceptT $ createNoteFolder db user
-              pure user
-    selectUser :: [User] -> IO User
-    selectUser [user@User {userId}] = do
-      withTransaction st (`setActiveUser` userId)
-      pure user
-    selectUser users = do
-      putStrLn "Select user profile:"
-      forM_ (zip [1 ..] users) $ \(n :: Int, user) -> putStrLn $ show n <> " - " <> userStr user
-      loop
-      where
-        loop = do
-          nStr <- getWithPrompt $ "user profile number (1 .. " <> show (length users) <> ")"
-          case readMaybe nStr :: Maybe Int of
-            Nothing -> putStrLn "invalid user 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 user
-    userStr :: User -> String
-    userStr User {localDisplayName, profile = LocalProfile {fullName}} =
-      T.unpack $ localDisplayName <> if T.null fullName || localDisplayName == fullName then "" else " (" <> fullName <> ")"
-    getContactName :: IO ContactName
-    getContactName = do
-      displayName <- getWithPrompt "display name"
-      let validName = mkValidName displayName
-      if
-        | null displayName -> putStrLn "display name can't be empty" >> getContactName
-        | null validName -> putStrLn "display name is invalid, please choose another" >> getContactName
-        | displayName /= validName -> putStrLn ("display name is invalid, you could use this one: " <> validName) >> getContactName
-        | otherwise -> pure $ T.pack displayName
-    getWithPrompt :: String -> IO String
-    getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine
-
 withUser' :: ChatMonad m => (User -> m ChatResponse) -> m ChatResponse
 withUser' action =
   asks currentUser

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