mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: settings to hide member messages, to show only reply (and mention) notifications (#3190)
* core: settings to hide member messages, to show only reply (and mention) notifications * change type for showMessages * commands for member settings * member and notification settings * test * take member settings into account when showing messages and notifications * fix to show sent messages * store blocked items * types * rename to MFMentions
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
b03fe183bb
commit
bca9473d77
+70
-62
@@ -800,7 +800,7 @@ processChatCommand = \case
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> withChatLock "deleteChatItem" $ case cType of
|
||||
CTDirect -> do
|
||||
(ct, ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, editable}})) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
|
||||
(ct, CChatItem msgDir ci@ChatItem {meta = CIMeta {itemSharedMsgId, editable}}) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
|
||||
case (mode, msgDir, itemSharedMsgId, editable) of
|
||||
(CIDMInternal, _, _, _) -> deleteDirectCI user ct ci True False
|
||||
(CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do
|
||||
@@ -812,7 +812,7 @@ processChatCommand = \case
|
||||
(CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete
|
||||
CTGroup -> do
|
||||
Group gInfo ms <- withStore $ \db -> getGroup db user chatId
|
||||
ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, editable}}) <- withStore $ \db -> getGroupChatItem db user chatId itemId
|
||||
CChatItem msgDir ci@ChatItem {meta = CIMeta {itemSharedMsgId, editable}} <- withStore $ \db -> getGroupChatItem db user chatId itemId
|
||||
case (mode, msgDir, itemSharedMsgId, editable) of
|
||||
(CIDMInternal, _, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime
|
||||
(CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do
|
||||
@@ -824,7 +824,7 @@ processChatCommand = \case
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do
|
||||
Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db user gId
|
||||
ci@(CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) <- withStore $ \db -> getGroupChatItem db user gId itemId
|
||||
CChatItem _ ci@ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}} <- withStore $ \db -> getGroupChatItem db user gId itemId
|
||||
case (chatDir, itemSharedMsgId) of
|
||||
(CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do
|
||||
when (groupMemberId /= mId) $ throwChatError CEInvalidChatItemDelete
|
||||
@@ -1178,7 +1178,7 @@ processChatCommand = \case
|
||||
ct <- getContact db user chatId
|
||||
liftIO $ updateContactSettings db user chatId chatSettings
|
||||
pure ct
|
||||
withAgent $ \a -> toggleConnectionNtfs a (contactConnId ct) (enableNtfs chatSettings)
|
||||
withAgent $ \a -> toggleConnectionNtfs a (contactConnId ct) (chatHasNtfs chatSettings)
|
||||
ok user
|
||||
CTGroup -> do
|
||||
ms <- withStore $ \db -> do
|
||||
@@ -1186,9 +1186,17 @@ processChatCommand = \case
|
||||
liftIO $ updateGroupSettings db user chatId chatSettings
|
||||
pure ms
|
||||
forM_ (filter memberActive ms) $ \m -> forM_ (memberConnId m) $ \connId ->
|
||||
withAgent (\a -> toggleConnectionNtfs a connId $ enableNtfs chatSettings) `catchChatError` (toView . CRChatError (Just user))
|
||||
withAgent (\a -> toggleConnectionNtfs a connId $ chatHasNtfs chatSettings) `catchChatError` (toView . CRChatError (Just user))
|
||||
ok user
|
||||
_ -> pure $ chatCmdError (Just user) "not supported"
|
||||
APISetMemberSettings gId gMemberId settings -> withUser $ \user -> do
|
||||
m <- withStore $ \db -> do
|
||||
liftIO $ updateGroupMemberSettings db user gId gMemberId settings
|
||||
getGroupMember db user gId gMemberId
|
||||
when (memberActive m) $ forM_ (memberConnId m) $ \connId -> do
|
||||
let ntfOn = showMessages $ memberSettings m
|
||||
withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user))
|
||||
ok user
|
||||
APIContactInfo contactId -> withUser $ \user@User {userId} -> do
|
||||
-- [incognito] print user's incognito profile for this contact
|
||||
ct@Contact {activeConn = Connection {customUserProfileId}} <- withStore $ \db -> getContact db user contactId
|
||||
@@ -1283,6 +1291,11 @@ processChatCommand = \case
|
||||
_ -> throwChatError CEGroupMemberNotActive
|
||||
SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn})
|
||||
SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_})
|
||||
SetShowMemberMessages gName mName showMessages -> withUser $ \user -> do
|
||||
(gId, mId) <- getGroupAndMemberId user gName mName
|
||||
m <- withStore $ \db -> getGroupMember db user gId mId
|
||||
let settings = (memberSettings m) {showMessages}
|
||||
processChatCommand $ APISetMemberSettings gId mId settings
|
||||
ContactInfo cName -> withContactName cName APIContactInfo
|
||||
ShowGroupInfo gName -> withUser $ \user -> do
|
||||
groupId <- withStore $ \db -> getGroupIdByName db user gName
|
||||
@@ -2073,7 +2086,7 @@ processChatCommand = \case
|
||||
when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g)
|
||||
when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved
|
||||
unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
|
||||
delGroupChatItem :: User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> m ChatResponse
|
||||
delGroupChatItem :: MsgDirectionI d => User -> GroupInfo -> ChatItem 'CTGroup d -> MessageId -> Maybe GroupMember -> m ChatResponse
|
||||
delGroupChatItem user gInfo ci msgId byGroupMember = do
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
if groupFeatureAllowed SGFFullDelete gInfo
|
||||
@@ -2813,10 +2826,10 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do
|
||||
waitChatStarted
|
||||
case cType of
|
||||
CTDirect -> do
|
||||
(ct, ci) <- withStoreCtx (Just "deleteTimedItem, getContact ...") $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
|
||||
(ct, CChatItem _ ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
|
||||
deleteDirectCI user ct ci True True >>= toView
|
||||
CTGroup -> do
|
||||
(gInfo, ci) <- withStoreCtx (Just "deleteTimedItem, getGroupInfo ...") $ \db -> (,) <$> getGroupInfo db user chatId <*> getGroupChatItem db user chatId itemId
|
||||
(gInfo, CChatItem _ ci) <- withStore $ \db -> (,) <$> getGroupInfo db user chatId <*> getGroupChatItem db user chatId itemId
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
deleteGroupCI user gInfo ci True True Nothing deletedTs >>= toView
|
||||
_ -> toView . CRChatError (Just user) . ChatError $ CEInternalError "bad deleteTimedItem cType"
|
||||
@@ -3335,7 +3348,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
updateGroupMemberStatus db userId membership GSMemConnected
|
||||
-- possible improvement: check for each pending message, requires keeping track of connection state
|
||||
unless (connDisabled conn) $ sendPendingGroupMessages user m conn
|
||||
withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ enableNtfs chatSettings
|
||||
withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings
|
||||
case memberCategory m of
|
||||
GCHostMember -> do
|
||||
toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected}
|
||||
@@ -3932,7 +3945,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
deleteRcvChatItem `catchCINotFound` (toView . CRChatItemDeletedNotFound user ct)
|
||||
where
|
||||
deleteRcvChatItem = do
|
||||
ci@(CChatItem msgDir _) <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId
|
||||
CChatItem msgDir ci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId
|
||||
case msgDir of
|
||||
SMDRcv ->
|
||||
if featureAllowed SCFFullDelete forContact ct
|
||||
@@ -4013,21 +4026,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
createItem timed_ live
|
||||
| groupFeatureAllowed SGFFullDelete gInfo = do
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta CIRcvModerated Nothing timed_ False
|
||||
ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo (CChatItem SMDRcv ci) moderator moderatedAt
|
||||
toView $ CRNewChatItem user ci'
|
||||
ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
|
||||
toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci'
|
||||
| otherwise = do
|
||||
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent content) (snd <$> file_) timed_ False
|
||||
cr <- markGroupCIDeleted user gInfo (CChatItem SMDRcv ci) createdByMsgId False (Just moderator) moderatedAt
|
||||
toView cr
|
||||
toView =<< markGroupCIDeleted user gInfo ci createdByMsgId False (Just moderator) moderatedAt
|
||||
createItem timed_ live = do
|
||||
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
|
||||
newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
|
||||
autoAcceptFile file_
|
||||
when (showMessages $ memberSettings m) $ autoAcceptFile file_
|
||||
newChatItem ciContent ciFile_ timed_ live = do
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live
|
||||
ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
|
||||
reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_
|
||||
groupMsgToView gInfo m ci {reactions} msgMeta
|
||||
groupMsgToView gInfo m ci' {reactions} msgMeta
|
||||
|
||||
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m ()
|
||||
groupMessageUpdate gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ =
|
||||
@@ -4039,7 +4052,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live
|
||||
ci' <- withStore' $ \db -> do
|
||||
createChatItemVersion db (chatItemId' ci) brokerTs mc
|
||||
updateGroupChatItem db user groupId ci content live Nothing
|
||||
ci' <- updateGroupChatItem db user groupId ci content live Nothing
|
||||
blockedMember m ci' $ markGroupChatItemBlocked db user gInfo ci'
|
||||
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
|
||||
where
|
||||
MsgMeta {broker = (_, brokerTs)} = msgMeta
|
||||
@@ -4068,7 +4082,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do
|
||||
let msgMemberId = fromMaybe memberId sndMemberId_
|
||||
withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case
|
||||
Right ci@(CChatItem _ ChatItem {chatDir}) -> case chatDir of
|
||||
Right (CChatItem _ ci@ChatItem {chatDir}) -> case chatDir of
|
||||
CIGroupRcv mem
|
||||
| sameMemberId memberId mem && msgMemberId == memberId -> delete ci Nothing >>= toView
|
||||
| otherwise -> deleteMsg mem ci
|
||||
@@ -4078,7 +4092,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
| senderRole < GRAdmin -> messageError $ "x.msg.del: message not found, message of another member with insufficient member permissions, " <> tshow e
|
||||
| otherwise -> withStore' $ \db -> createCIModeration db gInfo m msgMemberId sharedMsgId msgId brokerTs
|
||||
where
|
||||
deleteMsg :: GroupMember -> CChatItem 'CTGroup -> m ()
|
||||
deleteMsg :: MsgDirectionI d => GroupMember -> ChatItem 'CTGroup d -> m ()
|
||||
deleteMsg mem ci = case sndMemberId_ of
|
||||
Just sndMemberId
|
||||
| sameMemberId sndMemberId mem -> checkRole mem $ delete ci (Just m) >>= toView
|
||||
@@ -4088,6 +4102,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
| senderRole < GRAdmin || senderRole < memberRole =
|
||||
messageError "x.msg.del: message of another member with insufficient member permissions"
|
||||
| otherwise = a
|
||||
delete :: MsgDirectionI d => ChatItem 'CTGroup d -> Maybe GroupMember -> m ChatResponse
|
||||
delete ci byGroupMember
|
||||
| groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCI user gInfo ci False False byGroupMember brokerTs
|
||||
| otherwise = markGroupCIDeleted user gInfo ci msgId False byGroupMember brokerTs
|
||||
@@ -4113,7 +4128,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
|
||||
ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol}
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
|
||||
groupMsgToView gInfo m ci' msgMeta
|
||||
|
||||
blockedMember :: Monad m' => GroupMember -> ChatItem c d -> m' (ChatItem c d) -> m' (ChatItem c d)
|
||||
blockedMember m ci blockedCI
|
||||
| showMessages (memberSettings m) = pure ci
|
||||
| otherwise = blockedCI
|
||||
|
||||
receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> m (Maybe InlineFileMode)
|
||||
receiveInlineMode FileInvitation {fileSize, fileInline, fileDescr} mc_ chSize = case (fileInline, fileDescr) of
|
||||
@@ -4632,7 +4653,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
toView $ CRJoinedGroupMemberConnecting user gInfo m newMember
|
||||
|
||||
xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m ()
|
||||
xGrpMemIntro gInfo@GroupInfo {chatSettings = ChatSettings {enableNtfs}} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do
|
||||
xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do
|
||||
case memberCategory m of
|
||||
GCHostMember -> do
|
||||
members <- withStore' $ \db -> getGroupMembers db user gInfo
|
||||
@@ -4652,7 +4673,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId subMode
|
||||
_ -> messageError "x.grp.mem.intro can be only sent by host member"
|
||||
where
|
||||
createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv enableNtfs SCMInvitation subMode
|
||||
createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation subMode
|
||||
|
||||
sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> m ()
|
||||
sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do
|
||||
@@ -4675,7 +4696,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
_ -> messageError "x.grp.mem.inv can be only sent by invitee member"
|
||||
|
||||
xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> m ()
|
||||
xGrpMemFwd gInfo@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} m memInfo@(MemberInfo memId memRole memberChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do
|
||||
xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memberChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do
|
||||
checkHostRole m memRole
|
||||
members <- withStore' $ \db -> getGroupMembers db user gInfo
|
||||
toMember <- case find (sameMemberId memId) members of
|
||||
@@ -4690,8 +4711,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- [incognito] send membership incognito profile, create direct connection as incognito
|
||||
dm <- directMessage $ XGrpMemInfo membership.memberId (fromLocalProfile $ memberProfile membership)
|
||||
-- [async agent commands] no continuation needed, but commands should be asynchronous for stability
|
||||
groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm subMode
|
||||
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user enableNtfs dcr dm subMode
|
||||
groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode
|
||||
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode
|
||||
let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
|
||||
mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange
|
||||
withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId subMode
|
||||
@@ -5215,20 +5236,22 @@ mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs cur
|
||||
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs currentTs currentTs
|
||||
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file}
|
||||
|
||||
deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse
|
||||
deleteDirectCI user ct ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed = do
|
||||
deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse
|
||||
deleteDirectCI user ct ci@ChatItem {file} byUser timed = do
|
||||
deleteCIFile user file
|
||||
withStoreCtx' (Just "deleteDirectCI, deleteDirectChatItem") $ \db -> deleteDirectChatItem db user ct ci
|
||||
pure $ CRChatItemDeleted user (AChatItem SCTDirect msgDir (DirectChat ct) deletedItem) Nothing byUser timed
|
||||
pure $ CRChatItemDeleted user (AChatItem SCTDirect msgDirection (DirectChat ct) ci) Nothing byUser timed
|
||||
|
||||
deleteGroupCI :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
|
||||
deleteGroupCI user gInfo ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed byGroupMember_ deletedTs = do
|
||||
deleteGroupCI :: (ChatMonad m, MsgDirectionI d) => User -> GroupInfo -> ChatItem 'CTGroup d -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
|
||||
deleteGroupCI user gInfo ci@ChatItem {file} byUser timed byGroupMember_ deletedTs = do
|
||||
deleteCIFile user file
|
||||
toCi <- withStoreCtx' (Just "deleteGroupCI, deleteGroupChatItem ...") $ \db ->
|
||||
case byGroupMember_ of
|
||||
Nothing -> deleteGroupChatItem db user gInfo ci $> Nothing
|
||||
Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m deletedTs
|
||||
pure $ CRChatItemDeleted user (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) toCi byUser timed
|
||||
pure $ CRChatItemDeleted user (gItem ci) (gItem <$> toCi) byUser timed
|
||||
where
|
||||
gItem = AChatItem SCTGroup msgDirection (GroupChat gInfo)
|
||||
|
||||
deleteCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m ()
|
||||
deleteCIFile user file_ =
|
||||
@@ -5236,25 +5259,21 @@ deleteCIFile user file_ =
|
||||
fileAgentConnIds <- deleteFile' user (mkCIFileInfo file) True
|
||||
deleteAgentConnectionsAsync user fileAgentConnIds
|
||||
|
||||
markDirectCIDeleted :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> MessageId -> Bool -> UTCTime -> m ChatResponse
|
||||
markDirectCIDeleted user ct@Contact {contactId} ci@(CChatItem _ ChatItem {file}) msgId byUser deletedTs = do
|
||||
markDirectCIDeleted :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> MessageId -> Bool -> UTCTime -> m ChatResponse
|
||||
markDirectCIDeleted user ct ci@ChatItem {file} msgId byUser deletedTs = do
|
||||
cancelCIFile user file
|
||||
toCi <- withStore $ \db -> do
|
||||
liftIO $ markDirectChatItemDeleted db user ct ci msgId deletedTs
|
||||
getDirectChatItem db user contactId (cchatItemId ci)
|
||||
pure $ CRChatItemDeleted user (ctItem ci) (Just $ ctItem toCi) byUser False
|
||||
ci' <- withStore' $ \db -> markDirectChatItemDeleted db user ct ci msgId deletedTs
|
||||
pure $ CRChatItemDeleted user (ctItem ci) (Just $ ctItem ci') byUser False
|
||||
where
|
||||
ctItem (CChatItem msgDir ci') = AChatItem SCTDirect msgDir (DirectChat ct) ci'
|
||||
ctItem = AChatItem SCTDirect msgDirection (DirectChat ct)
|
||||
|
||||
markGroupCIDeleted :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
|
||||
markGroupCIDeleted user gInfo@GroupInfo {groupId} ci@(CChatItem _ ChatItem {file}) msgId byUser byGroupMember_ deletedTs = do
|
||||
markGroupCIDeleted :: (ChatMonad m, MsgDirectionI d) => User -> GroupInfo -> ChatItem 'CTGroup d -> MessageId -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
|
||||
markGroupCIDeleted user gInfo ci@ChatItem {file} msgId byUser byGroupMember_ deletedTs = do
|
||||
cancelCIFile user file
|
||||
toCi <- withStore $ \db -> do
|
||||
liftIO $ markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_ deletedTs
|
||||
getGroupChatItem db user groupId (cchatItemId ci)
|
||||
pure $ CRChatItemDeleted user (gItem ci) (Just $ gItem toCi) byUser False
|
||||
ci' <- withStore' $ \db -> markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_ deletedTs
|
||||
pure $ CRChatItemDeleted user (gItem ci) (Just $ gItem ci') byUser False
|
||||
where
|
||||
gItem (CChatItem msgDir ci') = AChatItem SCTGroup msgDir (GroupChat gInfo) ci'
|
||||
gItem = AChatItem SCTGroup msgDirection (GroupChat gInfo)
|
||||
|
||||
cancelCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m ()
|
||||
cancelCIFile user file_ =
|
||||
@@ -5440,21 +5459,6 @@ getCreateActiveUser st testView = do
|
||||
getWithPrompt :: String -> IO String
|
||||
getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine
|
||||
|
||||
userNtf :: User -> Bool
|
||||
userNtf User {showNtfs, activeUser} = showNtfs || activeUser
|
||||
|
||||
chatNtf :: User -> ChatInfo c -> Bool
|
||||
chatNtf user = \case
|
||||
DirectChat ct -> contactNtf user ct
|
||||
GroupChat g -> groupNtf user g
|
||||
_ -> False
|
||||
|
||||
contactNtf :: User -> Contact -> Bool
|
||||
contactNtf user Contact {chatSettings} = userNtf user && enableNtfs chatSettings
|
||||
|
||||
groupNtf :: User -> GroupInfo -> Bool
|
||||
groupNtf user GroupInfo {chatSettings} = userNtf user && enableNtfs chatSettings
|
||||
|
||||
withUser' :: ChatMonad m => (User -> m ChatResponse) -> m ChatResponse
|
||||
withUser' action =
|
||||
asks currentUser
|
||||
@@ -5492,9 +5496,12 @@ withAgent action =
|
||||
chatCommandP :: Parser ChatCommand
|
||||
chatCommandP =
|
||||
choice
|
||||
[ "/mute " *> ((`SetShowMessages` False) <$> chatNameP),
|
||||
"/unmute " *> ((`SetShowMessages` True) <$> chatNameP),
|
||||
[ "/mute " *> ((`SetShowMessages` MFNone) <$> chatNameP),
|
||||
"/unmute " *> ((`SetShowMessages` MFAll) <$> chatNameP),
|
||||
"/unmute mentions " *> ((`SetShowMessages` MFMentions) <$> chatNameP),
|
||||
"/receipts " *> (SetSendReceipts <$> chatNameP <* " " <*> ((Just <$> onOffP) <|> ("default" $> Nothing))),
|
||||
"/block #" *> (SetShowMemberMessages <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure False),
|
||||
"/unblock #" *> (SetShowMemberMessages <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure True),
|
||||
"/_create user " *> (CreateActiveUser <$> jsonP),
|
||||
"/create user " *> (CreateActiveUser <$> newUserP),
|
||||
"/users" $> ListUsers,
|
||||
@@ -5598,6 +5605,7 @@ chatCommandP =
|
||||
("/network" <|> "/net") $> APIGetNetworkConfig,
|
||||
"/reconnect" $> ReconnectAllServers,
|
||||
"/_settings " *> (APISetChatSettings <$> chatRefP <* A.space <*> jsonP),
|
||||
"/_member settings #" *> (APISetMemberSettings <$> A.decimal <* A.space <*> A.decimal <* A.space <*> jsonP),
|
||||
"/_info #" *> (APIGroupMemberInfo <$> A.decimal <* A.space <*> A.decimal),
|
||||
"/_info #" *> (APIGroupInfo <$> A.decimal),
|
||||
"/_info @" *> (APIContactInfo <$> A.decimal),
|
||||
|
||||
Reference in New Issue
Block a user