mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
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
This commit is contained in:
Evgeny Poberezkin
GitHub
parent
3340bea150
commit
fe0e5e8b89
10 changed files with 93 additions and 53 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 <topic> " <> " - help on: files, groups, address, smp_servers",
|
||||
indent <> highlight "/help <topic> " <> " - help on: files, groups, address, replies, smp_servers",
|
||||
indent <> highlight "/profile " <> " - show / update user profile",
|
||||
indent <> highlight "/delete <contact>" <> " - 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) <msg> " <> " - to reply to alice's most recent message",
|
||||
indent <> highlight ">> @alice (hi) <msg> " <> " - to quote user's most recent message to alice",
|
||||
indent <> highlight "> #team (hi) <msg> " <> " - to quote most recent message in the group from any member",
|
||||
indent <> highlight "> #team @alice (hi) <msg>" <> " - to quote alice's most recent message in the group #team"
|
||||
]
|
||||
|
||||
markdownInfo :: [StyledString]
|
||||
markdownInfo =
|
||||
map
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue