simple welcome message (#152)

* simple welcome message

* show welcome message only once

* show onboarding progress

src/Simplex/Chat/Controller.hs

@@ -37,6 +37,7 @@ data ChatConfig = ChatConfig
 
 data ChatController = ChatController
   { currentUser :: TVar User,
+    firstTime :: Bool,
     smpAgent :: AgentClient,
     chatTerminal :: ChatTerminal,
     chatStore :: SQLiteStore,

src/Simplex/Chat/Help.hs

@@ -1,7 +1,9 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Chat.Help
-  ( chatHelpInfo,
+  ( chatWelcome,
+    chatHelpInfo,
     filesHelpInfo,
     groupsHelpInfo,
     myAddressHelpInfo,
@@ -11,13 +13,24 @@ where
 
 import Data.List (intersperse)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Simplex.Chat.Markdown
 import Simplex.Chat.Styled
+import Simplex.Chat.Types (Onboarding (..), Profile (..), User (..))
 import System.Console.ANSI.Types
 
 highlight :: Text -> Markdown
 highlight = Markdown (Colored Cyan)
 
+blue :: Text -> Markdown
+blue = Markdown (Colored Blue)
+
+cyan :: Text -> Markdown
+cyan = Markdown (Colored Cyan)
+
+yellow :: Text -> Markdown
+yellow = Markdown (Colored Yellow)
+
 green :: Text -> Markdown
 green = Markdown (Colored Green)
 
@@ -27,6 +40,36 @@ indent = "        "
 listHighlight :: [Text] -> Markdown
 listHighlight = mconcat . intersperse ", " . map highlight
 
+chatWelcome :: User -> Onboarding -> [StyledString]
+chatWelcome user Onboarding {contactsCount, createdGroups, membersCount, filesSentCount, addressCount} =
+  map
+    styleMarkdown
+    [ blue "                             __   __",
+      cyan "  ___ ___ __  __ ___ _    ___" <> blue "\\ \\ / /" <> yellow " ___ _  _   _ _____",
+      cyan " / __|_ _|  \\/  | _ \\ |  | __ " <> blue "\\ V /" <> yellow " / __| || | /_\\_   _|",
+      cyan " \\__ \\| || |\\/| |  _/ |__| _|" <> blue " / . \\" <> yellow "| (__| __ |/ _ \\| |",
+      cyan " |___/___|_|  |_|_| |____|___" <> blue "/_/ \\_\\" <> yellow "\\___|_||_/_/ \\_\\_|",
+      "",
+      "Welcome " <> green userName <> "!",
+      "Thank you for installing SimpleX Chat!",
+      "",
+      "To try out how it works:",
+      "[" <> check (contactsCount >= 2) <> "] connect with 2 friends - " <> highlight "/help" <> " for instructions",
+      "[" <> check (createdGroups >= 1 && membersCount >= 2) <> "] create a group with them - " <> highlight "/group #friends",
+      "[" <> check (filesSentCount >= 1) <> "] send your photo, e.g. to the group - " <> highlight "/file #friends ./photo.jpg",
+      "[" <> check (addressCount >= 1) <> "] create your chat " <> highlight "/address" <> " and share it with your friends",
+      "",
+      "To help us build SimpleX Chat:",
+      "> star GitHub repo: https://github.com/simplex-chat/simplex-chat",
+      "> join Reddit group: https://www.reddit.com/r/SimpleXChat/",
+      "",
+      "To show this message again - " <> highlight "/welcome"
+    ]
+  where
+    User {profile = Profile {displayName, fullName}} = user
+    userName = if T.null fullName then displayName else fullName
+    check c = if c then green "*" else " "
+
 chatHelpInfo :: [StyledString]
 chatHelpInfo =
   map

src/Simplex/Chat/Store.hs

@@ -17,6 +17,7 @@ module Simplex.Chat.Store
   ( SQLiteStore,
     StoreError (..),
     createStore,
+    chatStoreFile,
     createUser,
     getUsers,
     setActiveUser,
@@ -88,6 +89,7 @@ module Simplex.Chat.Store
     deleteRcvFileChunks,
     getFileTransfer,
     getFileTransferProgress,
+    getOnboarding,
   )
 where
 
@@ -136,6 +138,9 @@ migrations =
 createStore :: FilePath -> Int -> IO SQLiteStore
 createStore dbFilePath poolSize = createSQLiteStore dbFilePath poolSize migrations
 
+chatStoreFile :: FilePath -> FilePath
+chatStoreFile = (<> ".chat.db")
+
 checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
 checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)
 
@@ -1586,6 +1591,21 @@ getSndFileTransfers_ db userId fileId =
         Just recipientDisplayName -> Right SndFileTransfer {..}
         Nothing -> Left $ SESndFileInvalid fileId
 
+getOnboarding :: MonadUnliftIO m => SQLiteStore -> UserId -> m Onboarding
+getOnboarding st userId =
+  liftIO . withTransaction st $ \db -> do
+    contactsCount <- intQuery db "SELECT COUNT(contact_id) FROM contacts WHERE user_id = ?"
+    createdGroups <- headOrZero <$> DB.query db "SELECT COUNT(g.group_id) FROM groups g JOIN group_members m WHERE g.user_id = ? AND m.member_status = ?" (userId, GSMemCreator)
+    membersCount <- headOrZero <$> DB.query db "SELECT COUNT(group_member_id) FROM group_members WHERE user_id = ? AND (member_status = ? OR member_status = ?)" (userId, GSMemConnected, GSMemComplete)
+    filesSentCount <- intQuery db "SELECT COUNT(s.file_id) FROM snd_files s JOIN files f USING (file_id) WHERE f.user_id = ?"
+    addressCount <- intQuery db "SELECT COUNT(user_contact_link_id) FROM user_contact_links WHERE user_id = ?"
+    pure $ Onboarding {..}
+  where
+    intQuery :: DB.Connection -> DB.Query -> IO Int
+    intQuery db q = headOrZero <$> DB.query db q (Only userId)
+    headOrZero [] = 0
+    headOrZero (n : _) = fromOnly n
+
 -- | Saves unique local display name based on passed displayName, suffixed with _N if required.
 -- This function should be called inside transaction.
 withLocalDisplayName :: forall a. DB.Connection -> UserId -> Text -> (Text -> IO a) -> IO (Either StoreError a)

src/Simplex/Chat/Types.hs

@@ -518,3 +518,11 @@ serializeIntroStatus = \case
   GMIntroReConnected -> "re-con"
   GMIntroToConnected -> "to-con"
   GMIntroConnected -> "con"
+
+data Onboarding = Onboarding
+  { contactsCount :: Int,
+    createdGroups :: Int,
+    membersCount :: Int,
+    filesSentCount :: Int,
+    addressCount :: Int
+  }

src/Simplex/Chat/Util.hs

@@ -1,5 +1,6 @@
 module Simplex.Chat.Util where
 
+import Control.Monad (when)
 import Data.ByteString.Char8 (ByteString)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8With)
@@ -12,5 +13,8 @@ safeDecodeUtf8 = decodeUtf8With onError
 ifM :: Monad m => m Bool -> m a -> m a -> m a
 ifM ba t f = ba >>= \b -> if b then t else f
 
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM ba a = ba >>= (`when` a)
+
 unlessM :: Monad m => m Bool -> m () -> m ()
 unlessM b = ifM b $ pure ()