diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index ea16af7157..344359b38c 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -127,7 +127,7 @@ public enum ChatCommand { case let .setAllContactReceipts(enable): return "/set receipts all \(onOff(enable))" case let .apiSetUserContactReceipts(userId, 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 .apiUnhideUser(userId, viewPwd): return "/_unhide user \(userId) \(encodeJSON(viewPwd))" case let .apiMuteUser(userId): return "/_mute user \(userId)" diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index 3bfe32c732..0e2f53a581 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -1882,7 +1882,7 @@ sealed class CC { is SetAllContactReceipts -> "/set receipts all ${onOff(enable)}" is ApiSetUserContactReceipts -> { 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 ApiUnhideUser -> "/_unhide user $userId ${json.encodeToString(viewPwd)}" diff --git a/simplex-chat.cabal b/simplex-chat.cabal index bba4d69689..cad28ffe73 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -105,6 +105,7 @@ library Simplex.Chat.Migrations.M20230618_favorite_chats Simplex.Chat.Migrations.M20230621_chat_item_moderations Simplex.Chat.Migrations.M20230705_delivery_receipts + Simplex.Chat.Migrations.M20230721_group_snd_item_statuses Simplex.Chat.Mobile Simplex.Chat.Mobile.WebRTC Simplex.Chat.Options diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index df8120b9cb..514553a574 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -159,6 +159,9 @@ maxMsgReactions = 3 fixedImagePreview :: ImageData fixedImagePreview = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAAXNSR0IArs4c6QAAAKVJREFUeF7t1kENACEUQ0FQhnVQ9lfGO+xggITQdvbMzArPey+8fa3tAfwAEdABZQspQStgBssEcgAIkSAJkiAJljtEgiRIgmUCSZAESZAESZAEyx0iQRIkwTKBJEiCv5fgvTd1wDmn7QAP4AeIgA4oW0gJWgEzWCZwbQ7gAA7ggLKFOIADOKBMIAeAEAmSIAmSYLlDJEiCJFgmkARJkARJ8N8S/ADTZUewBvnTOQAAAABJRU5ErkJggg==" +smallGroupsRcptsMemLimit :: Int +smallGroupsRcptsMemLimit = 20 + logCfg :: LogConfig logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} @@ -397,6 +400,12 @@ processChatCommand = \case withStore' $ \db -> updateUserContactReceipts db user' settings ok user 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 user' <- privateGetUser userId' case viewPwdHash user' of @@ -494,10 +503,16 @@ processChatCommand = \case chatItems <- withStore $ \db -> getAllChatItems db user pagination search pure $ CRChatItems user chatItems 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) 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 CTDirect -> do 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) timed_ <- sndGroupCITimed live gInfo itemTTL (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_ 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') $ startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) setActive $ ActiveG gName @@ -708,7 +726,7 @@ processChatCommand = \case let changed = mc /= oldMC if changed || fromMaybe False itemLive 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 currentTs <- liftIO getCurrentTime when changed $ @@ -742,7 +760,7 @@ processChatCommand = \case (CIDMInternal, _, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime (CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do 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 (CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete CTContactRequest -> pure $ chatCmdError (Just user) "not supported" @@ -754,7 +772,7 @@ processChatCommand = \case (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do when (groupMemberId /= mId) $ throwChatError CEInvalidChatItemDelete 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) (_, _) -> throwChatError CEInvalidChatItemDelete 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 rs <- withStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True 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 reactions <- withStore' $ \db -> do 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 _ -> throwChatError $ CEGroupCantResendInvitation gInfo cName _ -> 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) toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole} @@ -1425,7 +1443,7 @@ processChatCommand = \case deleteMemberConnection user m withStore' $ \db -> deleteGroupMember db user m _ -> 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)) toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) deleteMemberConnection user m @@ -1435,7 +1453,7 @@ processChatCommand = \case APILeaveGroup groupId -> withUser $ \user@User {userId} -> do Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId withChatLock "leaveGroup" . procCmd $ do - msg <- sendGroupMessage user gInfo members XGrpLeave + (msg, _) <- sendGroupMessage user gInfo members XGrpLeave ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) -- TODO delete direct connections that were unused @@ -1823,7 +1841,7 @@ processChatCommand = \case runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p} ms) p' = do assertUserGroupRole g GROwner 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' unless (sameGroupProfileInfo p p') $ do ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') @@ -2871,12 +2889,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do SENT msgId -> do sentMsgDeliveryEvent conn msgId checkSndInlineFTComplete conn msgId - withStore' (\db -> getDirectChatItemByAgentMsgId db user contactId connId msgId) >>= \case - 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 () + updateDirectItemStatus ct conn msgId $ CISSndSent SSPComplete SWITCH qd phase cStats -> do toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats) 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} -> when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId MERR msgId err -> do - chatItemId_ <- withStore' $ \db -> getChatItemIdByAgentMsgId db connId msgId - forM_ chatItemId_ $ \chatItemId -> do - chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId chatItemId (agentErrToItemStatus err) - toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) + updateDirectItemStatus ct conn msgId $ agentErrToItemStatus err toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) incAuthErrCounter connEntity conn err ERR err -> do @@ -3066,7 +3076,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XGrpInfo p' -> xGrpInfo gInfo m p' msg msgMeta BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta _ -> 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 canSend a | 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 sentMsgDeliveryEvent conn msgId checkSndInlineFTComplete conn msgId + updateGroupItemStatus gInfo m conn msgId $ CISSndSent SSPComplete SWITCH qd phase cStats -> do toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats) 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 withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, 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 -- toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) incAuthErrCounter connEntity conn err @@ -3368,7 +3388,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- 1) retry processing several times -- 2) stabilize database -- 3) show screen of death to the user asking to restart - -- TODO send receipt depending on contact/group settings tryChatError action >>= \case Right withRcpt -> ack $ if withRcpt then Just "" else Nothing Left e -> ack Nothing >> throwError e @@ -4295,21 +4314,52 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' 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 forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus - withStore' (\db -> getDirectChatItemByAgentMsgId db user contactId connId agentMsgId) >>= \case - Just (CChatItem SMDSnd ci) -> do - chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId (chatItemId' ci) $ CISSndRcvd msgRcptStatus - toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) - _ -> pure () + updateDirectItemStatus ct conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m () - groupMsgReceived gInfo m Connection {connId} msgMeta msgRcpts = do + groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta - forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> + 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) + _ -> pure () + + updateGroupMemSndStatus :: ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> m Bool + updateGroupMemSndStatus itemId groupMemberId newStatus = + runExceptT (withStore $ \db -> getGroupSndStatus db itemId groupMemberId) >>= \case + Right (CISSndRcvd _ _) -> pure False + 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 = @@ -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") $ \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 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 msg <- createSndMessage chatMsgEvent (GroupId groupId) -- TODO collect failed deliveries into a single error - forM_ (filter memberCurrent members) $ \m -> - messageMember m msg `catchChatError` (toView . CRChatError (Just user)) - pure msg + rs <- forM (filter memberCurrent members) $ \m -> + messageMember m msg `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) + let sentToMembers = catMaybes rs + pure (msg, sentToMembers) where + messageMember :: GroupMember -> SndMessage -> m (Maybe GroupMember) 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} - | connDisabled conn || connStatus == ConnDeleted -> pure () + | connDisabled conn || connStatus == ConnDeleted -> pure Nothing | connStatus == ConnSndReady || connStatus == ConnReady -> do let tag = toCMEventTag chatMsgEvent 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 user GroupMember {groupMemberId, localDisplayName} conn = do @@ -4926,8 +4983,10 @@ chatCommandP = "/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)), ("/user " <|> "/u ") *> (SetActiveUser <$> displayName <*> optional (A.space *> pwdP)), "/set receipts all " *> (SetAllContactReceipts <$> onOffP), - "/_set receipts " *> (APISetUserContactReceipts <$> A.decimal <* A.space <*> receiptSettings), - "/set receipts " *> (SetUserContactReceipts <$> receiptSettings), + "/_set receipts contacts " *> (APISetUserContactReceipts <$> A.decimal <* A.space <*> 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), "/_unhide user " *> (APIUnhideUser <$> A.decimal <* A.space <*> jsonP), "/_mute user " *> (APIMuteUser <$> A.decimal), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 8091320717..90f90fdcb6 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -203,6 +203,8 @@ data ChatCommand | SetAllContactReceipts Bool | APISetUserContactReceipts UserId UserMsgReceiptSettings | SetUserContactReceipts UserMsgReceiptSettings + | APISetUserGroupReceipts UserId UserMsgReceiptSettings + | SetUserGroupReceipts UserMsgReceiptSettings | APIHideUser UserId UserPwd | APIUnhideUser UserId UserPwd | APIMuteUser UserId diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index f2d6553a5a..daf59d82ac 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -21,7 +21,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy.Char8 as LB import Data.Int (Int64) -import Data.Maybe (isJust, isNothing) +import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) @@ -624,13 +624,15 @@ data CIFileInfo = CIFileInfo data CIStatus (d :: MsgDirection) where CISSndNew :: CIStatus 'MDSnd - CISSndSent :: CIStatus 'MDSnd - CISSndRcvd :: MsgReceiptStatus -> CIStatus 'MDSnd + CISSndSent :: SndCIStatusProgress -> CIStatus 'MDSnd + CISSndRcvd :: MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd CISSndErrorAuth :: CIStatus 'MDSnd CISSndError :: String -> CIStatus 'MDSnd CISRcvNew :: CIStatus 'MDRcv CISRcvRead :: CIStatus 'MDRcv +deriving instance Eq (CIStatus d) + deriving instance Show (CIStatus d) 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 (Typeable d, MsgDirectionI d) => FromField (CIStatus d) 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) @@ -648,8 +652,8 @@ deriving instance Show ACIStatus instance MsgDirectionI d => StrEncoding (CIStatus d) where strEncode = \case CISSndNew -> "snd_new" - CISSndSent -> "snd_sent" - CISSndRcvd status -> "snd_rcvd " <> strEncode status + CISSndSent sndProgress -> "snd_sent " <> strEncode sndProgress + CISSndRcvd msgRcptStatus sndProgress -> "snd_rcvd " <> strEncode msgRcptStatus <> " " <> strEncode sndProgress CISSndErrorAuth -> "snd_error_auth" CISSndError e -> "snd_error " <> encodeUtf8 (T.pack e) CISRcvNew -> "rcv_new" @@ -661,8 +665,8 @@ instance StrEncoding ACIStatus where strP = A.takeTill (== ' ') >>= \case "snd_new" -> pure $ ACIStatus SMDSnd CISSndNew - "snd_sent" -> pure $ ACIStatus SMDSnd CISSndSent - "snd_rcvd" -> ACIStatus SMDSnd . CISSndRcvd <$> (A.space *> strP) + "snd_sent" -> ACIStatus SMDSnd . CISSndSent <$> ((A.space *> strP) <|> pure SSPComplete) + "snd_rcvd" -> ACIStatus SMDSnd <$> (CISSndRcvd <$> (A.space *> strP) <*> ((A.space *> strP) <|> pure SSPComplete)) "snd_error_auth" -> pure $ ACIStatus SMDSnd CISSndErrorAuth "snd_error" -> ACIStatus SMDSnd . CISSndError . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString) "rcv_new" -> pure $ ACIStatus SMDRcv CISRcvNew @@ -671,8 +675,8 @@ instance StrEncoding ACIStatus where data JSONCIStatus = JCISSndNew - | JCISSndSent - | JCISSndRcvd {msgRcptStatus :: MsgReceiptStatus} + | JCISSndSent {sndProgress :: SndCIStatusProgress} + | JCISSndRcvd {msgRcptStatus :: MsgReceiptStatus, sndProgress :: SndCIStatusProgress} | JCISSndErrorAuth | JCISSndError {agentError :: String} | JCISRcvNew @@ -686,8 +690,8 @@ instance ToJSON JSONCIStatus where jsonCIStatus :: CIStatus d -> JSONCIStatus jsonCIStatus = \case CISSndNew -> JCISSndNew - CISSndSent -> JCISSndSent - CISSndRcvd ok -> JCISSndRcvd ok + CISSndSent sndProgress -> JCISSndSent sndProgress + CISSndRcvd msgRcptStatus sndProgress -> JCISSndRcvd msgRcptStatus sndProgress CISSndErrorAuth -> JCISSndErrorAuth CISSndError e -> JCISSndError e CISRcvNew -> JCISRcvNew @@ -703,6 +707,40 @@ ciCreateStatus content = case msgDirection @d of SMDSnd -> ciStatusNew 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 ChatItemTs = UTCTime @@ -887,7 +925,8 @@ itemDeletedTs = \case CIModerated ts _ -> ts data ChatItemInfo = ChatItemInfo - { itemVersions :: [ChatItemVersion] + { itemVersions :: [ChatItemVersion], + memberDeliveryStatuses :: Maybe [MemberDeliveryStatus] } deriving (Eq, Show, Generic) @@ -917,6 +956,14 @@ mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content 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 { moderationId :: Int64, moderatorMember :: GroupMember, diff --git a/src/Simplex/Chat/Migrations/M20230721_group_snd_item_statuses.hs b/src/Simplex/Chat/Migrations/M20230721_group_snd_item_statuses.hs new file mode 100644 index 0000000000..8453da88f5 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230721_group_snd_item_statuses.hs @@ -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; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 893d00d345..f925726436 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -496,6 +496,14 @@ CREATE TABLE chat_item_moderations( created_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( display_name, full_name @@ -687,3 +695,9 @@ CREATE INDEX idx_chat_item_moderations_group ON chat_item_moderations( item_member_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 +); diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index c8b58fa857..c3c62d52da 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -39,6 +39,7 @@ module Simplex.Chat.Store.Groups getGroupMemberById, getGroupMembers, getGroupMembersForExpiration, + getGroupCurrentMembersCount, deleteGroupConnectionsAndFiles, deleteGroupItemsAndMembers, deleteGroup, @@ -548,6 +549,20 @@ toContactMember :: User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember toContactMember User {userContactId} (memberRow :. 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 user groupId = getConnRec_ user >>= \case diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 29e6e2abc3..b185b3a972 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -44,6 +44,7 @@ module Simplex.Chat.Store.Messages createChatItemVersion, deleteDirectChatItem, markDirectChatItemDeleted, + updateGroupChatItemStatus, updateGroupChatItem, deleteGroupChatItem, updateGroupChatItemModerated, @@ -69,6 +70,7 @@ module Simplex.Chat.Store.Messages getGroupChatItem, getGroupChatItemBySharedMsgId, getGroupMemberCIBySharedMsgId, + getGroupChatItemByAgentMsgId, getGroupMemberChatItemLast, getDirectChatItemIdByText, getDirectChatItemIdByText', @@ -87,6 +89,11 @@ module Simplex.Chat.Store.Messages createCIModeration, getCIModeration, deleteCIModeration, + createGroupSndStatus, + getGroupSndStatus, + updateGroupSndStatus, + getGroupSndStatuses, + getGroupSndStatusCounts, ) where @@ -1325,6 +1332,16 @@ getDirectChatItemIdByText' db User {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 db user groupId ci newContent live msgId_ = do currentTs <- liftIO getCurrentTime @@ -1434,6 +1451,11 @@ getGroupMemberCIBySharedMsgId db user@User {userId} groupId memberId sharedMsgId (GCUserMember, userId, groupId, memberId, sharedMsgId) 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 User {userId, userContactId} groupId itemId = ExceptT $ do currentTs <- getCurrentTime @@ -1847,3 +1869,58 @@ deleteCIModeration db GroupInfo {groupId} itemMemberId (Just sharedMsgId) = db "DELETE FROM chat_item_moderations WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?" (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) diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index f1fd40d438..972f0718eb 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -74,6 +74,7 @@ import Simplex.Chat.Migrations.M20230608_deleted_contacts import Simplex.Chat.Migrations.M20230618_favorite_chats import Simplex.Chat.Migrations.M20230621_chat_item_moderations import Simplex.Chat.Migrations.M20230705_delivery_receipts +import Simplex.Chat.Migrations.M20230721_group_snd_item_statuses import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -147,7 +148,8 @@ schemaMigrations = ("20230608_deleted_contacts", m20230608_deleted_contacts, Just down_m20230608_deleted_contacts), ("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), - ("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 diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 608befb54d..ddbe665d71 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -30,6 +30,7 @@ module Simplex.Chat.Store.Profiles updateUserPrivacy, updateAllContactReceipts, updateUserContactReceipts, + updateUserGroupReceipts, updateUserProfile, setUserProfileContactLink, getUserContactProfiles, @@ -92,7 +93,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image, when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0" let showNtfs = True sendRcptsContacts = True - sendRcptsSmallGroups = False + sendRcptsSmallGroups = True DB.execute 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,?,?,?,?,?)" @@ -222,13 +223,21 @@ updateUserPrivacy db User {userId, showNtfs, viewPwdHash} = updateAllContactReceipts :: DB.Connection -> Bool -> IO () 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 User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do 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" +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 user p' | displayName == newName = do diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 6f368a774a..9e4d3c0e02 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -92,6 +92,7 @@ data StoreError | SEGroupLinkNotFound {groupInfo :: GroupInfo} | SEHostMemberIdNotFound {groupId :: Int64} | SEContactNotFoundByFileId {fileId :: FileTransferId} + | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId} deriving (Show, Exception, Generic) instance ToJSON StoreError where diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 33a6bd0456..9d9791f1a9 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -782,7 +782,10 @@ memberActive m = case memberStatus m of GSMemCreator -> True memberCurrent :: GroupMember -> Bool -memberCurrent m = case memberStatus m of +memberCurrent = memberCurrent' . memberStatus + +memberCurrent' :: GroupMemberStatus -> Bool +memberCurrent' = \case GSMemRemoved -> False GSMemLeft -> False GSMemGroupDeleted -> False diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 0b7db12f94..03b7956274 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -465,12 +465,21 @@ localTs tz ts = do viewChatItemStatusUpdated :: AChatItem -> CurrentTime -> TimeZone -> Bool -> Bool -> [StyledString] viewChatItemStatusUpdated (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) ts tz testView showReceipts = 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 then prependFirst (viewDeliveryReceipt rcptStatus <> " ") $ viewChatItem chat item False ts tz else [] _ -> [] +viewDeliveryReceiptPartial :: MsgReceiptStatus -> StyledString +viewDeliveryReceiptPartial = \case + MROk -> "%" + MRBadMsgHash -> ttyError' "%!" + viewDeliveryReceipt :: MsgReceiptStatus -> StyledString viewDeliveryReceipt = \case MROk -> "⩗" diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 7d4774500f..7b93b97589 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -2213,13 +2213,13 @@ testConfigureDeliveryReceipts tmp = noReceipt cath alice "4" -- configure receipts for user contacts - alice ##> "/_set receipts 1 on" + alice ##> "/_set receipts contacts 1 on" alice <## "ok" receipt bob alice "5" receipt cath alice "6" -- configure receipts for user contacts (terminal api) - alice ##> "/set receipts off" + alice ##> "/set receipts contacts off" alice <## "ok" noReceipt bob alice "7" noReceipt cath alice "8" @@ -2231,18 +2231,18 @@ testConfigureDeliveryReceipts tmp = noReceipt cath alice "10" -- configure receipts for user contacts (don't clear overrides) - alice ##> "/_set receipts 1 off" + alice ##> "/_set receipts contacts 1 off" alice <## "ok" receipt bob alice "11" noReceipt cath alice "12" - alice ##> "/_set receipts 1 off clear_overrides=off" + alice ##> "/_set receipts contacts 1 off clear_overrides=off" alice <## "ok" receipt bob alice "13" noReceipt cath alice "14" -- configure receipts for user contacts (clear overrides) - alice ##> "/set receipts off clear_overrides=on" + alice ##> "/set receipts contacts off clear_overrides=on" alice <## "ok" noReceipt bob alice "15" noReceipt cath alice "16" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index bb556062cf..6e1e761208 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -59,8 +59,11 @@ chatGroupTests = do it "show message decryption error" testGroupMsgDecryptError it "should report ratchet de-synchronization, synchronize ratchets" testGroupSyncRatchet it "synchronize ratchets, reset connection code" testGroupSyncRatchetCodeReset - describe "message reactions" $ do + describe "group message reactions" $ do 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 = versionTestMatrix3 runTestGroup @@ -198,6 +201,7 @@ testGroupShared alice bob cath checkMessages = do 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")] -- test clearing chat + threadDelay 1000000 alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY") alice #$> ("/_get chat #1 count=100", chat, []) bob #$> ("/clear #team", id, "#team: all messages are removed locally ONLY") @@ -976,6 +980,7 @@ testGroupMessageDelete = (bob <# "#team alice> hello!") (cath <# "#team alice> hello!") + threadDelay 1000000 msgItemId1 <- lastItemId alice alice #$> ("/_delete item #1 " <> msgItemId1 <> " internal", id, "message deleted") @@ -2197,47 +2202,46 @@ testGroupLinkLeaveDelete = testGroupMsgDecryptError :: HasCallStack => FilePath -> IO () testGroupMsgDecryptError tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do - withNewTestChat tmp "cath" cathProfile $ \cath -> do - withNewTestChat tmp "bob" bobProfile $ \bob -> do - createGroup3 "team" alice bob cath - alice #> "#team hi" - [bob, cath] *<# "#team alice> hi" - bob #> "#team hey" - [alice, cath] *<# "#team bob> hey" - setupDesynchronizedRatchet tmp alice cath - withTestChat tmp "bob" $ \bob -> do - bob <## "2 contacts connected (use /cs for the list)" - bob <## "#team: connected to server(s)" - alice #> "#team hello again" - bob <# "#team alice> skipped message ID 8..10" - [bob, cath] *<# "#team alice> hello again" - bob #> "#team received!" - alice <# "#team bob> received!" - cath <# "#team bob> received!" + withNewTestChat tmp "bob" bobProfile $ \bob -> do + createGroup2 "team" alice bob + alice #> "#team hi" + bob <# "#team alice> hi" + bob #> "#team hey" + alice <# "#team bob> hey" + setupDesynchronizedRatchet tmp alice + withTestChat tmp "bob" $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + bob <## "#team: connected to server(s)" + alice #> "#team hello again" + bob <# "#team alice> skipped message ID 10..12" + bob <# "#team alice> hello again" + bob #> "#team received!" + alice <# "#team bob> received!" -setupDesynchronizedRatchet :: HasCallStack => FilePath -> TestCC -> TestCC -> IO () -setupDesynchronizedRatchet tmp alice cath = do +setupDesynchronizedRatchet :: HasCallStack => FilePath -> TestCC -> IO () +setupDesynchronizedRatchet tmp alice = do copyDb "bob" "bob_old" 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)" - alice #> "#team hello" - [bob, cath] *<# "#team alice> hello" - bob #> "#team hello too" - [alice, cath] *<# "#team bob> hello too" + alice #> "#team 1" + bob <# "#team alice> 1" + bob #> "#team 2" + alice <# "#team bob> 2" + alice #> "#team 3" + bob <# "#team alice> 3" + bob #> "#team 4" + alice <# "#team bob> 4" 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 ##> "/sync #team alice" bob <## "error: command is prohibited" alice #> "#team 1" bob <## "#team alice: decryption error (connection out of sync), synchronization required" bob <## "use /sync #team alice to synchronize" - cath <# "#team alice> 1" alice #> "#team 2" - cath <# "#team alice> 2" alice #> "#team 3" - cath <# "#team alice> 3" (bob "/tail #team 1" bob <# "#team alice> decryption error, possibly due to the device change (header, 3 messages)" @@ -2249,99 +2253,82 @@ setupDesynchronizedRatchet tmp alice cath = do testGroupSyncRatchet :: HasCallStack => FilePath -> IO () testGroupSyncRatchet tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do - withNewTestChat tmp "cath" cathProfile $ \cath -> do - withNewTestChat tmp "bob" bobProfile $ \bob -> do - createGroup3 "team" alice bob cath - alice #> "#team hi" - [bob, cath] *<# "#team alice> hi" - bob #> "#team hey" - [alice, cath] *<# "#team bob> hey" - setupDesynchronizedRatchet tmp alice cath - withTestChat tmp "bob_old" $ \bob -> do - bob <## "2 contacts connected (use /cs for the list)" - bob <## "#team: connected to server(s)" - -- cath and bob are not fully de-synchronized - bob `send` "#team 1" - bob <## "error: command is prohibited" -- silence? - bob <# "#team 1" - (alice "#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 - bob ##> "/sync #team alice" - bob <## "connection synchronization started" - alice <## "#team bob: connection synchronization agreed" - bob <## "#team alice: connection synchronization agreed" - alice <## "#team bob: connection synchronized" - bob <## "#team alice: connection synchronized" + withNewTestChat tmp "bob" bobProfile $ \bob -> do + createGroup2 "team" alice bob + alice #> "#team hi" + bob <# "#team alice> hi" + bob #> "#team hey" + alice <# "#team bob> hey" + setupDesynchronizedRatchet tmp alice + withTestChat tmp "bob_old" $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + bob <## "#team: connected to server(s)" + bob `send` "#team 1" + bob <## "error: command is prohibited" -- silence? + bob <# "#team 1" + (alice "/sync #team alice" + bob <## "connection synchronization started" + alice <## "#team bob: connection synchronization agreed" + bob <## "#team alice: connection synchronization agreed" + alice <## "#team bob: connection synchronized" + bob <## "#team alice: connection synchronized" - bob #$> ("/_get chat #1 count=3", chat, [(1, "connection synchronization started for alice"), (0, "connection synchronization agreed"), (0, "connection synchronized")]) - alice #$> ("/_get chat #1 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")]) + bob #$> ("/_get chat #1 count=3", chat, [(1, "connection synchronization started for alice"), (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" - [bob, cath] *<# "#team alice> hello again" - bob #> "#team received!" - alice <# "#team bob> received!" - cath <# "#team bob> received!" + alice #> "#team hello again" + bob <# "#team alice> hello again" + bob #> "#team received!" + alice <# "#team bob> received!" testGroupSyncRatchetCodeReset :: HasCallStack => FilePath -> IO () testGroupSyncRatchetCodeReset tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do - withNewTestChat tmp "cath" cathProfile $ \cath -> do - withNewTestChat tmp "bob" bobProfile $ \bob -> do - createGroup3 "team" alice bob cath - alice #> "#team hi" - [bob, cath] *<# "#team alice> hi" - bob #> "#team hey" - [alice, cath] *<# "#team bob> hey" - -- connection not verified - bob ##> "/i #team alice" - aliceInfo bob - bob <## "connection not verified, use /code command to see security code" - -- verify connection - alice ##> "/code #team bob" - bCode <- getTermLine alice - bob ##> ("/verify #team alice " <> bCode) - bob <## "connection verified" - -- connection verified - bob ##> "/i #team alice" - aliceInfo bob - bob <## "connection verified" - setupDesynchronizedRatchet tmp alice cath - withTestChat tmp "bob_old" $ \bob -> do - bob <## "2 contacts connected (use /cs for the list)" - bob <## "#team: connected to server(s)" - bob ##> "/sync #team alice" - bob <## "connection synchronization started" - alice <## "#team bob: connection synchronization agreed" - bob <## "#team alice: connection synchronization agreed" - bob <## "#team alice: security code changed" - alice <## "#team bob: connection synchronized" - bob <## "#team alice: connection synchronized" + withNewTestChat tmp "bob" bobProfile $ \bob -> do + createGroup2 "team" alice bob + alice #> "#team hi" + bob <# "#team alice> hi" + bob #> "#team hey" + alice <# "#team bob> hey" + -- connection not verified + bob ##> "/i #team alice" + aliceInfo bob + bob <## "connection not verified, use /code command to see security code" + -- verify connection + alice ##> "/code #team bob" + bCode <- getTermLine alice + bob ##> ("/verify #team alice " <> bCode) + bob <## "connection verified" + -- connection verified + bob ##> "/i #team alice" + aliceInfo bob + bob <## "connection verified" + setupDesynchronizedRatchet tmp alice + withTestChat tmp "bob_old" $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + bob <## "#team: connected to server(s)" + bob ##> "/sync #team alice" + bob <## "connection synchronization started" + alice <## "#team bob: connection synchronization agreed" + bob <## "#team alice: connection synchronization agreed" + bob <## "#team alice: security code changed" + alice <## "#team bob: connection synchronized" + bob <## "#team alice: connection synchronized" - bob #$> ("/_get chat #1 count=4", chat, [(1, "connection synchronization started for alice"), (0, "connection synchronization agreed"), (0, "security code changed"), (0, "connection synchronized")]) - alice #$> ("/_get chat #1 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")]) + bob #$> ("/_get chat #1 count=4", chat, [(1, "connection synchronization started for alice"), (0, "connection synchronization agreed"), (0, "security code changed"), (0, "connection synchronized")]) + alice #$> ("/_get chat #1 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")]) - -- connection not verified - bob ##> "/i #team alice" - aliceInfo bob - bob <## "connection not verified, use /code command to see security code" + -- connection not verified + bob ##> "/i #team alice" + aliceInfo bob + bob <## "connection not verified, use /code command to see security code" - alice #> "#team hello again" - [bob, cath] *<# "#team alice> hello again" - bob #> "#team received!" - alice <# "#team bob> received!" - (cath "#team hello again" + bob <# "#team alice> hello again" + bob #> "#team received!" + alice <# "#team bob> received!" where aliceInfo :: HasCallStack => TestCC -> IO () aliceInfo bob = do @@ -2418,3 +2405,182 @@ testSetGroupMessageReactions = cath ##> "/tail #team 1" cath <# "#team alice> hi" 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 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 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 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 getTermLine cc) `shouldReturn` "i " <> line (⩗) :: HasCallStack => TestCC -> String -> Expectation cc ⩗ line = (dropTime . dropReceipt <$> getTermLine cc) `shouldReturn` line +(%) :: HasCallStack => TestCC -> String -> Expectation +cc % line = (dropTime . dropPartialReceipt <$> getTermLine cc) `shouldReturn` line + ( TestCC -> Expectation ( Just text _ -> 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 cc = do cc <## "pass this invitation link to your contact (via another channel):" diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 220c8a0d3e..31c0803547 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -27,16 +27,16 @@ noActiveUser = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"e activeUserExists :: String #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 -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 activeUser :: String #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 -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 chatStarted :: String @@ -75,7 +75,7 @@ pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\"," <> userJSON <> #endif 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 #if defined(darwin_HOST_OS) && defined(swiftJSON)