dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-03-30 20:45:49 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into users

Browse Source
This commit is contained in:
JRoberts
2023-01-16 16:37:13 +04:00
parent cf6afb7687 774af334fd
commit 24c47657f4
6 changed files with 75 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/Simplex/Chat.hs
View File

@@ -1209,6 +1209,9 @@ processChatCommand = \case
quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName (safeDecodeUtf8 quotedMsg)
let mc = MCText $ safeDecodeUtf8 msg
processChatCommand . APISendMessage (ChatRef CTGroup groupId) False $ ComposedMessage Nothing (Just quotedItemId) mc
LastChats count_ -> withUser' $ \user -> do
chats <- withStore' $ \db -> getChatPreviews db user False
pure $ CRChats $ maybe id take count_ chats
LastMessages (Just chatName) count search -> withUser $ \user -> do
chatRef <- getChatRef user chatName
chatResp <- processChatCommand $ APIGetChat chatRef (CPLast count) search
@@ -3970,7 +3973,7 @@ chatCommandP =
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> A.takeByteString),
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> A.takeByteString),
"/_contacts " *> (APIListContacts <$> A.decimal),
("/contacts" <|> "/cs") $> ListContacts,
"/contacts" $> ListContacts,
"/_connect " *> (APIConnect <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
"/_connect " *> (APIAddContact <$> A.decimal),
("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
@@ -3982,6 +3985,7 @@ chatCommandP =
("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> A.takeByteString),
("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> A.takeByteString),
"/feed " *> (SendMessageBroadcast <$> A.takeByteString),
("/chats" <|> "/cs") *> (LastChats <$> (" all" $> Nothing <|> Just <$> (A.space *> A.decimal <|> pure 20))),
("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> pure Nothing),
("/search" <|> "/?") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> (Just <$> (A.space *> stringP))),
"/last_item_id" *> (LastChatItemId <$> optional (A.space *> chatNameP) <*> (A.space *> A.decimal <|> pure 0)),

2
src/Simplex/Chat/Controller.hs
View File

@@ -285,6 +285,7 @@ data ChatCommand
| DeleteGroupLink GroupName
| ShowGroupLink GroupName
| SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString}
| LastChats (Maybe Int) -- UserId (not used in UI)
| LastMessages (Maybe ChatName) Int (Maybe String) -- UserId (not used in UI)
| LastChatItemId (Maybe ChatName) Int -- UserId (not used in UI)
| ShowChatItem (Maybe ChatItemId) -- UserId (not used in UI)
@@ -320,6 +321,7 @@ data ChatResponse
| CRChatStopped
| CRChatSuspended
| CRApiChats {user :: User, chats :: [AChat]}
| CRChats {chats :: [AChat]}
| CRApiChat {user :: User, chat :: AChat}
| CRChatItems {user :: User, chatItems :: [AChatItem]}
| CRChatItemId User (Maybe ChatItemId)

8
src/Simplex/Chat/Help.hs
View File

@@ -87,7 +87,7 @@ chatHelpInfo =
indent <> highlight "/help <topic> " <> " - help on: " <> listHighlight ["messages", "files", "groups", "address", "settings"],
indent <> highlight "/profile " <> " - show / update user profile",
indent <> highlight "/delete <contact>" <> " - delete contact and all messages with them",
indent <> highlight "/contacts " <> " - list contacts",
indent <> highlight "/chats " <> " - most recent chats",
indent <> highlight "/markdown " <> " - supported markdown syntax",
indent <> highlight "/version " <> " - SimpleX Chat version",
indent <> highlight "/quit " <> " - quit chat",
@@ -153,7 +153,11 @@ messagesHelpInfo :: [StyledString]
messagesHelpInfo =
map
styleMarkdown
[ green "Show recent messages",
[ green "Show recent chats",
indent <> highlight "/chats [N] " <> " - the most recent N conversations (20 by default)",
indent <> highlight "/chats all " <> " - all conversations",
"",
green "Show recent messages",
indent <> highlight "/tail @alice [N]" <> " - the last N messages with alice (10 by default)",
indent <> highlight "/tail #team [N] " <> " - the last N messages in the group team",
indent <> highlight "/tail [N] " <> " - the last N messages in all chats",

18
src/Simplex/Chat/Styled.hs
View File

@@ -1,5 +1,6 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Styled
( StyledString (..),
@@ -9,6 +10,7 @@ module Simplex.Chat.Styled
unStyle,
sLength,
sShow,
sTake,
)
where
@@ -25,7 +27,7 @@ data StyledString = Styled [SGR] String | StyledString :<>: StyledString
instance Semigroup StyledString where (<>) = (:<>:)
instance Monoid StyledString where mempty = plain ""
instance Monoid StyledString where mempty = ""
instance IsString StyledString where fromString = plain
@@ -34,7 +36,7 @@ styleMarkdown (s1 :|: s2) = styleMarkdown s1 <> styleMarkdown s2
styleMarkdown (Markdown f s) = styleFormat f s
styleMarkdownList :: MarkdownList -> StyledString
styleMarkdownList [] = plain ""
styleMarkdownList [] = ""
styleMarkdownList [FormattedText f s] = styleFormat f s
styleMarkdownList (FormattedText f s : ts) = styleFormat f s <> styleMarkdownList ts
@@ -82,3 +84,15 @@ unStyle (s1 :<>: s2) = unStyle s1 <> unStyle s2
sLength :: StyledString -> Int
sLength (Styled _ s) = length s
sLength (s1 :<>: s2) = sLength s1 + sLength s2
sTake :: Int -> StyledString -> StyledString
sTake n = go Nothing 0
where
go res len = \case
Styled f s ->
let s' = Styled f $ take (n - len) s
in maybe id (<>) res s'
s1 :<>: s2 ->
let s1' = go res len s1
len' = sLength s1'
in if len' >= n then s1' else go (Just s1') len' s2

15
src/Simplex/Chat/View.hs
View File

@@ -65,6 +65,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
CRChatStopped -> ["chat stopped"]
CRChatSuspended -> ["chat suspended"]
CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats]
CRChats chats -> viewChats ts chats
CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat]
CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
CRUserSMPServers u smpServers _ -> ttyUser u $ viewSMPServers (L.toList smpServers) testView
@@ -288,6 +289,20 @@ showSMPServer = B.unpack . strEncode . host
viewHostEvent :: AProtocolType -> TransportHost -> String
viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h)
viewChats :: CurrentTime -> [AChat] -> [StyledString]
viewChats ts = concatMap chatPreview . reverse
where
chatPreview (AChat _ (Chat chat items _)) = case items of
CChatItem _ ci : _ -> case viewChatItem chat ci True ts of
s : _ -> [let s' = sTake 120 s in if sLength s' < sLength s then s' <> "..." else s']
_ -> chatName
_ -> chatName
where
chatName = case chat of
DirectChat ct -> [" " <> ttyToContact' ct]
GroupChat g -> [" " <> ttyToGroup g]
_ -> []
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString]
viewChatItem chat ChatItem {chatDir, meta = meta@CIMeta {itemDeleted}, content, quotedItem, file} doShow ts =
withItemDeleted <$> case chat of

62
tests/ChatTests.hs
View File

@@ -339,7 +339,7 @@ testDeleteContactDeletesProfile =
-- bob deletes contact, profile is deleted
bob ##> "/d alice"
bob <## "alice: contact is deleted"
bob ##> "/cs"
bob ##> "/contacts"
(bob </)
bob `hasContactProfiles` ["bob"]
@@ -616,7 +616,7 @@ testGroupShared alice bob cath checkMessages = do
"cath (Catherine): admin, invited, connected"
]
-- list contacts
alice ##> "/cs"
alice ##> "/contacts"
alice <## "bob (Bob)"
alice <## "cath (Catherine)"
-- remove member
@@ -1558,28 +1558,28 @@ testGroupDeleteUnusedContacts =
bob <## "use @cath <message> to send messages"
]
-- list contacts
bob ##> "/cs"
bob ##> "/contacts"
bob <## "alice (Alice)"
bob <## "cath (Catherine)"
cath ##> "/cs"
cath ##> "/contacts"
cath <## "alice (Alice)"
cath <## "bob (Bob)"
-- delete group 1, contacts and profiles are kept
deleteGroup alice bob cath "team"
bob ##> "/cs"
bob ##> "/contacts"
bob <## "alice (Alice)"
bob <## "cath (Catherine)"
bob `hasContactProfiles` ["alice", "bob", "cath"]
cath ##> "/cs"
cath ##> "/contacts"
cath <## "alice (Alice)"
cath <## "bob (Bob)"
cath `hasContactProfiles` ["alice", "bob", "cath"]
-- delete group 2, unused contacts and profiles are deleted
deleteGroup alice bob cath "club"
bob ##> "/cs"
bob ##> "/contacts"
bob <## "alice (Alice)"
bob `hasContactProfiles` ["alice", "bob"]
cath ##> "/cs"
cath ##> "/contacts"
cath <## "alice (Alice)"
cath `hasContactProfiles` ["alice", "cath"]
where
@@ -2921,25 +2921,25 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi
bob <## (aliceIncognito <> " updated preferences for you:")
bob <## "Full deletion: off (you allow: no, contact allows: no)"
-- list contacts
alice ##> "/cs"
alice ##> "/contacts"
alice
<### [ ConsoleString $ "i " <> bobIncognito,
"cath (Catherine)"
]
alice `hasContactProfiles` ["alice", T.pack aliceIncognito, T.pack bobIncognito, "cath"]
bob ##> "/cs"
bob ##> "/contacts"
bob <## ("i " <> aliceIncognito)
bob `hasContactProfiles` ["bob", T.pack aliceIncognito, T.pack bobIncognito]
-- alice deletes contact, incognito profile is deleted
alice ##> ("/d " <> bobIncognito)
alice <## (bobIncognito <> ": contact is deleted")
alice ##> "/cs"
alice ##> "/contacts"
alice <## "cath (Catherine)"
alice `hasContactProfiles` ["alice", "cath"]
-- bob deletes contact, incognito profile is deleted
bob ##> ("/d " <> aliceIncognito)
bob <## (aliceIncognito <> ": contact is deleted")
bob ##> "/cs"
bob ##> "/contacts"
(bob </)
bob `hasContactProfiles` ["bob"]
@@ -2972,13 +2972,13 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
bob ?#> "@alice I'm Batman"
alice <# (bobIncognito <> "> I'm Batman")
-- list contacts
bob ##> "/cs"
bob ##> "/contacts"
bob <## "i alice (Alice)"
bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito]
-- delete contact, incognito profile is deleted
bob ##> "/d alice"
bob <## "alice: contact is deleted"
bob ##> "/cs"
bob ##> "/contacts"
(bob </)
bob `hasContactProfiles` ["bob"]
@@ -3007,13 +3007,13 @@ testAcceptContactRequestIncognito = testChat2 aliceProfile bobProfile $
bob #> ("@" <> aliceIncognito <> " I know!")
alice ?<# "bob> I know!"
-- list contacts
alice ##> "/cs"
alice ##> "/contacts"
alice <## "i bob (Bob)"
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
-- delete contact, incognito profile is deleted
alice ##> "/d bob"
alice <## "bob: contact is deleted"
alice ##> "/cs"
alice ##> "/contacts"
(alice </)
alice `hasContactProfiles` ["alice"]
@@ -3318,13 +3318,13 @@ testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobPr
concurrently_
(alice <## ("#team: " <> bobIncognito <> " joined the group"))
(bob <## ("#team: you joined the group incognito as " <> bobIncognito))
bob ##> "/cs"
bob ##> "/contacts"
bob <## "i alice (Alice)"
bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito]
-- delete contact
bob ##> "/d alice"
bob <## "alice: contact is deleted"
bob ##> "/cs"
bob ##> "/contacts"
(bob </)
bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito]
-- delete group
@@ -3370,7 +3370,7 @@ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobPr
concurrently_
(alice <## ("#team: " <> bobIncognito <> " joined the group"))
(bob <## ("#team: you joined the group incognito as " <> bobIncognito))
bob ##> "/cs"
bob ##> "/contacts"
bob <## "i alice (Alice)"
bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito]
-- delete group
@@ -3387,7 +3387,7 @@ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobPr
-- delete contact
bob ##> "/d alice"
bob <## "alice: contact is deleted"
bob ##> "/cs"
bob ##> "/contacts"
(bob </)
bob `hasContactProfiles` ["bob"]
@@ -3396,10 +3396,10 @@ testSetAlias = testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #$> ("/_set alias @2 my friend bob", id, "contact bob alias updated: my friend bob")
alice ##> "/cs"
alice ##> "/contacts"
alice <## "bob (Bob) (alias: my friend bob)"
alice #$> ("/_set alias @2", id, "contact bob alias removed")
alice ##> "/cs"
alice ##> "/contacts"
alice <## "bob (Bob)"
testSetConnectionAlias :: IO ()
@@ -3417,7 +3417,7 @@ testSetConnectionAlias = testChat2 aliceProfile bobProfile $
(bob <## "alice (Alice): contact is connected")
threadDelay 100000
alice @@@ [("@bob", "Voice messages: enabled")]
alice ##> "/cs"
alice ##> "/contacts"
alice <## "bob (Bob) (alias: friend)"
testSetContactPrefs :: IO ()
@@ -4352,11 +4352,11 @@ testMuteContact =
bob <## "ok"
alice #> "@bob hi"
(bob </)
bob ##> "/cs"
bob ##> "/contacts"
bob <## "alice (Alice) (muted, you can /unmute @alice)"
bob ##> "/unmute alice"
bob <## "ok"
bob ##> "/cs"
bob ##> "/contacts"
bob <## "alice (Alice)"
alice #> "@bob hi again"
bob <# "alice> hi again"
@@ -4899,16 +4899,16 @@ testGroupLinkUnusedHostContactDeleted =
]
]
-- list contacts
bob ##> "/cs"
bob ##> "/contacts"
bob <## "alice (Alice)"
-- delete group 1, host contact and profile are kept
bobLeaveDeleteGroup alice bob "team"
bob ##> "/cs"
bob ##> "/contacts"
bob <## "alice (Alice)"
bob `hasContactProfiles` ["alice", "bob"]
-- delete group 2, unused host contact and profile are deleted
bobLeaveDeleteGroup alice bob "club"
bob ##> "/cs"
bob ##> "/contacts"
(bob </)
bob `hasContactProfiles` ["bob"]
where
@@ -4932,18 +4932,18 @@ testGroupLinkIncognitoUnusedHostContactsDeleted =
bobIncognitoClub <- createGroupBobIncognito alice bob "club" "alice_1"
bobIncognitoTeam `shouldNotBe` bobIncognitoClub
-- list contacts
bob ##> "/cs"
bob ##> "/contacts"
bob <## "i alice (Alice)"
bob <## "i alice_1 (Alice)"
bob `hasContactProfiles` ["alice", "alice", "bob", T.pack bobIncognitoTeam, T.pack bobIncognitoClub]
-- delete group 1, unused host contact and profile are deleted
bobLeaveDeleteGroup alice bob "team" bobIncognitoTeam
bob ##> "/cs"
bob ##> "/contacts"
bob <## "i alice_1 (Alice)"
bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognitoClub]
-- delete group 2, unused host contact and profile are deleted
bobLeaveDeleteGroup alice bob "club" bobIncognitoClub
bob ##> "/cs"
bob ##> "/contacts"
(bob </)
bob `hasContactProfiles` ["bob"]
where