From 1c2e49ae83ad60bcb65e5dba53597ccb4bfe08bd Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 10 Dec 2021 11:45:58 +0000 Subject: [PATCH] trim trailing whitespace, additional commands to list contacts and groups (#149) --- src/Simplex/Chat.hs | 9 ++++++++- src/Simplex/Chat/Help.hs | 8 +++++--- src/Simplex/Chat/Store.hs | 9 ++++++++- src/Simplex/Chat/View.hs | 19 ++++++++++++++++++- tests/ChatTests.hs | 14 ++++++++++++++ 5 files changed, 53 insertions(+), 6 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index d8b12da871..2f4e5f3edd 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -23,6 +23,7 @@ import Data.Attoparsec.ByteString.Char8 (Parser) import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Bifunctor (first) import Data.ByteString.Char8 (ByteString) +import Data.Char (isSpace) import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) import Data.Int (Int64) @@ -72,6 +73,7 @@ data ChatCommand | AddContact | Connect AConnectionRequest | DeleteContact ContactName + | ListContacts | CreateMyAddress | DeleteMyAddress | ShowMyAddress @@ -86,6 +88,7 @@ data ChatCommand | LeaveGroup GroupName | DeleteGroup GroupName | ListMembers GroupName + | ListGroups | SendGroupMessage GroupName ByteString | SendFile ContactName FilePath | SendGroupFile GroupName FilePath @@ -164,7 +167,7 @@ inputSubscriber = do atomically (readTBQueue q) >>= \case InputControl _ -> pure () InputCommand s -> - case parseAll chatCommandP . encodeUtf8 $ T.pack s of + case parseAll chatCommandP . B.dropWhileEnd isSpace . encodeUtf8 $ T.pack s of Left e -> printToView [plain s, "invalid input: " <> plain e] Right cmd -> do case cmd of @@ -204,6 +207,7 @@ processChatCommand user@User {userId, profile} = \case unsetActive $ ActiveC cName showContactDeleted cName gs -> showContactGroups cName gs + ListContacts -> withStore (`getUserContacts` user) >>= showContactsList CreateMyAddress -> do (connId, cReq) <- withAgent (`createConnection` SCMContact) withStore $ \st -> createUserContactLink st userId connId cReq @@ -293,6 +297,7 @@ processChatCommand user@User {userId, profile} = \case ListMembers gName -> do group <- withStore $ \st -> getGroup st user gName showGroupMembers group + ListGroups -> withStore (`getUserGroupNames` userId) >>= showGroupsList SendGroupMessage gName msg -> do -- TODO save sent messages -- TODO save pending message delivery for members without connections @@ -1163,7 +1168,9 @@ chatCommandP = <|> ("/leave #" <|> "/leave " <|> "/l #" <|> "/l ") *> (LeaveGroup <$> displayName) <|> ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName) <|> ("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName) + <|> ("/groups" <|> "/gs") $> ListGroups <|> A.char '#' *> (SendGroupMessage <$> displayName <* A.space <*> A.takeByteString) + <|> ("/contacts" <|> "/cs") $> ListContacts <|> ("/connect " <|> "/c ") *> (Connect <$> connReqP) <|> ("/connect" <|> "/c") $> AddContact <|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName) diff --git a/src/Simplex/Chat/Help.hs b/src/Simplex/Chat/Help.hs index e25e532f27..4a47ad96ad 100644 --- a/src/Simplex/Chat/Help.hs +++ b/src/Simplex/Chat/Help.hs @@ -55,8 +55,9 @@ chatHelpInfo = green "Other commands:", indent <> highlight "/profile " <> " - show / update user profile", indent <> highlight "/delete " <> " - delete contact and all messages with them", - indent <> highlight "/markdown " <> " - show supported markdown syntax", - indent <> highlight "/version " <> " - show SimpleX Chat version", + indent <> highlight "/contacts " <> " - list contacts", + indent <> highlight "/markdown " <> " - supported markdown syntax", + indent <> highlight "/version " <> " - SimpleX Chat version", indent <> highlight "/quit " <> " - quit chat", "", "The commands may be abbreviated: " <> listHighlight ["/c", "/f", "/g", "/p", "/ad"] <> ", etc." @@ -88,9 +89,10 @@ groupsHelpInfo = indent <> highlight "/leave " <> " - leave group", indent <> highlight "/delete " <> " - delete group", indent <> highlight "/members " <> " - list group members", + indent <> highlight "/groups " <> " - list groups", indent <> highlight "# " <> " - send message to group", "", - "The commands may be abbreviated: " <> listHighlight ["/g", "/a", "/j", "/rm", "/l", "/d", "/ms"] + "The commands may be abbreviated: " <> listHighlight ["/g", "/a", "/j", "/rm", "/l", "/d", "/ms", "/gs"] ] myAddressHelpInfo :: [StyledString] diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 560b1c15ad..379e810d1c 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -48,6 +48,7 @@ module Simplex.Chat.Store getGroup, deleteGroup, getUserGroups, + getUserGroupNames, getGroupInvitation, createContactGroupMember, createMemberConnection, @@ -969,9 +970,15 @@ deleteGroup st User {userId} Group {groupId, members, localDisplayName} = getUserGroups :: MonadUnliftIO m => SQLiteStore -> User -> m [Group] getUserGroups st user = liftIO . withTransaction st $ \db -> do - groupNames <- liftIO $ map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only $ userId user) + groupNames <- getUserGroupNames_ db $ userId user map fst . rights <$> mapM (runExceptT . getGroup_ db user) groupNames +getUserGroupNames :: MonadUnliftIO m => SQLiteStore -> UserId -> m [GroupName] +getUserGroupNames st userId = liftIO $ withTransaction st (`getUserGroupNames_` userId) + +getUserGroupNames_ :: DB.Connection -> UserId -> IO [GroupName] +getUserGroupNames_ db userId = map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only userId) + getGroupInvitation :: StoreMonad m => SQLiteStore -> User -> GroupName -> m ReceivedGroupInvitation getGroupInvitation st user localDisplayName = liftIOEither . withTransaction st $ \db -> runExceptT $ do diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 5f9358dc37..55c3afa017 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -11,6 +11,7 @@ module Simplex.Chat.View showChatError, showContactDeleted, showContactGroups, + showContactsList, showContactConnected, showContactDisconnected, showContactAnotherClient, @@ -63,6 +64,7 @@ module Simplex.Chat.View showLeftMemberUser, showLeftMember, showGroupMembers, + showGroupsList, showContactsMerged, showUserProfile, showUserProfileUpdated, @@ -80,7 +82,7 @@ import Data.ByteString.Char8 (ByteString) import Data.Composition ((.:), (.:.)) import Data.Function (on) import Data.Int (Int64) -import Data.List (groupBy, intersperse, sortOn) +import Data.List (groupBy, intersperse, sortOn, sort) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (DiffTime, UTCTime) @@ -112,6 +114,9 @@ showContactDeleted = printToView . contactDeleted showContactGroups :: ChatReader m => ContactName -> [GroupName] -> m () showContactGroups = printToView .: contactGroups +showContactsList :: ChatReader m => [Contact] -> m () +showContactsList = printToView . contactsList + showContactConnected :: ChatReader m => Contact -> m () showContactConnected = printToView . contactConnected @@ -274,6 +279,9 @@ showLeftMember = printToView .: leftMember showGroupMembers :: ChatReader m => Group -> m () showGroupMembers = printToView . groupMembers +showGroupsList :: ChatReader m => [GroupName] -> m () +showGroupsList = printToView . groupsList + showContactsMerged :: ChatReader m => Contact -> Contact -> m () showContactsMerged = printToView .: contactsMerged @@ -309,6 +317,11 @@ contactGroups c gNames = [ttyContact c <> ": contact cannot be deleted, it is a ttyGroups [g] = ttyGroup g ttyGroups (g : gs) = ttyGroup g <> ", " <> ttyGroups gs +contactsList :: [Contact] -> [StyledString] +contactsList = + let ldn = T.toLower . (localDisplayName :: Contact -> ContactName) + in map ttyFullContact . sortOn ldn + contactConnected :: Contact -> [StyledString] contactConnected ct = [ttyFullContact ct <> ": contact is connected"] @@ -461,6 +474,10 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov GSMemCreator -> "created group" _ -> "" +groupsList :: [GroupName] -> [StyledString] +groupsList [] = ["you have no groups!", "to create: " <> highlight' "/g "] +groupsList gs = map ttyGroup $ sort gs + contactsMerged :: Contact -> Contact -> [StyledString] contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayName = c2} = [ "contact " <> ttyContact c2 <> " is merged into " <> ttyContact c1, diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index c93d6da030..e83d9d24ef 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -132,6 +132,20 @@ testGroup = (alice <# "#team cath> hey") (bob <# "#team cath> hey") bob <##> cath + -- list groups + alice ##> "/gs" + alice <## "#team" + -- list group members + alice ##> "/ms team" + alice + <### [ "alice (Alice): owner, you, created group", + "bob (Bob): admin, invited, connected", + "cath (Catherine): admin, invited, connected" + ] + -- list contacts + alice ##> "/cs" + alice <## "bob (Bob)" + alice <## "cath (Catherine)" -- remove member bob ##> "/rm team cath" concurrentlyN_