mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
terminal: commands to mute/unmute contacts and groups (#1018)
* terminal: commands to mute/unmute contacts and groups * tests
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
f512298d10
commit
b232b6132f
+31
-25
@@ -509,8 +509,8 @@ processChatCommand = \case
|
||||
forM_ call_ $ \call -> updateCallItemStatus userId ct call WCSDisconnected Nothing
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
|
||||
pure CRCmdOk
|
||||
SendCallInvitation cName callType -> withUser $ \User {userId} -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db userId cName
|
||||
SendCallInvitation cName callType -> withUser $ \user -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
processChatCommand $ APISendCallInvitation contactId callType
|
||||
APIRejectCall contactId ->
|
||||
-- party accepting call
|
||||
@@ -629,8 +629,14 @@ processChatCommand = \case
|
||||
(g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
|
||||
connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m)
|
||||
pure $ CRGroupMemberInfo g m connectionStats
|
||||
ContactInfo cName -> withUser $ \User {userId} -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db userId cName
|
||||
ShowMessages (ChatName cType name) ntfOn -> withUser $ \user -> do
|
||||
chatId <- case cType of
|
||||
CTDirect -> withStore $ \db -> getContactIdByName db user name
|
||||
CTGroup -> withStore $ \db -> getGroupIdByName db user name
|
||||
_ -> throwChatError $ CECommandError "not supported"
|
||||
processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ ChatSettings ntfOn
|
||||
ContactInfo cName -> withUser $ \user -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
processChatCommand $ APIContactInfo contactId
|
||||
GroupMemberInfo gName mName -> withUser $ \user -> do
|
||||
(gId, mId) <- withStore $ \db -> getGroupIdByName db user gName >>= \gId -> (gId,) <$> getGroupMemberIdByName db user gId mName
|
||||
@@ -661,11 +667,11 @@ processChatCommand = \case
|
||||
ConnectSimplex -> withUser $ \User {userId, profile} ->
|
||||
-- [incognito] generate profile to send
|
||||
connectViaContact userId adminContactReq $ fromLocalProfile profile
|
||||
DeleteContact cName -> withUser $ \User {userId} -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db userId cName
|
||||
DeleteContact cName -> withUser $ \user -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
processChatCommand $ APIDeleteChat (ChatRef CTDirect contactId)
|
||||
ClearContact cName -> withUser $ \User {userId} -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db userId cName
|
||||
ClearContact cName -> withUser $ \user -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
processChatCommand $ APIClearChat (ChatRef CTDirect contactId)
|
||||
ListContacts -> withUser $ \user -> CRContactsList <$> withStore' (`getUserContacts` user)
|
||||
CreateMyAddress -> withUser $ \User {userId} -> withChatLock . procCmd $ do
|
||||
@@ -706,8 +712,8 @@ processChatCommand = \case
|
||||
)
|
||||
`catchError` (toView . CRChatError)
|
||||
CRBroadcastSent mc (length cts) <$> liftIO getZonedTime
|
||||
SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \User {userId} -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db userId cName
|
||||
SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir (safeDecodeUtf8 quotedMsg)
|
||||
let mc = MCText $ safeDecodeUtf8 msg
|
||||
processChatCommand . APISendMessage (ChatRef CTDirect contactId) $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
@@ -807,8 +813,8 @@ processChatCommand = \case
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft
|
||||
pure $ CRLeftMemberUser gInfo {membership = membership {memberStatus = GSMemLeft}}
|
||||
APIListMembers groupId -> CRGroupMembers <$> withUser (\user -> withStore (\db -> getGroup db user groupId))
|
||||
AddMember gName cName memRole -> withUser $ \user@User {userId} -> do
|
||||
(groupId, contactId) <- withStore $ \db -> (,) <$> getGroupIdByName db user gName <*> getContactIdByName db userId cName
|
||||
AddMember gName cName memRole -> withUser $ \user -> do
|
||||
(groupId, contactId) <- withStore $ \db -> (,) <$> getGroupIdByName db user gName <*> getContactIdByName db user cName
|
||||
processChatCommand $ APIAddMember groupId contactId memRole
|
||||
JoinGroup gName -> withUser $ \user -> do
|
||||
groupId <- withStore $ \db -> getGroupIdByName db user gName
|
||||
@@ -929,9 +935,9 @@ processChatCommand = \case
|
||||
procCmd :: m ChatResponse -> m ChatResponse
|
||||
procCmd = id
|
||||
getChatRef :: User -> ChatName -> m ChatRef
|
||||
getChatRef user@User {userId} (ChatName cType name) =
|
||||
getChatRef user (ChatName cType name) =
|
||||
ChatRef cType <$> case cType of
|
||||
CTDirect -> withStore $ \db -> getContactIdByName db userId name
|
||||
CTDirect -> withStore $ \db -> getContactIdByName db user name
|
||||
CTGroup -> withStore $ \db -> getGroupIdByName db user name
|
||||
_ -> throwChatError $ CECommandError "not supported"
|
||||
checkChatStopped :: m ChatResponse -> m ChatResponse
|
||||
@@ -1715,8 +1721,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
(probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId ct
|
||||
void . sendDirectContactMessage ct $ XInfoProbe probe
|
||||
if connectedIncognito
|
||||
then
|
||||
withStore' $ \db -> deleteSentProbe db userId probeId
|
||||
then withStore' $ \db -> deleteSentProbe db userId probeId
|
||||
else do
|
||||
cs <- withStore' $ \db -> getMatchingContacts db userId ct
|
||||
let probeHash = ProbeHash $ C.sha256Hash (unProbe probe)
|
||||
@@ -1734,14 +1739,14 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
messageError = toView . CRMessageError "error"
|
||||
|
||||
newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
|
||||
newContentMessage ct@Contact {localDisplayName = c} mc msg msgMeta = do
|
||||
newContentMessage ct@Contact {localDisplayName = c, chatSettings} mc msg msgMeta = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
let (ExtMsgContent content fileInvitation_) = mcExtMsgContent mc
|
||||
ciFile_ <- processFileInvitation fileInvitation_ $
|
||||
\fi chSize -> withStore' $ \db -> createRcvFileTransfer db userId ct fi chSize
|
||||
ci@ChatItem {formattedText} <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent content) ciFile_
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||
showMsgToast (c <> "> ") content formattedText
|
||||
when (enableNtfs chatSettings) $ showMsgToast (c <> "> ") content formattedText
|
||||
setActive $ ActiveC c
|
||||
|
||||
processFileInvitation :: Maybe FileInvitation -> (FileInvitation -> Integer -> m RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
|
||||
@@ -1761,9 +1766,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
-- This patches initial sharedMsgId into chat item when locally deleted chat item
|
||||
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
|
||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||
ci@ChatItem {formattedText} <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing
|
||||
toView . CRChatItemUpdated $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||
showMsgToast (c <> "> ") mc formattedText
|
||||
setActive $ ActiveC c
|
||||
_ -> throwError e
|
||||
where
|
||||
@@ -1790,14 +1794,14 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||
SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete"
|
||||
|
||||
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
|
||||
newGroupContentMessage gInfo m@GroupMember {localDisplayName = c} mc msg msgMeta = do
|
||||
newGroupContentMessage gInfo@GroupInfo {chatSettings} m@GroupMember {localDisplayName = c} mc msg msgMeta = do
|
||||
let (ExtMsgContent content fileInvitation_) = mcExtMsgContent mc
|
||||
ciFile_ <- processFileInvitation fileInvitation_ $
|
||||
\fi chSize -> withStore' $ \db -> createRcvGroupFileTransfer db userId m fi chSize
|
||||
ci@ChatItem {formattedText} <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent content) ciFile_
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
let g = groupName' gInfo
|
||||
showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
|
||||
when (enableNtfs chatSettings) $ showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
|
||||
setActive $ ActiveG g
|
||||
|
||||
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> m ()
|
||||
@@ -2524,7 +2528,9 @@ withStore action = do
|
||||
chatCommandP :: Parser ChatCommand
|
||||
chatCommandP =
|
||||
A.choice
|
||||
[ ("/user " <|> "/u ") *> (CreateActiveUser <$> userProfile),
|
||||
[ "/mute " *> ((`ShowMessages` False) <$> chatNameP'),
|
||||
"/unmute " *> ((`ShowMessages` True) <$> chatNameP'),
|
||||
("/user " <|> "/u ") *> (CreateActiveUser <$> userProfile),
|
||||
("/user" <|> "/u") $> ShowActiveUser,
|
||||
"/_start subscribe=" *> (StartChat <$> ("on" $> True <|> "off" $> False)),
|
||||
"/_start" $> StartChat True,
|
||||
@@ -2588,9 +2594,9 @@ chatCommandP =
|
||||
("/help" <|> "/h") $> ChatHelp HSMain,
|
||||
("/group #" <|> "/group " <|> "/g #" <|> "/g ") *> (NewGroup <$> groupProfile),
|
||||
"/_group " *> (NewGroup <$> jsonP),
|
||||
("/add #" <|> "/add " <|> "/a #" <|> "/a ") *> (AddMember <$> displayName <* A.space <*> displayName <*> memberRole),
|
||||
("/add #" <|> "/add " <|> "/a #" <|> "/a ") *> (AddMember <$> displayName <* A.space <* optional (A.char '@') <*> displayName <*> memberRole),
|
||||
("/join #" <|> "/join " <|> "/j #" <|> "/j ") *> (JoinGroup <$> displayName),
|
||||
("/remove #" <|> "/remove " <|> "/rm #" <|> "/rm ") *> (RemoveMember <$> displayName <* A.space <*> displayName),
|
||||
("/remove #" <|> "/remove " <|> "/rm #" <|> "/rm ") *> (RemoveMember <$> displayName <* A.space <* optional (A.char '@') <*> displayName),
|
||||
("/leave #" <|> "/leave " <|> "/l #" <|> "/l ") *> (LeaveGroup <$> displayName),
|
||||
("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName),
|
||||
("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName),
|
||||
|
||||
Reference in New Issue
Block a user