core: group snd status (#2763)

* core: group snd status

* schema, implementation

* refactor direct, tests

* configure, tests

* item info

* refactor

* refactor

* remove do

* rename

* remove receipts on events

* refactor

* refactor

* refactor

* refactor

* tests

* rename tests

* aggregates

* fix name

* refactor

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
spaced4ndy 2023-07-26 14:49:35 +04:00 committed by GitHub
parent 26a233ab1a
commit ae9b83515c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
19 changed files with 635 additions and 184 deletions

View File

@ -127,7 +127,7 @@ public enum ChatCommand {
case let .setAllContactReceipts(enable): return "/set receipts all \(onOff(enable))" case let .setAllContactReceipts(enable): return "/set receipts all \(onOff(enable))"
case let .apiSetUserContactReceipts(userId, userMsgReceiptSettings): case let .apiSetUserContactReceipts(userId, userMsgReceiptSettings):
let umrs = userMsgReceiptSettings let umrs = userMsgReceiptSettings
return "/_set receipts \(userId) \(onOff(umrs.enable)) clear_overrides=\(onOff(umrs.clearOverrides))" return "/_set receipts contacts \(userId) \(onOff(umrs.enable)) clear_overrides=\(onOff(umrs.clearOverrides))"
case let .apiHideUser(userId, viewPwd): return "/_hide user \(userId) \(encodeJSON(viewPwd))" case let .apiHideUser(userId, viewPwd): return "/_hide user \(userId) \(encodeJSON(viewPwd))"
case let .apiUnhideUser(userId, viewPwd): return "/_unhide user \(userId) \(encodeJSON(viewPwd))" case let .apiUnhideUser(userId, viewPwd): return "/_unhide user \(userId) \(encodeJSON(viewPwd))"
case let .apiMuteUser(userId): return "/_mute user \(userId)" case let .apiMuteUser(userId): return "/_mute user \(userId)"

View File

@ -1882,7 +1882,7 @@ sealed class CC {
is SetAllContactReceipts -> "/set receipts all ${onOff(enable)}" is SetAllContactReceipts -> "/set receipts all ${onOff(enable)}"
is ApiSetUserContactReceipts -> { is ApiSetUserContactReceipts -> {
val mrs = userMsgReceiptSettings val mrs = userMsgReceiptSettings
"/_set receipts $userId ${onOff(mrs.enable)} clear_overrides=${onOff(mrs.clearOverrides)}" "/_set receipts contacts $userId ${onOff(mrs.enable)} clear_overrides=${onOff(mrs.clearOverrides)}"
} }
is ApiHideUser -> "/_hide user $userId ${json.encodeToString(viewPwd)}" is ApiHideUser -> "/_hide user $userId ${json.encodeToString(viewPwd)}"
is ApiUnhideUser -> "/_unhide user $userId ${json.encodeToString(viewPwd)}" is ApiUnhideUser -> "/_unhide user $userId ${json.encodeToString(viewPwd)}"

View File

@ -105,6 +105,7 @@ library
Simplex.Chat.Migrations.M20230618_favorite_chats Simplex.Chat.Migrations.M20230618_favorite_chats
Simplex.Chat.Migrations.M20230621_chat_item_moderations Simplex.Chat.Migrations.M20230621_chat_item_moderations
Simplex.Chat.Migrations.M20230705_delivery_receipts Simplex.Chat.Migrations.M20230705_delivery_receipts
Simplex.Chat.Migrations.M20230721_group_snd_item_statuses
Simplex.Chat.Mobile Simplex.Chat.Mobile
Simplex.Chat.Mobile.WebRTC Simplex.Chat.Mobile.WebRTC
Simplex.Chat.Options Simplex.Chat.Options

View File

@ -159,6 +159,9 @@ maxMsgReactions = 3
fixedImagePreview :: ImageData fixedImagePreview :: ImageData
fixedImagePreview = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAAXNSR0IArs4c6QAAAKVJREFUeF7t1kENACEUQ0FQhnVQ9lfGO+xggITQdvbMzArPey+8fa3tAfwAEdABZQspQStgBssEcgAIkSAJkiAJljtEgiRIgmUCSZAESZAESZAEyx0iQRIkwTKBJEiCv5fgvTd1wDmn7QAP4AeIgA4oW0gJWgEzWCZwbQ7gAA7ggLKFOIADOKBMIAeAEAmSIAmSYLlDJEiCJFgmkARJkARJ8N8S/ADTZUewBvnTOQAAAABJRU5ErkJggg==" fixedImagePreview = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAAXNSR0IArs4c6QAAAKVJREFUeF7t1kENACEUQ0FQhnVQ9lfGO+xggITQdvbMzArPey+8fa3tAfwAEdABZQspQStgBssEcgAIkSAJkiAJljtEgiRIgmUCSZAESZAESZAEyx0iQRIkwTKBJEiCv5fgvTd1wDmn7QAP4AeIgA4oW0gJWgEzWCZwbQ7gAA7ggLKFOIADOKBMIAeAEAmSIAmSYLlDJEiCJFgmkARJkARJ8N8S/ADTZUewBvnTOQAAAABJRU5ErkJggg=="
smallGroupsRcptsMemLimit :: Int
smallGroupsRcptsMemLimit = 20
logCfg :: LogConfig logCfg :: LogConfig
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
@ -397,6 +400,12 @@ processChatCommand = \case
withStore' $ \db -> updateUserContactReceipts db user' settings withStore' $ \db -> updateUserContactReceipts db user' settings
ok user ok user
SetUserContactReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserContactReceipts userId settings SetUserContactReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserContactReceipts userId settings
APISetUserGroupReceipts userId' settings -> withUser $ \user -> do
user' <- privateGetUser userId'
validateUserPassword user user' Nothing
withStore' $ \db -> updateUserGroupReceipts db user' settings
ok user
SetUserGroupReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserGroupReceipts userId settings
APIHideUser userId' (UserPwd viewPwd) -> withUser $ \user -> do APIHideUser userId' (UserPwd viewPwd) -> withUser $ \user -> do
user' <- privateGetUser userId' user' <- privateGetUser userId'
case viewPwdHash user' of case viewPwdHash user' of
@ -494,10 +503,16 @@ processChatCommand = \case
chatItems <- withStore $ \db -> getAllChatItems db user pagination search chatItems <- withStore $ \db -> getAllChatItems db user pagination search
pure $ CRChatItems user chatItems pure $ CRChatItems user chatItems
APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do
(aci@(AChatItem _ _ _ ci), versions) <- withStore $ \db -> (aci@(AChatItem cType dir _ ci), versions) <- withStore $ \db ->
(,) <$> getAChatItem db user chatRef itemId <*> liftIO (getChatItemVersions db itemId) (,) <$> getAChatItem db user chatRef itemId <*> liftIO (getChatItemVersions db itemId)
let itemVersions = if null versions then maybeToList $ mkItemVersion ci else versions let itemVersions = if null versions then maybeToList $ mkItemVersion ci else versions
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions} memberDeliveryStatuses <- case (cType, dir) of
(SCTGroup, SMDSnd) -> do
withStore' (`getGroupSndStatuses` itemId) >>= \case
[] -> pure Nothing
memStatuses -> pure $ Just $ map (uncurry MemberDeliveryStatus) memStatuses
_ -> pure Nothing
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses}
APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
CTDirect -> do CTDirect -> do
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
@ -572,9 +587,12 @@ processChatCommand = \case
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms) (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo itemTTL timed_ <- sndGroupCITimed live gInfo itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer) (msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_ mapM_ (sendGroupFileInline ms sharedMsgId) ft_
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
withStore' $ \db ->
forM_ sentToMembers $ \GroupMember {groupMemberId} ->
createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
forM_ (timed_ >>= timedDeleteAt') $ forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
setActive $ ActiveG gName setActive $ ActiveG gName
@ -708,7 +726,7 @@ processChatCommand = \case
let changed = mc /= oldMC let changed = mc /= oldMC
if changed || fromMaybe False itemLive if changed || fromMaybe False itemLive
then do then do
SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
ci' <- withStore' $ \db -> do ci' <- withStore' $ \db -> do
currentTs <- liftIO getCurrentTime currentTs <- liftIO getCurrentTime
when changed $ when changed $
@ -742,7 +760,7 @@ processChatCommand = \case
(CIDMInternal, _, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime (CIDMInternal, _, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime
(CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do (CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do
assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
SndMessage {msgId} <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing
delGroupChatItem user gInfo ci msgId Nothing delGroupChatItem user gInfo ci msgId Nothing
(CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete (CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete
CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
@ -754,7 +772,7 @@ processChatCommand = \case
(CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do
when (groupMemberId /= mId) $ throwChatError CEInvalidChatItemDelete when (groupMemberId /= mId) $ throwChatError CEInvalidChatItemDelete
assertUserGroupRole gInfo $ max GRAdmin memberRole assertUserGroupRole gInfo $ max GRAdmin memberRole
SndMessage {msgId} <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId $ Just memberId (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId $ Just memberId
delGroupChatItem user gInfo ci msgId (Just membership) delGroupChatItem user gInfo ci msgId (Just membership)
(_, _) -> throwChatError CEInvalidChatItemDelete (_, _) -> throwChatError CEInvalidChatItemDelete
APIChatItemReaction (ChatRef cType chatId) itemId add reaction -> withUser $ \user -> withChatLock "chatItemReaction" $ case cType of APIChatItemReaction (ChatRef cType chatId) itemId add reaction -> withUser $ \user -> withChatLock "chatItemReaction" $ case cType of
@ -786,7 +804,7 @@ processChatCommand = \case
let GroupMember {memberId = itemMemberId} = chatItemMember g ci let GroupMember {memberId = itemMemberId} = chatItemMember g ci
rs <- withStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True rs <- withStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True
checkReactionAllowed rs checkReactionAllowed rs
SndMessage {msgId} <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add) (SndMessage {msgId}, _) <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add)
createdAt <- liftIO getCurrentTime createdAt <- liftIO getCurrentTime
reactions <- withStore' $ \db -> do reactions <- withStore' $ \db -> do
setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt
@ -1409,7 +1427,7 @@ processChatCommand = \case
(Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq (Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName _ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
_ -> do _ -> do
msg <- sendGroupMessage user gInfo members $ XGrpMemRole mId memRole (msg, _) <- sendGroupMessage user gInfo members $ XGrpMemRole mId memRole
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent) ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent)
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole} pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole}
@ -1425,7 +1443,7 @@ processChatCommand = \case
deleteMemberConnection user m deleteMemberConnection user m
withStore' $ \db -> deleteGroupMember db user m withStore' $ \db -> deleteGroupMember db user m
_ -> do _ -> do
msg <- sendGroupMessage user gInfo members $ XGrpMemDel mId (msg, _) <- sendGroupMessage user gInfo members $ XGrpMemDel mId
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile))
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
deleteMemberConnection user m deleteMemberConnection user m
@ -1435,7 +1453,7 @@ processChatCommand = \case
APILeaveGroup groupId -> withUser $ \user@User {userId} -> do APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
withChatLock "leaveGroup" . procCmd $ do withChatLock "leaveGroup" . procCmd $ do
msg <- sendGroupMessage user gInfo members XGrpLeave (msg, _) <- sendGroupMessage user gInfo members XGrpLeave
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft)
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
-- TODO delete direct connections that were unused -- TODO delete direct connections that were unused
@ -1823,7 +1841,7 @@ processChatCommand = \case
runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p} ms) p' = do runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p} ms) p' = do
assertUserGroupRole g GROwner assertUserGroupRole g GROwner
g' <- withStore $ \db -> updateGroupProfile db user g p' g' <- withStore $ \db -> updateGroupProfile db user g p'
msg <- sendGroupMessage user g' ms (XGrpInfo p') (msg, _) <- sendGroupMessage user g' ms (XGrpInfo p')
let cd = CDGroupSnd g' let cd = CDGroupSnd g'
unless (sameGroupProfileInfo p p') $ do unless (sameGroupProfileInfo p p') $ do
ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p')
@ -2871,12 +2889,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
SENT msgId -> do SENT msgId -> do
sentMsgDeliveryEvent conn msgId sentMsgDeliveryEvent conn msgId
checkSndInlineFTComplete conn msgId checkSndInlineFTComplete conn msgId
withStore' (\db -> getDirectChatItemByAgentMsgId db user contactId connId msgId) >>= \case updateDirectItemStatus ct conn msgId $ CISSndSent SSPComplete
Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemStatus = CISSndRcvd _}}) -> pure ()
Just (CChatItem SMDSnd ci) -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId (chatItemId' ci) CISSndSent
toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
_ -> pure ()
SWITCH qd phase cStats -> do SWITCH qd phase cStats -> do
toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats) toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats)
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
@ -2917,10 +2930,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} -> withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} ->
when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId
MERR msgId err -> do MERR msgId err -> do
chatItemId_ <- withStore' $ \db -> getChatItemIdByAgentMsgId db connId msgId updateDirectItemStatus ct conn msgId $ agentErrToItemStatus err
forM_ chatItemId_ $ \chatItemId -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId chatItemId (agentErrToItemStatus err)
toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
incAuthErrCounter connEntity conn err incAuthErrCounter connEntity conn err
ERR err -> do ERR err -> do
@ -3066,7 +3076,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
XGrpInfo p' -> xGrpInfo gInfo m p' msg msgMeta XGrpInfo p' -> xGrpInfo gInfo m p' msg msgMeta
BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
_ -> messageError $ "unsupported message: " <> T.pack (show event) _ -> messageError $ "unsupported message: " <> T.pack (show event)
pure False -- no receipts in group now $ hasDeliveryReceipt $ toCMEventTag event currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
let GroupInfo {chatSettings = ChatSettings {sendRcpts}} = gInfo
pure $
fromMaybe (sendRcptsSmallGroups user) sendRcpts
&& hasDeliveryReceipt (toCMEventTag event)
&& currentMemCount <= smallGroupsRcptsMemLimit
where where
canSend a canSend a
| memberRole (m :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages" | memberRole (m :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages"
@ -3077,6 +3092,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
SENT msgId -> do SENT msgId -> do
sentMsgDeliveryEvent conn msgId sentMsgDeliveryEvent conn msgId
checkSndInlineFTComplete conn msgId checkSndInlineFTComplete conn msgId
updateGroupItemStatus gInfo m conn msgId $ CISSndSent SSPComplete
SWITCH qd phase cStats -> do SWITCH qd phase cStats -> do
toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats) toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
@ -3113,7 +3129,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- [async agent commands] continuation on receiving OK -- [async agent commands] continuation on receiving OK
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} -> withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} ->
when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId
MERR _ err -> do MERR msgId err -> do
chatItemId_ <- withStore' $ \db -> getChatItemIdByAgentMsgId db connId msgId
forM_ chatItemId_ $ \itemId -> do
let GroupMember {groupMemberId} = m
updateGroupMemSndStatus itemId groupMemberId $ agentErrToItemStatus err
-- group errors are silenced to reduce load on UI event log -- group errors are silenced to reduce load on UI event log
-- toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) -- toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
incAuthErrCounter connEntity conn err incAuthErrCounter connEntity conn err
@ -3368,7 +3388,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- 1) retry processing several times -- 1) retry processing several times
-- 2) stabilize database -- 2) stabilize database
-- 3) show screen of death to the user asking to restart -- 3) show screen of death to the user asking to restart
-- TODO send receipt depending on contact/group settings
tryChatError action >>= \case tryChatError action >>= \case
Right withRcpt -> ack $ if withRcpt then Just "" else Nothing Right withRcpt -> ack $ if withRcpt then Just "" else Nothing
Left e -> ack Nothing >> throwError e Left e -> ack Nothing >> throwError e
@ -4295,21 +4314,52 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m () directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
directMsgReceived ct@Contact {contactId} Connection {connId} msgMeta msgRcpts = do directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
withStore' (\db -> getDirectChatItemByAgentMsgId db user contactId connId agentMsgId) >>= \case updateDirectItemStatus ct conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
Just (CChatItem SMDSnd ci) -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId (chatItemId' ci) $ CISSndRcvd msgRcptStatus groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do
checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
updateGroupItemStatus gInfo m conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
updateDirectItemStatus :: Contact -> Connection -> AgentMsgId -> CIStatus 'MDSnd -> m ()
updateDirectItemStatus ct@Contact {contactId} Connection {connId} msgId newStatus =
withStore' (\db -> getDirectChatItemByAgentMsgId db user contactId connId msgId) >>= \case
Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemStatus = CISSndRcvd _ _}}) -> pure ()
Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}})
| itemStatus == newStatus -> pure ()
| otherwise -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId itemId newStatus
toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
_ -> pure () _ -> pure ()
groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m () updateGroupMemSndStatus :: ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> m Bool
groupMsgReceived gInfo m Connection {connId} msgMeta msgRcpts = do updateGroupMemSndStatus itemId groupMemberId newStatus =
checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta runExceptT (withStore $ \db -> getGroupSndStatus db itemId groupMemberId) >>= \case
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> Right (CISSndRcvd _ _) -> pure False
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus Right memStatus
| memStatus == newStatus -> pure False
| otherwise -> withStore' (\db -> updateGroupSndStatus db itemId groupMemberId newStatus) $> True
_ -> pure False
updateGroupItemStatus :: GroupInfo -> GroupMember -> Connection -> AgentMsgId -> CIStatus 'MDSnd -> m ()
updateGroupItemStatus gInfo@GroupInfo {groupId} GroupMember {groupMemberId} Connection {connId} msgId newMemStatus =
withStore' (\db -> getGroupChatItemByAgentMsgId db user groupId connId msgId) >>= \case
Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemStatus = CISSndRcvd _ SSPComplete}}) -> pure ()
Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}}) -> do
memStatusChanged <- updateGroupMemSndStatus itemId groupMemberId newMemStatus
when memStatusChanged $ do
memStatusCounts <- withStore' (`getGroupSndStatusCounts` itemId)
let newStatus = membersGroupItemStatus memStatusCounts
when (newStatus /= itemStatus) $ do
chatItem <- withStore $ \db -> updateGroupChatItemStatus db user groupId itemId newStatus
toView $ CRChatItemStatusUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) chatItem)
_ -> pure ()
parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p) parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p)
parseFileDescription = parseFileDescription =
@ -4525,26 +4575,33 @@ deliverMessage conn@Connection {connId} cmEventTag msgBody msgId = do
(Just $ "createSndMsgDelivery, sndMsgDelivery: " <> show sndMsgDelivery <> ", msgId: " <> show msgId <> ", cmEventTag: " <> show cmEventTag <> ", msgDeliveryStatus: MDSSndAgent") (Just $ "createSndMsgDelivery, sndMsgDelivery: " <> show sndMsgDelivery <> ", msgId: " <> show msgId <> ", cmEventTag: " <> show cmEventTag <> ", msgDeliveryStatus: MDSSndAgent")
$ \db -> createSndMsgDelivery db sndMsgDelivery msgId $ \db -> createSndMsgDelivery db sndMsgDelivery msgId
sendGroupMessage :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m SndMessage sendGroupMessage :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember])
sendGroupMessage user GroupInfo {groupId} members chatMsgEvent = sendGroupMessage user GroupInfo {groupId} members chatMsgEvent =
sendGroupMessage' user members chatMsgEvent groupId Nothing $ pure () sendGroupMessage' user members chatMsgEvent groupId Nothing $ pure ()
sendGroupMessage' :: (MsgEncodingI e, ChatMonad m) => User -> [GroupMember] -> ChatMsgEvent e -> Int64 -> Maybe Int64 -> m () -> m SndMessage sendGroupMessage' :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> [GroupMember] -> ChatMsgEvent e -> Int64 -> Maybe Int64 -> m () -> m (SndMessage, [GroupMember])
sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do
msg <- createSndMessage chatMsgEvent (GroupId groupId) msg <- createSndMessage chatMsgEvent (GroupId groupId)
-- TODO collect failed deliveries into a single error -- TODO collect failed deliveries into a single error
forM_ (filter memberCurrent members) $ \m -> rs <- forM (filter memberCurrent members) $ \m ->
messageMember m msg `catchChatError` (toView . CRChatError (Just user)) messageMember m msg `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
pure msg let sentToMembers = catMaybes rs
pure (msg, sentToMembers)
where where
messageMember :: GroupMember -> SndMessage -> m (Maybe GroupMember)
messageMember m@GroupMember {groupMemberId} SndMessage {msgId, msgBody} = case memberConn m of messageMember m@GroupMember {groupMemberId} SndMessage {msgId, msgBody} = case memberConn m of
Nothing -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_ Nothing -> do
withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
pure $ Just m
Just conn@Connection {connStatus} Just conn@Connection {connStatus}
| connDisabled conn || connStatus == ConnDeleted -> pure () | connDisabled conn || connStatus == ConnDeleted -> pure Nothing
| connStatus == ConnSndReady || connStatus == ConnReady -> do | connStatus == ConnSndReady || connStatus == ConnReady -> do
let tag = toCMEventTag chatMsgEvent let tag = toCMEventTag chatMsgEvent
deliverMessage conn tag msgBody msgId >> postDeliver deliverMessage conn tag msgBody msgId >> postDeliver
| otherwise -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_ pure $ Just m
| otherwise -> do
withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
pure $ Just m
sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m () sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m ()
sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do
@ -4926,8 +4983,10 @@ chatCommandP =
"/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)), "/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)),
("/user " <|> "/u ") *> (SetActiveUser <$> displayName <*> optional (A.space *> pwdP)), ("/user " <|> "/u ") *> (SetActiveUser <$> displayName <*> optional (A.space *> pwdP)),
"/set receipts all " *> (SetAllContactReceipts <$> onOffP), "/set receipts all " *> (SetAllContactReceipts <$> onOffP),
"/_set receipts " *> (APISetUserContactReceipts <$> A.decimal <* A.space <*> receiptSettings), "/_set receipts contacts " *> (APISetUserContactReceipts <$> A.decimal <* A.space <*> receiptSettings),
"/set receipts " *> (SetUserContactReceipts <$> receiptSettings), "/set receipts contacts " *> (SetUserContactReceipts <$> receiptSettings),
"/_set receipts groups " *> (APISetUserGroupReceipts <$> A.decimal <* A.space <*> receiptSettings),
"/set receipts groups " *> (SetUserGroupReceipts <$> receiptSettings),
"/_hide user " *> (APIHideUser <$> A.decimal <* A.space <*> jsonP), "/_hide user " *> (APIHideUser <$> A.decimal <* A.space <*> jsonP),
"/_unhide user " *> (APIUnhideUser <$> A.decimal <* A.space <*> jsonP), "/_unhide user " *> (APIUnhideUser <$> A.decimal <* A.space <*> jsonP),
"/_mute user " *> (APIMuteUser <$> A.decimal), "/_mute user " *> (APIMuteUser <$> A.decimal),

View File

@ -203,6 +203,8 @@ data ChatCommand
| SetAllContactReceipts Bool | SetAllContactReceipts Bool
| APISetUserContactReceipts UserId UserMsgReceiptSettings | APISetUserContactReceipts UserId UserMsgReceiptSettings
| SetUserContactReceipts UserMsgReceiptSettings | SetUserContactReceipts UserMsgReceiptSettings
| APISetUserGroupReceipts UserId UserMsgReceiptSettings
| SetUserGroupReceipts UserMsgReceiptSettings
| APIHideUser UserId UserPwd | APIHideUser UserId UserPwd
| APIUnhideUser UserId UserPwd | APIUnhideUser UserId UserPwd
| APIMuteUser UserId | APIMuteUser UserId

View File

@ -21,7 +21,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy.Char8 as LB import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Int (Int64) import Data.Int (Int64)
import Data.Maybe (isJust, isNothing) import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@ -624,13 +624,15 @@ data CIFileInfo = CIFileInfo
data CIStatus (d :: MsgDirection) where data CIStatus (d :: MsgDirection) where
CISSndNew :: CIStatus 'MDSnd CISSndNew :: CIStatus 'MDSnd
CISSndSent :: CIStatus 'MDSnd CISSndSent :: SndCIStatusProgress -> CIStatus 'MDSnd
CISSndRcvd :: MsgReceiptStatus -> CIStatus 'MDSnd CISSndRcvd :: MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
CISSndErrorAuth :: CIStatus 'MDSnd CISSndErrorAuth :: CIStatus 'MDSnd
CISSndError :: String -> CIStatus 'MDSnd CISSndError :: String -> CIStatus 'MDSnd
CISRcvNew :: CIStatus 'MDRcv CISRcvNew :: CIStatus 'MDRcv
CISRcvRead :: CIStatus 'MDRcv CISRcvRead :: CIStatus 'MDRcv
deriving instance Eq (CIStatus d)
deriving instance Show (CIStatus d) deriving instance Show (CIStatus d)
instance ToJSON (CIStatus d) where instance ToJSON (CIStatus d) where
@ -639,6 +641,8 @@ instance ToJSON (CIStatus d) where
instance MsgDirectionI d => ToField (CIStatus d) where toField = toField . decodeLatin1 . strEncode instance MsgDirectionI d => ToField (CIStatus d) where toField = toField . decodeLatin1 . strEncode
instance (Typeable d, MsgDirectionI d) => FromField (CIStatus d) where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8 instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
data ACIStatus = forall d. MsgDirectionI d => ACIStatus (SMsgDirection d) (CIStatus d) data ACIStatus = forall d. MsgDirectionI d => ACIStatus (SMsgDirection d) (CIStatus d)
@ -648,8 +652,8 @@ deriving instance Show ACIStatus
instance MsgDirectionI d => StrEncoding (CIStatus d) where instance MsgDirectionI d => StrEncoding (CIStatus d) where
strEncode = \case strEncode = \case
CISSndNew -> "snd_new" CISSndNew -> "snd_new"
CISSndSent -> "snd_sent" CISSndSent sndProgress -> "snd_sent " <> strEncode sndProgress
CISSndRcvd status -> "snd_rcvd " <> strEncode status CISSndRcvd msgRcptStatus sndProgress -> "snd_rcvd " <> strEncode msgRcptStatus <> " " <> strEncode sndProgress
CISSndErrorAuth -> "snd_error_auth" CISSndErrorAuth -> "snd_error_auth"
CISSndError e -> "snd_error " <> encodeUtf8 (T.pack e) CISSndError e -> "snd_error " <> encodeUtf8 (T.pack e)
CISRcvNew -> "rcv_new" CISRcvNew -> "rcv_new"
@ -661,8 +665,8 @@ instance StrEncoding ACIStatus where
strP = strP =
A.takeTill (== ' ') >>= \case A.takeTill (== ' ') >>= \case
"snd_new" -> pure $ ACIStatus SMDSnd CISSndNew "snd_new" -> pure $ ACIStatus SMDSnd CISSndNew
"snd_sent" -> pure $ ACIStatus SMDSnd CISSndSent "snd_sent" -> ACIStatus SMDSnd . CISSndSent <$> ((A.space *> strP) <|> pure SSPComplete)
"snd_rcvd" -> ACIStatus SMDSnd . CISSndRcvd <$> (A.space *> strP) "snd_rcvd" -> ACIStatus SMDSnd <$> (CISSndRcvd <$> (A.space *> strP) <*> ((A.space *> strP) <|> pure SSPComplete))
"snd_error_auth" -> pure $ ACIStatus SMDSnd CISSndErrorAuth "snd_error_auth" -> pure $ ACIStatus SMDSnd CISSndErrorAuth
"snd_error" -> ACIStatus SMDSnd . CISSndError . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString) "snd_error" -> ACIStatus SMDSnd . CISSndError . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString)
"rcv_new" -> pure $ ACIStatus SMDRcv CISRcvNew "rcv_new" -> pure $ ACIStatus SMDRcv CISRcvNew
@ -671,8 +675,8 @@ instance StrEncoding ACIStatus where
data JSONCIStatus data JSONCIStatus
= JCISSndNew = JCISSndNew
| JCISSndSent | JCISSndSent {sndProgress :: SndCIStatusProgress}
| JCISSndRcvd {msgRcptStatus :: MsgReceiptStatus} | JCISSndRcvd {msgRcptStatus :: MsgReceiptStatus, sndProgress :: SndCIStatusProgress}
| JCISSndErrorAuth | JCISSndErrorAuth
| JCISSndError {agentError :: String} | JCISSndError {agentError :: String}
| JCISRcvNew | JCISRcvNew
@ -686,8 +690,8 @@ instance ToJSON JSONCIStatus where
jsonCIStatus :: CIStatus d -> JSONCIStatus jsonCIStatus :: CIStatus d -> JSONCIStatus
jsonCIStatus = \case jsonCIStatus = \case
CISSndNew -> JCISSndNew CISSndNew -> JCISSndNew
CISSndSent -> JCISSndSent CISSndSent sndProgress -> JCISSndSent sndProgress
CISSndRcvd ok -> JCISSndRcvd ok CISSndRcvd msgRcptStatus sndProgress -> JCISSndRcvd msgRcptStatus sndProgress
CISSndErrorAuth -> JCISSndErrorAuth CISSndErrorAuth -> JCISSndErrorAuth
CISSndError e -> JCISSndError e CISSndError e -> JCISSndError e
CISRcvNew -> JCISRcvNew CISRcvNew -> JCISRcvNew
@ -703,6 +707,40 @@ ciCreateStatus content = case msgDirection @d of
SMDSnd -> ciStatusNew SMDSnd -> ciStatusNew
SMDRcv -> if ciRequiresAttention content then ciStatusNew else CISRcvRead SMDRcv -> if ciRequiresAttention content then ciStatusNew else CISRcvRead
membersGroupItemStatus :: [(CIStatus 'MDSnd, Int)] -> CIStatus 'MDSnd
membersGroupItemStatus memStatusCounts
| rcvdOk == total = CISSndRcvd MROk SSPComplete
| rcvdOk + rcvdBad == total = CISSndRcvd MRBadMsgHash SSPComplete
| rcvdBad > 0 = CISSndRcvd MRBadMsgHash SSPPartial
| rcvdOk > 0 = CISSndRcvd MROk SSPPartial
| sent == total = CISSndSent SSPComplete
| sent > 0 = CISSndSent SSPPartial
| otherwise = CISSndNew
where
total = sum $ map snd memStatusCounts
rcvdOk = fromMaybe 0 $ lookup (CISSndRcvd MROk SSPComplete) memStatusCounts
rcvdBad = fromMaybe 0 $ lookup (CISSndRcvd MRBadMsgHash SSPComplete) memStatusCounts
sent = fromMaybe 0 $ lookup (CISSndSent SSPComplete) memStatusCounts
data SndCIStatusProgress
= SSPPartial
| SSPComplete
deriving (Eq, Show, Generic)
instance ToJSON SndCIStatusProgress where
toJSON = J.genericToJSON . enumJSON $ dropPrefix "SSP"
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "SSP"
instance StrEncoding SndCIStatusProgress where
strEncode = \case
SSPPartial -> "partial"
SSPComplete -> "complete"
strP =
A.takeWhile1 (/= ' ') >>= \case
"partial" -> pure SSPPartial
"complete" -> pure SSPComplete
_ -> fail "bad SndCIStatusProgress"
type ChatItemId = Int64 type ChatItemId = Int64
type ChatItemTs = UTCTime type ChatItemTs = UTCTime
@ -887,7 +925,8 @@ itemDeletedTs = \case
CIModerated ts _ -> ts CIModerated ts _ -> ts
data ChatItemInfo = ChatItemInfo data ChatItemInfo = ChatItemInfo
{ itemVersions :: [ChatItemVersion] { itemVersions :: [ChatItemVersion],
memberDeliveryStatuses :: Maybe [MemberDeliveryStatus]
} }
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
@ -917,6 +956,14 @@ mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content
createdAt = createdAt createdAt = createdAt
} }
data MemberDeliveryStatus = MemberDeliveryStatus
{ groupMemberId :: GroupMemberId,
memberDeliveryStatus :: CIStatus 'MDSnd
}
deriving (Eq, Show, Generic)
instance ToJSON MemberDeliveryStatus where toEncoding = J.genericToEncoding J.defaultOptions
data CIModeration = CIModeration data CIModeration = CIModeration
{ moderationId :: Int64, { moderationId :: Int64,
moderatorMember :: GroupMember, moderatorMember :: GroupMember,

View File

@ -0,0 +1,33 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230721_group_snd_item_statuses where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20230721_group_snd_item_statuses :: Query
m20230721_group_snd_item_statuses =
[sql|
CREATE TABLE group_snd_item_statuses (
group_snd_item_status_id INTEGER PRIMARY KEY,
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
group_snd_item_status TEXT NOT NULL,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
CREATE INDEX idx_group_snd_item_statuses_chat_item_id ON group_snd_item_statuses(chat_item_id);
CREATE INDEX idx_group_snd_item_statuses_group_member_id ON group_snd_item_statuses(group_member_id);
UPDATE users SET send_rcpts_small_groups = 1 WHERE send_rcpts_contacts = 1;
|]
down_m20230721_group_snd_item_statuses :: Query
down_m20230721_group_snd_item_statuses =
[sql|
DROP INDEX idx_group_snd_item_statuses_group_member_id;
DROP INDEX idx_group_snd_item_statuses_chat_item_id;
DROP TABLE group_snd_item_statuses;
|]

View File

@ -496,6 +496,14 @@ CREATE TABLE chat_item_moderations(
created_at TEXT NOT NULL DEFAULT(datetime('now')), created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now')) updated_at TEXT NOT NULL DEFAULT(datetime('now'))
); );
CREATE TABLE group_snd_item_statuses(
group_snd_item_status_id INTEGER PRIMARY KEY,
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
group_snd_item_status TEXT NOT NULL,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
CREATE INDEX contact_profiles_index ON contact_profiles( CREATE INDEX contact_profiles_index ON contact_profiles(
display_name, display_name,
full_name full_name
@ -687,3 +695,9 @@ CREATE INDEX idx_chat_item_moderations_group ON chat_item_moderations(
item_member_id, item_member_id,
shared_msg_id shared_msg_id
); );
CREATE INDEX idx_group_snd_item_statuses_chat_item_id ON group_snd_item_statuses(
chat_item_id
);
CREATE INDEX idx_group_snd_item_statuses_group_member_id ON group_snd_item_statuses(
group_member_id
);

View File

@ -39,6 +39,7 @@ module Simplex.Chat.Store.Groups
getGroupMemberById, getGroupMemberById,
getGroupMembers, getGroupMembers,
getGroupMembersForExpiration, getGroupMembersForExpiration,
getGroupCurrentMembersCount,
deleteGroupConnectionsAndFiles, deleteGroupConnectionsAndFiles,
deleteGroupItemsAndMembers, deleteGroupItemsAndMembers,
deleteGroup, deleteGroup,
@ -548,6 +549,20 @@ toContactMember :: User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember User {userContactId} (memberRow :. connRow) = toContactMember User {userContactId} (memberRow :. connRow) =
(toGroupMember userContactId memberRow) {activeConn = toMaybeConnection connRow} (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection connRow}
getGroupCurrentMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int
getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
statuses :: [GroupMemberStatus] <-
map fromOnly
<$> DB.query
db
[sql|
SELECT member_status
FROM group_members
WHERE group_id = ? AND user_id = ?
|]
(groupId, userId)
pure $ length $ filter memberCurrent' statuses
getGroupInvitation :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation getGroupInvitation :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation db user groupId = getGroupInvitation db user groupId =
getConnRec_ user >>= \case getConnRec_ user >>= \case

View File

@ -44,6 +44,7 @@ module Simplex.Chat.Store.Messages
createChatItemVersion, createChatItemVersion,
deleteDirectChatItem, deleteDirectChatItem,
markDirectChatItemDeleted, markDirectChatItemDeleted,
updateGroupChatItemStatus,
updateGroupChatItem, updateGroupChatItem,
deleteGroupChatItem, deleteGroupChatItem,
updateGroupChatItemModerated, updateGroupChatItemModerated,
@ -69,6 +70,7 @@ module Simplex.Chat.Store.Messages
getGroupChatItem, getGroupChatItem,
getGroupChatItemBySharedMsgId, getGroupChatItemBySharedMsgId,
getGroupMemberCIBySharedMsgId, getGroupMemberCIBySharedMsgId,
getGroupChatItemByAgentMsgId,
getGroupMemberChatItemLast, getGroupMemberChatItemLast,
getDirectChatItemIdByText, getDirectChatItemIdByText,
getDirectChatItemIdByText', getDirectChatItemIdByText',
@ -87,6 +89,11 @@ module Simplex.Chat.Store.Messages
createCIModeration, createCIModeration,
getCIModeration, getCIModeration,
deleteCIModeration, deleteCIModeration,
createGroupSndStatus,
getGroupSndStatus,
updateGroupSndStatus,
getGroupSndStatuses,
getGroupSndStatusCounts,
) )
where where
@ -1325,6 +1332,16 @@ getDirectChatItemIdByText' db User {userId} contactId msg =
|] |]
(userId, contactId, msg <> "%") (userId, contactId, msg <> "%")
updateGroupChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> GroupId -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTGroup d)
updateGroupChatItemStatus db user@User {userId} groupId itemId itemStatus = do
ci <- liftEither . correctDir =<< getGroupChatItem db user groupId itemId
currentTs <- liftIO getCurrentTime
liftIO $ DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?" (itemStatus, currentTs, userId, groupId, itemId)
pure ci {meta = (meta ci) {itemStatus}}
where
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d) updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
updateGroupChatItem db user groupId ci newContent live msgId_ = do updateGroupChatItem db user groupId ci newContent live msgId_ = do
currentTs <- liftIO getCurrentTime currentTs <- liftIO getCurrentTime
@ -1434,6 +1451,11 @@ getGroupMemberCIBySharedMsgId db user@User {userId} groupId memberId sharedMsgId
(GCUserMember, userId, groupId, memberId, sharedMsgId) (GCUserMember, userId, groupId, memberId, sharedMsgId)
getGroupChatItem db user groupId itemId getGroupChatItem db user groupId itemId
getGroupChatItemByAgentMsgId :: DB.Connection -> User -> GroupId -> Int64 -> AgentMsgId -> IO (Maybe (CChatItem 'CTGroup))
getGroupChatItemByAgentMsgId db user groupId connId msgId = do
itemId_ <- getChatItemIdByAgentMsgId db connId msgId
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupChatItem db user groupId) itemId_
getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup) getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
currentTs <- getCurrentTime currentTs <- getCurrentTime
@ -1847,3 +1869,58 @@ deleteCIModeration db GroupInfo {groupId} itemMemberId (Just sharedMsgId) =
db db
"DELETE FROM chat_item_moderations WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?" "DELETE FROM chat_item_moderations WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?"
(groupId, itemMemberId, sharedMsgId) (groupId, itemMemberId, sharedMsgId)
createGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> IO ()
createGroupSndStatus db itemId memberId status =
DB.execute
db
"INSERT INTO group_snd_item_statuses (chat_item_id, group_member_id, group_snd_item_status) VALUES (?,?,?)"
(itemId, memberId, status)
getGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> ExceptT StoreError IO (CIStatus 'MDSnd)
getGroupSndStatus db itemId memberId =
ExceptT . firstRow fromOnly (SENoGroupSndStatus itemId memberId) $
DB.query
db
[sql|
SELECT group_snd_item_status
FROM group_snd_item_statuses
WHERE chat_item_id = ? AND group_member_id = ?
LIMIT 1
|]
(itemId, memberId)
updateGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> IO ()
updateGroupSndStatus db itemId memberId status = do
currentTs <- liftIO getCurrentTime
DB.execute
db
[sql|
UPDATE group_snd_item_statuses
SET group_snd_item_status = ?, updated_at = ?
WHERE chat_item_id = ? AND group_member_id = ?
|]
(status, currentTs, itemId, memberId)
getGroupSndStatuses :: DB.Connection -> ChatItemId -> IO [(GroupMemberId, CIStatus 'MDSnd)]
getGroupSndStatuses db itemId =
DB.query
db
[sql|
SELECT group_member_id, group_snd_item_status
FROM group_snd_item_statuses
WHERE chat_item_id = ?
|]
(Only itemId)
getGroupSndStatusCounts :: DB.Connection -> ChatItemId -> IO [(CIStatus 'MDSnd, Int)]
getGroupSndStatusCounts db itemId =
DB.query
db
[sql|
SELECT group_snd_item_status, COUNT(1)
FROM group_snd_item_statuses
WHERE chat_item_id = ?
GROUP BY group_snd_item_status
|]
(Only itemId)

View File

@ -74,6 +74,7 @@ import Simplex.Chat.Migrations.M20230608_deleted_contacts
import Simplex.Chat.Migrations.M20230618_favorite_chats import Simplex.Chat.Migrations.M20230618_favorite_chats
import Simplex.Chat.Migrations.M20230621_chat_item_moderations import Simplex.Chat.Migrations.M20230621_chat_item_moderations
import Simplex.Chat.Migrations.M20230705_delivery_receipts import Simplex.Chat.Migrations.M20230705_delivery_receipts
import Simplex.Chat.Migrations.M20230721_group_snd_item_statuses
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)] schemaMigrations :: [(String, Query, Maybe Query)]
@ -147,7 +148,8 @@ schemaMigrations =
("20230608_deleted_contacts", m20230608_deleted_contacts, Just down_m20230608_deleted_contacts), ("20230608_deleted_contacts", m20230608_deleted_contacts, Just down_m20230608_deleted_contacts),
("20230618_favorite_chats", m20230618_favorite_chats, Just down_m20230618_favorite_chats), ("20230618_favorite_chats", m20230618_favorite_chats, Just down_m20230618_favorite_chats),
("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations), ("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations),
("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts) ("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts),
("20230721_group_snd_item_statuses", m20230721_group_snd_item_statuses, Just down_m20230721_group_snd_item_statuses)
] ]
-- | The list of migrations in ascending order by date -- | The list of migrations in ascending order by date

View File

@ -30,6 +30,7 @@ module Simplex.Chat.Store.Profiles
updateUserPrivacy, updateUserPrivacy,
updateAllContactReceipts, updateAllContactReceipts,
updateUserContactReceipts, updateUserContactReceipts,
updateUserGroupReceipts,
updateUserProfile, updateUserProfile,
setUserProfileContactLink, setUserProfileContactLink,
getUserContactProfiles, getUserContactProfiles,
@ -92,7 +93,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0" when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
let showNtfs = True let showNtfs = True
sendRcptsContacts = True sendRcptsContacts = True
sendRcptsSmallGroups = False sendRcptsSmallGroups = True
DB.execute DB.execute
db db
"INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,0,?,?,?,?,?)" "INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,0,?,?,?,?,?)"
@ -222,13 +223,21 @@ updateUserPrivacy db User {userId, showNtfs, viewPwdHash} =
updateAllContactReceipts :: DB.Connection -> Bool -> IO () updateAllContactReceipts :: DB.Connection -> Bool -> IO ()
updateAllContactReceipts db onOff = updateAllContactReceipts db onOff =
DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE view_pwd_hash IS NULL" (Only onOff) DB.execute
db
"UPDATE users SET send_rcpts_contacts = ?, send_rcpts_small_groups = ? WHERE view_pwd_hash IS NULL"
(onOff, onOff)
updateUserContactReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO () updateUserContactReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserContactReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do updateUserContactReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (enable, userId) DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (enable, userId)
when clearOverrides $ DB.execute_ db "UPDATE contacts SET send_rcpts = NULL" when clearOverrides $ DB.execute_ db "UPDATE contacts SET send_rcpts = NULL"
updateUserGroupReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserGroupReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
DB.execute db "UPDATE users SET send_rcpts_small_groups = ? WHERE user_id = ?" (enable, userId)
when clearOverrides $ DB.execute_ db "UPDATE groups SET send_rcpts = NULL"
updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
updateUserProfile db user p' updateUserProfile db user p'
| displayName == newName = do | displayName == newName = do

View File

@ -92,6 +92,7 @@ data StoreError
| SEGroupLinkNotFound {groupInfo :: GroupInfo} | SEGroupLinkNotFound {groupInfo :: GroupInfo}
| SEHostMemberIdNotFound {groupId :: Int64} | SEHostMemberIdNotFound {groupId :: Int64}
| SEContactNotFoundByFileId {fileId :: FileTransferId} | SEContactNotFoundByFileId {fileId :: FileTransferId}
| SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
deriving (Show, Exception, Generic) deriving (Show, Exception, Generic)
instance ToJSON StoreError where instance ToJSON StoreError where

View File

@ -782,7 +782,10 @@ memberActive m = case memberStatus m of
GSMemCreator -> True GSMemCreator -> True
memberCurrent :: GroupMember -> Bool memberCurrent :: GroupMember -> Bool
memberCurrent m = case memberStatus m of memberCurrent = memberCurrent' . memberStatus
memberCurrent' :: GroupMemberStatus -> Bool
memberCurrent' = \case
GSMemRemoved -> False GSMemRemoved -> False
GSMemLeft -> False GSMemLeft -> False
GSMemGroupDeleted -> False GSMemGroupDeleted -> False

View File

@ -465,12 +465,21 @@ localTs tz ts = do
viewChatItemStatusUpdated :: AChatItem -> CurrentTime -> TimeZone -> Bool -> Bool -> [StyledString] viewChatItemStatusUpdated :: AChatItem -> CurrentTime -> TimeZone -> Bool -> Bool -> [StyledString]
viewChatItemStatusUpdated (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) ts tz testView showReceipts = viewChatItemStatusUpdated (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) ts tz testView showReceipts =
case itemStatus of case itemStatus of
CISSndRcvd rcptStatus -> CISSndRcvd rcptStatus SSPPartial ->
if testView && showReceipts
then prependFirst (viewDeliveryReceiptPartial rcptStatus <> " ") $ viewChatItem chat item False ts tz
else []
CISSndRcvd rcptStatus SSPComplete ->
if testView && showReceipts if testView && showReceipts
then prependFirst (viewDeliveryReceipt rcptStatus <> " ") $ viewChatItem chat item False ts tz then prependFirst (viewDeliveryReceipt rcptStatus <> " ") $ viewChatItem chat item False ts tz
else [] else []
_ -> [] _ -> []
viewDeliveryReceiptPartial :: MsgReceiptStatus -> StyledString
viewDeliveryReceiptPartial = \case
MROk -> "%"
MRBadMsgHash -> ttyError' "%!"
viewDeliveryReceipt :: MsgReceiptStatus -> StyledString viewDeliveryReceipt :: MsgReceiptStatus -> StyledString
viewDeliveryReceipt = \case viewDeliveryReceipt = \case
MROk -> "" MROk -> ""

View File

@ -2213,13 +2213,13 @@ testConfigureDeliveryReceipts tmp =
noReceipt cath alice "4" noReceipt cath alice "4"
-- configure receipts for user contacts -- configure receipts for user contacts
alice ##> "/_set receipts 1 on" alice ##> "/_set receipts contacts 1 on"
alice <## "ok" alice <## "ok"
receipt bob alice "5" receipt bob alice "5"
receipt cath alice "6" receipt cath alice "6"
-- configure receipts for user contacts (terminal api) -- configure receipts for user contacts (terminal api)
alice ##> "/set receipts off" alice ##> "/set receipts contacts off"
alice <## "ok" alice <## "ok"
noReceipt bob alice "7" noReceipt bob alice "7"
noReceipt cath alice "8" noReceipt cath alice "8"
@ -2231,18 +2231,18 @@ testConfigureDeliveryReceipts tmp =
noReceipt cath alice "10" noReceipt cath alice "10"
-- configure receipts for user contacts (don't clear overrides) -- configure receipts for user contacts (don't clear overrides)
alice ##> "/_set receipts 1 off" alice ##> "/_set receipts contacts 1 off"
alice <## "ok" alice <## "ok"
receipt bob alice "11" receipt bob alice "11"
noReceipt cath alice "12" noReceipt cath alice "12"
alice ##> "/_set receipts 1 off clear_overrides=off" alice ##> "/_set receipts contacts 1 off clear_overrides=off"
alice <## "ok" alice <## "ok"
receipt bob alice "13" receipt bob alice "13"
noReceipt cath alice "14" noReceipt cath alice "14"
-- configure receipts for user contacts (clear overrides) -- configure receipts for user contacts (clear overrides)
alice ##> "/set receipts off clear_overrides=on" alice ##> "/set receipts contacts off clear_overrides=on"
alice <## "ok" alice <## "ok"
noReceipt bob alice "15" noReceipt bob alice "15"
noReceipt cath alice "16" noReceipt cath alice "16"

View File

@ -59,8 +59,11 @@ chatGroupTests = do
it "show message decryption error" testGroupMsgDecryptError it "show message decryption error" testGroupMsgDecryptError
it "should report ratchet de-synchronization, synchronize ratchets" testGroupSyncRatchet it "should report ratchet de-synchronization, synchronize ratchets" testGroupSyncRatchet
it "synchronize ratchets, reset connection code" testGroupSyncRatchetCodeReset it "synchronize ratchets, reset connection code" testGroupSyncRatchetCodeReset
describe "message reactions" $ do describe "group message reactions" $ do
it "set group message reactions" testSetGroupMessageReactions it "set group message reactions" testSetGroupMessageReactions
describe "group delivery receipts" $ do
it "should send delivery receipts in group" testSendGroupDeliveryReceipts
it "should send delivery receipts in group depending on configuration" testConfigureGroupDeliveryReceipts
testGroup :: HasCallStack => SpecWith FilePath testGroup :: HasCallStack => SpecWith FilePath
testGroup = versionTestMatrix3 runTestGroup testGroup = versionTestMatrix3 runTestGroup
@ -198,6 +201,7 @@ testGroupShared alice bob cath checkMessages = do
alice @@@ [("@cath", "sent invitation to join group team as admin"), ("#team", "received")] alice @@@ [("@cath", "sent invitation to join group team as admin"), ("#team", "received")]
bob @@@ [("@alice", "received invitation to join group team as admin"), ("@cath", "hey"), ("#team", "received")] bob @@@ [("@alice", "received invitation to join group team as admin"), ("@cath", "hey"), ("#team", "received")]
-- test clearing chat -- test clearing chat
threadDelay 1000000
alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY") alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
alice #$> ("/_get chat #1 count=100", chat, []) alice #$> ("/_get chat #1 count=100", chat, [])
bob #$> ("/clear #team", id, "#team: all messages are removed locally ONLY") bob #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
@ -976,6 +980,7 @@ testGroupMessageDelete =
(bob <# "#team alice> hello!") (bob <# "#team alice> hello!")
(cath <# "#team alice> hello!") (cath <# "#team alice> hello!")
threadDelay 1000000
msgItemId1 <- lastItemId alice msgItemId1 <- lastItemId alice
alice #$> ("/_delete item #1 " <> msgItemId1 <> " internal", id, "message deleted") alice #$> ("/_delete item #1 " <> msgItemId1 <> " internal", id, "message deleted")
@ -2197,47 +2202,46 @@ testGroupLinkLeaveDelete =
testGroupMsgDecryptError :: HasCallStack => FilePath -> IO () testGroupMsgDecryptError :: HasCallStack => FilePath -> IO ()
testGroupMsgDecryptError tmp = testGroupMsgDecryptError tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "cath" cathProfile $ \cath -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChat tmp "bob" bobProfile $ \bob -> do
createGroup3 "team" alice bob cath createGroup2 "team" alice bob
alice #> "#team hi" alice #> "#team hi"
[bob, cath] *<# "#team alice> hi" bob <# "#team alice> hi"
bob #> "#team hey" bob #> "#team hey"
[alice, cath] *<# "#team bob> hey" alice <# "#team bob> hey"
setupDesynchronizedRatchet tmp alice cath setupDesynchronizedRatchet tmp alice
withTestChat tmp "bob" $ \bob -> do withTestChat tmp "bob" $ \bob -> do
bob <## "2 contacts connected (use /cs for the list)" bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)" bob <## "#team: connected to server(s)"
alice #> "#team hello again" alice #> "#team hello again"
bob <# "#team alice> skipped message ID 8..10" bob <# "#team alice> skipped message ID 10..12"
[bob, cath] *<# "#team alice> hello again" bob <# "#team alice> hello again"
bob #> "#team received!" bob #> "#team received!"
alice <# "#team bob> received!" alice <# "#team bob> received!"
cath <# "#team bob> received!"
setupDesynchronizedRatchet :: HasCallStack => FilePath -> TestCC -> TestCC -> IO () setupDesynchronizedRatchet :: HasCallStack => FilePath -> TestCC -> IO ()
setupDesynchronizedRatchet tmp alice cath = do setupDesynchronizedRatchet tmp alice = do
copyDb "bob" "bob_old" copyDb "bob" "bob_old"
withTestChat tmp "bob" $ \bob -> do withTestChat tmp "bob" $ \bob -> do
bob <## "2 contacts connected (use /cs for the list)" bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)" bob <## "#team: connected to server(s)"
alice #> "#team hello" alice #> "#team 1"
[bob, cath] *<# "#team alice> hello" bob <# "#team alice> 1"
bob #> "#team hello too" bob #> "#team 2"
[alice, cath] *<# "#team bob> hello too" alice <# "#team bob> 2"
alice #> "#team 3"
bob <# "#team alice> 3"
bob #> "#team 4"
alice <# "#team bob> 4"
withTestChat tmp "bob_old" $ \bob -> do withTestChat tmp "bob_old" $ \bob -> do
bob <## "2 contacts connected (use /cs for the list)" bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)" bob <## "#team: connected to server(s)"
bob ##> "/sync #team alice" bob ##> "/sync #team alice"
bob <## "error: command is prohibited" bob <## "error: command is prohibited"
alice #> "#team 1" alice #> "#team 1"
bob <## "#team alice: decryption error (connection out of sync), synchronization required" bob <## "#team alice: decryption error (connection out of sync), synchronization required"
bob <## "use /sync #team alice to synchronize" bob <## "use /sync #team alice to synchronize"
cath <# "#team alice> 1"
alice #> "#team 2" alice #> "#team 2"
cath <# "#team alice> 2"
alice #> "#team 3" alice #> "#team 3"
cath <# "#team alice> 3"
(bob </) (bob </)
bob ##> "/tail #team 1" bob ##> "/tail #team 1"
bob <# "#team alice> decryption error, possibly due to the device change (header, 3 messages)" bob <# "#team alice> decryption error, possibly due to the device change (header, 3 messages)"
@ -2249,34 +2253,20 @@ setupDesynchronizedRatchet tmp alice cath = do
testGroupSyncRatchet :: HasCallStack => FilePath -> IO () testGroupSyncRatchet :: HasCallStack => FilePath -> IO ()
testGroupSyncRatchet tmp = testGroupSyncRatchet tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "cath" cathProfile $ \cath -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChat tmp "bob" bobProfile $ \bob -> do
createGroup3 "team" alice bob cath createGroup2 "team" alice bob
alice #> "#team hi" alice #> "#team hi"
[bob, cath] *<# "#team alice> hi" bob <# "#team alice> hi"
bob #> "#team hey" bob #> "#team hey"
[alice, cath] *<# "#team bob> hey" alice <# "#team bob> hey"
setupDesynchronizedRatchet tmp alice cath setupDesynchronizedRatchet tmp alice
withTestChat tmp "bob_old" $ \bob -> do withTestChat tmp "bob_old" $ \bob -> do
bob <## "2 contacts connected (use /cs for the list)" bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)" bob <## "#team: connected to server(s)"
-- cath and bob are not fully de-synchronized
bob `send` "#team 1" bob `send` "#team 1"
bob <## "error: command is prohibited" -- silence? bob <## "error: command is prohibited" -- silence?
bob <# "#team 1" bob <# "#team 1"
(alice </) (alice </)
(cath </)
cath #> "#team 1"
[alice, bob] *<# "#team cath> 1"
bob `send` "#team 2"
bob <## "error: command is prohibited"
bob <# "#team 2"
cath <# "#team bob> incorrect message hash"
cath <# "#team bob> 2"
bob `send` "#team 3"
bob <## "error: command is prohibited"
bob <# "#team 3"
cath <# "#team bob> 3"
-- synchronize bob and alice -- synchronize bob and alice
bob ##> "/sync #team alice" bob ##> "/sync #team alice"
bob <## "connection synchronization started" bob <## "connection synchronization started"
@ -2289,21 +2279,19 @@ testGroupSyncRatchet tmp =
alice #$> ("/_get chat #1 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")]) alice #$> ("/_get chat #1 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")])
alice #> "#team hello again" alice #> "#team hello again"
[bob, cath] *<# "#team alice> hello again" bob <# "#team alice> hello again"
bob #> "#team received!" bob #> "#team received!"
alice <# "#team bob> received!" alice <# "#team bob> received!"
cath <# "#team bob> received!"
testGroupSyncRatchetCodeReset :: HasCallStack => FilePath -> IO () testGroupSyncRatchetCodeReset :: HasCallStack => FilePath -> IO ()
testGroupSyncRatchetCodeReset tmp = testGroupSyncRatchetCodeReset tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "cath" cathProfile $ \cath -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChat tmp "bob" bobProfile $ \bob -> do
createGroup3 "team" alice bob cath createGroup2 "team" alice bob
alice #> "#team hi" alice #> "#team hi"
[bob, cath] *<# "#team alice> hi" bob <# "#team alice> hi"
bob #> "#team hey" bob #> "#team hey"
[alice, cath] *<# "#team bob> hey" alice <# "#team bob> hey"
-- connection not verified -- connection not verified
bob ##> "/i #team alice" bob ##> "/i #team alice"
aliceInfo bob aliceInfo bob
@ -2317,9 +2305,9 @@ testGroupSyncRatchetCodeReset tmp =
bob ##> "/i #team alice" bob ##> "/i #team alice"
aliceInfo bob aliceInfo bob
bob <## "connection verified" bob <## "connection verified"
setupDesynchronizedRatchet tmp alice cath setupDesynchronizedRatchet tmp alice
withTestChat tmp "bob_old" $ \bob -> do withTestChat tmp "bob_old" $ \bob -> do
bob <## "2 contacts connected (use /cs for the list)" bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)" bob <## "#team: connected to server(s)"
bob ##> "/sync #team alice" bob ##> "/sync #team alice"
bob <## "connection synchronization started" bob <## "connection synchronization started"
@ -2338,10 +2326,9 @@ testGroupSyncRatchetCodeReset tmp =
bob <## "connection not verified, use /code command to see security code" bob <## "connection not verified, use /code command to see security code"
alice #> "#team hello again" alice #> "#team hello again"
[bob, cath] *<# "#team alice> hello again" bob <# "#team alice> hello again"
bob #> "#team received!" bob #> "#team received!"
alice <# "#team bob> received!" alice <# "#team bob> received!"
(cath </) -- bob is partially de-synchronized with cath - see test above
where where
aliceInfo :: HasCallStack => TestCC -> IO () aliceInfo :: HasCallStack => TestCC -> IO ()
aliceInfo bob = do aliceInfo bob = do
@ -2418,3 +2405,182 @@ testSetGroupMessageReactions =
cath ##> "/tail #team 1" cath ##> "/tail #team 1"
cath <# "#team alice> hi" cath <# "#team alice> hi"
cath <## " 👍 1" cath <## " 👍 1"
testSendGroupDeliveryReceipts :: HasCallStack => FilePath -> IO ()
testSendGroupDeliveryReceipts tmp =
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
withNewTestChatCfg tmp cfg "cath" cathProfile $ \cath -> do
-- turn off contacts receipts for tests
alice ##> "/_set receipts contacts 1 off"
alice <## "ok"
bob ##> "/_set receipts contacts 1 off"
bob <## "ok"
cath ##> "/_set receipts contacts 1 off"
cath <## "ok"
createGroup3 "team" alice bob cath
threadDelay 1000000
alice #> "#team hi"
bob <# "#team alice> hi"
cath <# "#team alice> hi"
alice % "#team hi"
alice "#team hi"
bob #> "#team hey"
alice <# "#team bob> hey"
cath <# "#team bob> hey"
bob % "#team hey"
bob "#team hey"
where
cfg = testCfg {showReceipts = True}
testConfigureGroupDeliveryReceipts :: HasCallStack => FilePath -> IO ()
testConfigureGroupDeliveryReceipts tmp =
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
withNewTestChatCfg tmp cfg "cath" cathProfile $ \cath -> do
-- turn off contacts receipts for tests
alice ##> "/_set receipts contacts 1 off"
alice <## "ok"
bob ##> "/_set receipts contacts 1 off"
bob <## "ok"
cath ##> "/_set receipts contacts 1 off"
cath <## "ok"
-- create group 1
createGroup3 "team" alice bob cath
threadDelay 1000000
-- create group 2
alice ##> "/g club"
alice <## "group #club is created"
alice <## "to add members use /a club <name> or /create link #club"
alice ##> "/a club bob"
concurrentlyN_
[ alice <## "invitation to join the group #club sent to bob",
do
bob <## "#club: alice invites you to join the group as admin"
bob <## "use /j club to accept"
]
bob ##> "/j club"
concurrently_
(alice <## "#club: bob joined the group")
(bob <## "#club: you joined the group")
alice ##> "/a club cath"
concurrentlyN_
[ alice <## "invitation to join the group #club sent to cath",
do
cath <## "#club: alice invites you to join the group as admin"
cath <## "use /j club to accept"
]
cath ##> "/j club"
concurrentlyN_
[ alice <## "#club: cath joined the group",
do
cath <## "#club: you joined the group"
cath <## "#club: member bob_1 (Bob) is connected"
cath <## "contact bob_1 is merged into bob"
cath <## "use @bob <message> to send messages",
do
bob <## "#club: alice added cath_1 (Catherine) to the group (connecting...)"
bob <## "#club: new member cath_1 is connected"
bob <## "contact cath_1 is merged into cath"
bob <## "use @cath <message> to send messages"
]
threadDelay 1000000
-- for new users receipts are enabled by default
receipt bob alice cath "team" "1"
receipt bob alice cath "club" "2"
-- configure receipts in all chats
alice ##> "/set receipts all off"
alice <## "ok"
partialReceipt bob alice cath "team" "3"
partialReceipt bob alice cath "club" "4"
-- configure receipts for user groups
alice ##> "/_set receipts groups 1 on"
alice <## "ok"
receipt bob alice cath "team" "5"
receipt bob alice cath "club" "6"
-- configure receipts for user groups (terminal api)
alice ##> "/set receipts groups off"
alice <## "ok"
partialReceipt bob alice cath "team" "7"
partialReceipt bob alice cath "club" "8"
-- configure receipts for group
alice ##> "/receipts #team on"
alice <## "ok"
receipt bob alice cath "team" "9"
partialReceipt bob alice cath "club" "10"
-- configure receipts for user groups (don't clear overrides)
alice ##> "/_set receipts groups 1 off"
alice <## "ok"
receipt bob alice cath "team" "11"
partialReceipt bob alice cath "club" "12"
alice ##> "/_set receipts groups 1 off clear_overrides=off"
alice <## "ok"
receipt bob alice cath "team" "13"
partialReceipt bob alice cath "club" "14"
-- configure receipts for user groups (clear overrides)
alice ##> "/set receipts groups off clear_overrides=on"
alice <## "ok"
partialReceipt bob alice cath "team" "15"
partialReceipt bob alice cath "club" "16"
-- configure receipts for group, reset to default
alice ##> "/receipts #team on"
alice <## "ok"
receipt bob alice cath "team" "17"
partialReceipt bob alice cath "club" "18"
alice ##> "/receipts #team default"
alice <## "ok"
partialReceipt bob alice cath "team" "19"
partialReceipt bob alice cath "club" "20"
-- cath - disable receipts for user groups
cath ##> "/_set receipts groups 1 off"
cath <## "ok"
noReceipt bob alice cath "team" "21"
noReceipt bob alice cath "club" "22"
-- partial, all receipts in one group; no receipts in other group
cath ##> "/receipts #team on"
cath <## "ok"
partialReceipt bob alice cath "team" "23"
noReceipt bob alice cath "club" "24"
alice ##> "/receipts #team on"
alice <## "ok"
receipt bob alice cath "team" "25"
noReceipt bob alice cath "club" "26"
where
cfg = testCfg {showReceipts = True}
receipt cc1 cc2 cc3 gName msg = do
name1 <- userName cc1
cc1 #> ("#" <> gName <> " " <> msg)
cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
cc1 % ("#" <> gName <> " " <> msg)
cc1 ("#" <> gName <> " " <> msg)
partialReceipt cc1 cc2 cc3 gName msg = do
name1 <- userName cc1
cc1 #> ("#" <> gName <> " " <> msg)
cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
cc1 % ("#" <> gName <> " " <> msg)
noReceipt cc1 cc2 cc3 gName msg = do
name1 <- userName cc1
cc1 #> ("#" <> gName <> " " <> msg)
cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
cc1 <// 50000

View File

@ -311,6 +311,9 @@ cc ?<# line = (dropTime <$> getTermLine cc) `shouldReturn` "i " <> line
() :: HasCallStack => TestCC -> String -> Expectation () :: HasCallStack => TestCC -> String -> Expectation
cc line = (dropTime . dropReceipt <$> getTermLine cc) `shouldReturn` line cc line = (dropTime . dropReceipt <$> getTermLine cc) `shouldReturn` line
(%) :: HasCallStack => TestCC -> String -> Expectation
cc % line = (dropTime . dropPartialReceipt <$> getTermLine cc) `shouldReturn` line
(</) :: HasCallStack => TestCC -> Expectation (</) :: HasCallStack => TestCC -> Expectation
(</) = (<// 500000) (</) = (<// 500000)
@ -356,6 +359,16 @@ dropReceipt_ msg = case splitAt 2 msg of
("", text) -> Just text ("", text) -> Just text
_ -> Nothing _ -> Nothing
dropPartialReceipt :: HasCallStack => String -> String
dropPartialReceipt msg = fromMaybe err $ dropPartialReceipt_ msg
where
err = error $ "invalid partial receipt: " <> msg
dropPartialReceipt_ :: String -> Maybe String
dropPartialReceipt_ msg = case splitAt 2 msg of
("% ", text) -> Just text
_ -> Nothing
getInvitation :: HasCallStack => TestCC -> IO String getInvitation :: HasCallStack => TestCC -> IO String
getInvitation cc = do getInvitation cc = do
cc <## "pass this invitation link to your contact (via another channel):" cc <## "pass this invitation link to your contact (via another channel):"

View File

@ -27,16 +27,16 @@ noActiveUser = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"e
activeUserExists :: String activeUserExists :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
activeUserExists = "{\"resp\":{\"chatCmdError\":{\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false},\"chatError\":{\"error\":{\"errorType\":{\"userExists\":{\"contactName\":\"alice\"}}}}}}}" activeUserExists = "{\"resp\":{\"chatCmdError\":{\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true},\"chatError\":{\"error\":{\"errorType\":{\"userExists\":{\"contactName\":\"alice\"}}}}}}}"
#else #else
activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false},\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}}" activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true},\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}}"
#endif #endif
activeUser :: String activeUser :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}}}}" activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true}}}}"
#else #else
activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}}}" activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true}}}"
#endif #endif
chatStarted :: String chatStarted :: String
@ -75,7 +75,7 @@ pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\"," <> userJSON <>
#endif #endif
userJSON :: String userJSON :: String
userJSON = "\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}" userJSON = "\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":true}"
parsedMarkdown :: String parsedMarkdown :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)