From 20e7feb9530c65f0330c7a40dfd208fff4a1a88b Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 13 Dec 2021 12:05:57 +0000 Subject: [PATCH] simple welcome message (#152) * simple welcome message * show welcome message only once * show onboarding progress --- src/Simplex/Chat.hs | 18 +++++++++++--- src/Simplex/Chat/Controller.hs | 1 + src/Simplex/Chat/Help.hs | 45 +++++++++++++++++++++++++++++++++- src/Simplex/Chat/Store.hs | 20 +++++++++++++++ src/Simplex/Chat/Types.hs | 8 ++++++ src/Simplex/Chat/Util.hs | 4 +++ 6 files changed, 91 insertions(+), 5 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 84989d9573..216c1130e5 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -44,7 +44,7 @@ import Simplex.Chat.Store import Simplex.Chat.Styled (plain) import Simplex.Chat.Terminal import Simplex.Chat.Types -import Simplex.Chat.Util (ifM, unlessM) +import Simplex.Chat.Util (ifM, unlessM, whenM) import Simplex.Chat.View import Simplex.Messaging.Agent import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), defaultAgentConfig) @@ -70,6 +70,7 @@ data ChatCommand | GroupsHelp | MyAddressHelp | MarkdownHelp + | Welcome | AddContact | Connect AConnectionRequest | DeleteContact ContactName @@ -129,7 +130,9 @@ simplexChat cfg opts t = newChatController :: WithTerminal t => ChatConfig -> ChatOpts -> t -> (Notification -> IO ()) -> IO ChatController newChatController config@ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} ChatOpts {dbFile, smpServers} t sendNotification = do - chatStore <- createStore (dbFile <> ".chat.db") dbPoolSize + let f = chatStoreFile dbFile + firstTime <- not <$> doesFileExist f + chatStore <- createStore f dbPoolSize currentUser <- newTVarIO =<< getCreateActiveUser chatStore chatTerminal <- newChatTerminal t smpAgent <- getSMPAgentClient cfg {dbFile = dbFile <> ".agent.db", smpServers} @@ -142,7 +145,10 @@ newChatController config@ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} Cha pure ChatController {..} runSimplexChat :: ChatController -> IO () -runSimplexChat = runReaderT (race_ runTerminalInput runChatController) +runSimplexChat = runReaderT $ do + user <- readTVarIO =<< asks currentUser + whenM (asks firstTime) . printToView . chatWelcome user $ Onboarding 0 0 0 0 0 + race_ runTerminalInput runChatController runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => m () runChatController = @@ -187,6 +193,9 @@ processChatCommand user@User {userId, profile} = \case GroupsHelp -> printToView groupsHelpInfo MyAddressHelp -> printToView myAddressHelpInfo MarkdownHelp -> printToView markdownInfo + Welcome -> do + ob <- withStore (`getOnboarding` userId) + printToView $ chatWelcome user ob AddContact -> do (connId, cReq) <- withAgent (`createConnection` SCMInvitation) withStore $ \st -> createDirectConnection st userId connId @@ -548,7 +557,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do -- TODO update contact profile pure () XOk -> pure () - _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" + _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" CON -> withStore (\st -> getViaGroupMember st user ct) >>= \case Nothing -> do @@ -1186,6 +1195,7 @@ chatCommandP = <|> ("/accept @" <|> "/accept " <|> "/ac @" <|> "/ac ") *> (AcceptContact <$> displayName) <|> ("/reject @" <|> "/reject " <|> "/rc @" <|> "/rc ") *> (RejectContact <$> displayName) <|> ("/markdown" <|> "/m") $> MarkdownHelp + <|> ("/welcome" <|> "/w") $> Welcome <|> ("/profile " <|> "/p ") *> (UpdateProfile <$> userProfile) <|> ("/profile" <|> "/p") $> ShowProfile <|> ("/quit" <|> "/q" <|> "/exit") $> QuitChat diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index f8a2f3f902..dd8d7ef07c 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/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, diff --git a/src/Simplex/Chat/Help.hs b/src/Simplex/Chat/Help.hs index 4a47ad96ad..dad6379851 100644 --- a/src/Simplex/Chat/Help.hs +++ b/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 diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 379e810d1c..e2193fa4d9 100644 --- a/src/Simplex/Chat/Store.hs +++ b/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) diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index fd93ee4858..99c088769e 100644 --- a/src/Simplex/Chat/Types.hs +++ b/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 + } diff --git a/src/Simplex/Chat/Util.hs b/src/Simplex/Chat/Util.hs index 05ea20cf8d..1244774c50 100644 --- a/src/Simplex/Chat/Util.hs +++ b/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 ()