From fe0e5e8b89a10f5d6aca7e552bcd6d9f55012efb Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sat, 19 Mar 2022 09:04:53 +0000 Subject: [PATCH] terminal: version 1.3.3 (#447) * terminal: show version from .cabal file * update welcome message * terminal: helo on message quotes * terminal: allow replies in groups without specifying a member * core: update version to 1.3.3 --- package.yaml | 2 +- simplex-chat.cabal | 4 +- src/Simplex/Chat.hs | 12 +++--- src/Simplex/Chat/Controller.hs | 8 ++-- src/Simplex/Chat/Help.hs | 21 +++++++--- src/Simplex/Chat/Messages.hs | 1 - src/Simplex/Chat/Protocol.hs | 4 +- src/Simplex/Chat/Store.hs | 71 ++++++++++++++++++++-------------- src/Simplex/Chat/View.hs | 11 +++--- tests/ChatTests.hs | 12 ++++++ 10 files changed, 93 insertions(+), 53 deletions(-) diff --git a/package.yaml b/package.yaml index b96abaf7c..ca39fdb7b 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: simplex-chat -version: 1.3.2 +version: 1.3.3 #synopsis: #description: homepage: https://github.com/simplex-chat/simplex-chat#readme diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 5b42b59e0..dee280bcf 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: simplex-chat -version: 1.3.2 +version: 1.3.3 category: Web, System, Services, Cryptography homepage: https://github.com/simplex-chat/simplex-chat#readme author: simplex.chat @@ -127,7 +127,7 @@ test-suite simplex-chat-test Paths_simplex_chat hs-source-dirs: tests - ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns + ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded build-depends: aeson ==2.0.* , ansi-terminal >=0.10 && <0.12 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index ba228f7d1..87fa2934b 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -187,7 +187,7 @@ processChatCommand = \case CTDirect -> do (ct, qci) <- withStore $ \st -> (,) <$> getContact st userId chatId <*> getDirectChatItem st userId chatId quotedItemId case qci of - CChatItem _ (ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText}) -> do + CChatItem _ ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} -> do case ciContent of CISndMsgContent qmc -> send_ CIQDirectSnd True qmc CIRcvMsgContent qmc -> send_ CIQDirectRcv False qmc @@ -203,7 +203,7 @@ processChatCommand = \case unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved qci <- withStore $ \st -> getGroupChatItem st user chatId quotedItemId case qci of - CChatItem _ (ChatItem {chatDir, meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText}) -> do + CChatItem _ ChatItem {chatDir, meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} -> do case (ciContent, chatDir) of (CISndMsgContent qmc, _) -> send_ CIQGroupSnd True membership qmc (CIRcvMsgContent qmc, CIGroupRcv m) -> send_ (CIQGroupRcv $ Just m) False m qmc @@ -585,7 +585,7 @@ subscribeUserConnections user@User {userId} = do ms <- pooledForConcurrentlyN n connectedMembers $ \(m@GroupMember {localDisplayName = c}, cId) -> (m,) <$> ((subscribe cId $> Nothing) `catchError` (\e -> when ce (toView $ CRMemberSubError g c e) $> Just e)) toView $ CRGroupSubscribed g - pure $ mapMaybe (\(m, e) -> maybe Nothing (Just . MemberSubError m) e) ms + pure $ mapMaybe (\(m, e) -> (Just . MemberSubError m) =<< e) ms subscribeFiles n = do sndFileTransfers <- withStore (`getLiveSndFileTransfers` user) pooledForConcurrentlyN_ n sndFileTransfers $ \sft -> subscribeSndFile sft @@ -1527,6 +1527,7 @@ chatCommandP = <|> ("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles <|> ("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups <|> ("/help address" <|> "/ha") $> ChatHelp HSMyAddress + <|> ("/help replies" <|> "/hr") $> ChatHelp HSQuotes <|> ("/help" <|> "/h") $> ChatHelp HSMain <|> ("/group #" <|> "/group " <|> "/g #" <|> "/g ") *> (NewGroup <$> groupProfile) <|> ("/add #" <|> "/add " <|> "/a #" <|> "/a ") *> (AddMember <$> displayName <* A.space <*> displayName <*> memberRole) @@ -1537,7 +1538,8 @@ chatCommandP = <|> ("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName) <|> ("/groups" <|> "/gs") $> ListGroups <|> A.char '#' *> (SendGroupMessage <$> displayName <* A.space <*> A.takeByteString) - <|> (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* (" @" <|> " ") <*> displayName <* A.space <*> quotedMsg <*> A.takeByteString) + <|> (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> A.takeByteString) + <|> (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* optional (A.char '@') <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> A.takeByteString) <|> ("/contacts" <|> "/cs") $> ListContacts <|> ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)) <|> ("/connect" <|> "/c") $> AddContact @@ -1577,7 +1579,7 @@ chatCommandP = "text " *> (MCText . safeDecodeUtf8 <$> A.takeByteString) <|> "json " *> (J.eitherDecodeStrict' <$?> A.takeByteString) displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' ')) - sendMsgQuote msgDir = (SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> A.takeByteString) + sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> A.takeByteString quotedMsg = A.char '(' *> A.takeTill (== ')') <* A.char ')' <* optional A.space refChar c = c > ' ' && c /= '#' && c /= '@' onOffP = ("on" $> True) <|> ("off" $> False) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 69bc95e44..7d5fa8c8b 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -20,8 +20,10 @@ import Data.ByteString.Char8 (ByteString) import Data.Int (Int64) import Data.Map.Strict (Map) import Data.Text (Text) +import Data.Version (showVersion) import GHC.Generics (Generic) import Numeric.Natural +import qualified Paths_simplex_chat as SC import Simplex.Chat.Messages import Simplex.Chat.Protocol import Simplex.Chat.Store (StoreError) @@ -36,7 +38,7 @@ import System.IO (Handle) import UnliftIO.STM versionNumber :: String -versionNumber = "1.3.2" +versionNumber = showVersion SC.version versionStr :: String versionStr = "SimpleX Chat v" <> versionNumber @@ -76,7 +78,7 @@ data ChatController = ChatController config :: ChatConfig } -data HelpSection = HSMain | HSFiles | HSGroups | HSMyAddress | HSMarkdown +data HelpSection = HSMain | HSFiles | HSGroups | HSMyAddress | HSMarkdown | HSQuotes deriving (Show, Generic) instance ToJSON HelpSection where @@ -123,7 +125,7 @@ data ChatCommand | ListMembers GroupName | ListGroups | SendGroupMessage GroupName ByteString - | SendGroupMessageQuote {groupName :: GroupName, contactName :: ContactName, quotedMsg :: ByteString, message :: ByteString} + | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString} | SendFile ContactName FilePath | SendGroupFile GroupName FilePath | ReceiveFile FileTransferId (Maybe FilePath) diff --git a/src/Simplex/Chat/Help.hs b/src/Simplex/Chat/Help.hs index 3f17074dd..58c8fbb3e 100644 --- a/src/Simplex/Chat/Help.hs +++ b/src/Simplex/Chat/Help.hs @@ -7,6 +7,7 @@ module Simplex.Chat.Help filesHelpInfo, groupsHelpInfo, myAddressHelpInfo, + quotesHelpInfo, markdownInfo, ) where @@ -44,11 +45,7 @@ chatWelcome user = "Welcome " <> green userName <> "!", "Thank you for installing SimpleX Chat!", "", - "We have a couple of groups that you can join to play with SimpleX Chat:", - highlight "#termux" <> " (Android Termux 📱) - chatting about using SimpleX Chat on Android devices", - highlight "#music" <> " (Music 🎸) - favorite music of our team and users", - "", - "Connect to SimpleX Chat team to be added to these groups - type " <> highlight "/simplex", + "Connect to SimpleX Chat lead developer for any questions - just type " <> highlight "/simplex", "", "Follow our updates:", "> Reddit: https://www.reddit.com/r/SimpleXChat/", @@ -86,7 +83,7 @@ chatHelpInfo = green "Create your address: " <> highlight "/address", "", green "Other commands:", - indent <> highlight "/help " <> " - help on: files, groups, address, smp_servers", + indent <> highlight "/help " <> " - help on: files, groups, address, replies, smp_servers", indent <> highlight "/profile " <> " - show / update user profile", indent <> highlight "/delete " <> " - delete contact and all messages with them", indent <> highlight "/contacts " <> " - list contacts", @@ -146,6 +143,18 @@ myAddressHelpInfo = "The commands may be abbreviated: " <> listHighlight ["/ad", "/da", "/sa", "/ac", "/rc"] ] +quotesHelpInfo :: [StyledString] +quotesHelpInfo = + map + styleMarkdown + [ green "Sending replies to messages", + "To quote a message that starts with \"hi\":", + indent <> highlight "> @alice (hi) " <> " - to reply to alice's most recent message", + indent <> highlight ">> @alice (hi) " <> " - to quote user's most recent message to alice", + indent <> highlight "> #team (hi) " <> " - to quote most recent message in the group from any member", + indent <> highlight "> #team @alice (hi) " <> " - to quote alice's most recent message in the group #team" + ] + markdownInfo :: [StyledString] markdownInfo = map diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index a286e0970..dc8d9ece9 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -7,7 +7,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index ff93e139f..a238f0e02 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -224,7 +224,7 @@ instance ToJSON MsgContent where MCUnknown {json} -> JE.value $ J.Object json MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t -instance ToField (MsgContent) where +instance ToField MsgContent where toField = toField . safeDecodeUtf8 . LB.toStrict . J.encode instance FromField MsgContent where @@ -384,7 +384,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = AppMessage {msgId, event, p XMsgNew container -> msgContainerJSON container XFile fileInv -> o ["file" .= fileInv] XFileAcpt fileName -> o ["fileName" .= fileName] - XInfo profile -> o $ ["profile" .= profile] + XInfo profile -> o ["profile" .= profile] XContact profile xContactId -> o $ ("contactReqId" .=? xContactId) ["profile" .= profile] XGrpInv groupInv -> o ["groupInvitation" .= groupInv] XGrpAcpt memId -> o ["memberId" .= memId] diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 34350e1a8..7d0be6b85 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -2893,35 +2893,50 @@ getGroupChatItem st User {userId, userContactId} groupId itemId = |] (userId, groupId, itemId) -getGroupChatItemIdByText :: StoreMonad m => SQLiteStore -> User -> Int64 -> ContactName -> Text -> m ChatItemId -getGroupChatItemIdByText st User {userId, localDisplayName = userName} groupId cName quotedMsg = +getGroupChatItemIdByText :: StoreMonad m => SQLiteStore -> User -> Int64 -> Maybe ContactName -> Text -> m ChatItemId +getGroupChatItemIdByText st User {userId, localDisplayName = userName} groupId contactName_ quotedMsg = liftIOEither . withTransaction st $ \db -> - firstRow fromOnly SEQuotedChatItemNotFound $ - if userName == cName - then - DB.query - db - [sql| - SELECT chat_item_id - FROM chat_items - WHERE user_id = ? AND group_id = ? AND group_member_id IS NULL AND item_text like ? - ORDER BY chat_item_id DESC - LIMIT 1 - |] - (userId, groupId, quotedMsg <> "%") - else - DB.query - db - [sql| - SELECT i.chat_item_id - FROM chat_items i - JOIN group_members m ON m.group_member_id = i.group_member_id - JOIN contacts c ON c.contact_id = m.contact_id - WHERE i.user_id = ? AND i.group_id = ? AND c.local_display_name = ? AND i.item_text like ? - ORDER BY i.chat_item_id DESC - LIMIT 1 - |] - (userId, groupId, cName, quotedMsg <> "%") + firstRow fromOnly SEQuotedChatItemNotFound $ case contactName_ of + Nothing -> anyMemberChatItem_ db + Just cName + | userName == cName -> userChatItem_ db + | otherwise -> memberChatItem_ db cName + where + anyMemberChatItem_ db = + DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND group_id = ? AND item_text like ? + ORDER BY chat_item_id DESC + LIMIT 1 + |] + (userId, groupId, quotedMsg <> "%") + userChatItem_ db = + DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND group_id = ? AND group_member_id IS NULL AND item_text like ? + ORDER BY chat_item_id DESC + LIMIT 1 + |] + (userId, groupId, quotedMsg <> "%") + memberChatItem_ db cName = + DB.query + db + [sql| + SELECT i.chat_item_id + FROM chat_items i + JOIN group_members m ON m.group_member_id = i.group_member_id + JOIN contacts c ON c.contact_id = m.contact_id + WHERE i.user_id = ? AND i.group_id = ? AND c.local_display_name = ? AND i.item_text like ? + ORDER BY i.chat_item_id DESC + LIMIT 1 + |] + (userId, groupId, cName, quotedMsg <> "%") updateDirectChatItemsRead :: (StoreMonad m) => SQLiteStore -> Int64 -> (ChatItemId, ChatItemId) -> m () updateDirectChatItemsRead st contactId (fromItemId, toItemId) = do diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 7ae306c08..07d952c0a 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -57,6 +57,7 @@ responseToView testView = \case HSFiles -> filesHelpInfo HSGroups -> groupsHelpInfo HSMyAddress -> myAddressHelpInfo + HSQuotes -> quotesHelpInfo HSMarkdown -> markdownInfo CRWelcome user -> chatWelcome user CRContactsList cs -> viewContactsList cs @@ -109,7 +110,7 @@ responseToView testView = \case CRContactSubscribed c -> [ttyContact' c <> ": connected to server"] CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e] CRContactSubSummary summary -> - (if null subscribed then [] else [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)"]) <> viewErrorsSummary errors " contact errors" + [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors" where (errors, subscribed) = partition (isJust . contactError) summary CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} -> @@ -158,10 +159,10 @@ responseToView testView = \case Just CIQuote {chatDir = quoteDir, content} -> Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content) viewErrorsSummary :: [a] -> StyledString -> [StyledString] - viewErrorsSummary summary s = if null summary then [] else [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)"] + viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)] viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString] -viewChatItem chat (ChatItem {chatDir, meta, content, quotedItem}) = case chat of +viewChatItem chat ChatItem {chatDir, meta, content, quotedItem} = case chat of DirectChat c -> case chatDir of CIDirectSnd -> case content of CISndMsgContent mc -> viewSentMessage to quote mc meta @@ -191,10 +192,10 @@ viewChatItem chat (ChatItem {chatDir, meta, content, quotedItem}) = case chat of _ -> [] where directQuote :: forall d'. MsgDirectionI d' => CIDirection 'CTDirect d' -> CIQuote 'CTDirect -> [StyledString] - directQuote _ (CIQuote {content = qmc, chatDir = qouteDir}) = + directQuote _ CIQuote {content = qmc, chatDir = qouteDir} = quoteText qmc $ if toMsgDirection (msgDirection @d') == quoteMsgDirection qouteDir then ">>" else ">" groupQuote :: GroupInfo -> CIQuote 'CTGroup -> [StyledString] - groupQuote g (CIQuote {content = qmc, chatDir = quoteDir}) = quoteText qmc . ttyQuotedMember $ sentByMember g quoteDir + groupQuote g CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc . ttyQuotedMember $ sentByMember g quoteDir sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember sentByMember GroupInfo {membership} = \case CIQGroupSnd -> Just membership diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index a3606b859..ca270a60b 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -619,6 +619,18 @@ testGroupMessageQuotedReply = cath #$> ("/_get chat #1 count=1", chat', [((1, "hi there!"), Just (0, "hello, all good, you?"))]) alice #$> ("/_get chat #1 count=1", chat', [((0, "hi there!"), Just (0, "hello, all good, you?"))]) bob #$> ("/_get chat #1 count=1", chat', [((0, "hi there!"), Just (1, "hello, all good, you?"))]) + alice `send ` "> #team (will tell) go on" + alice <# "#team > bob will tell more" + alice <## " go on" + concurrently_ + ( do + bob <# "#team alice> > bob will tell more" + bob <## " go on" + ) + ( do + cath <# "#team alice> > bob will tell more" + cath <## " go on" + ) testUpdateProfile :: IO () testUpdateProfile =