diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs index 3aca687ec5..7284b72d62 100644 --- a/src/Simplex/Chat/Bot.hs +++ b/src/Simplex/Chat/Bot.hs @@ -86,14 +86,14 @@ sendComposedMessages cc sendRef = sendComposedMessages_ cc sendRef . L.map (Noth sendComposedMessages_ :: ChatController -> SendRef -> NonEmpty (Maybe ChatItemId, MsgContent) -> IO () sendComposedMessages_ cc sendRef qmcs = do let cms = L.map (\(qiId, mc) -> ComposedMessage {fileSource = Nothing, quotedItemId = qiId, msgContent = mc, mentions = M.empty}) qmcs - sendChatCmd cc (APISendMessages sendRef False Nothing cms) >>= \case + sendChatCmd cc (APISendMessages sendRef False Nothing False cms) >>= \case Right (CRNewChatItems {}) -> printLog cc CLLInfo $ "sent " <> show (length cms) <> " messages to " <> show sendRef r -> putStrLn $ "unexpected send message response: " <> show r sendComposedMessageFile :: ChatController -> SendRef -> Maybe ChatItemId -> MsgContent -> CryptoFile -> IO () sendComposedMessageFile cc sendRef qiId mc file = do let cm = ComposedMessage {fileSource = Just file, quotedItemId = qiId, msgContent = mc, mentions = M.empty} - sendChatCmd cc (APISendMessages sendRef False Nothing (cm :| [])) >>= \case + sendChatCmd cc (APISendMessages sendRef False Nothing False (cm :| [])) >>= \case Right (CRNewChatItems {}) -> printLog cc CLLInfo $ "sent file message to " <> show sendRef r -> putStrLn $ "unexpected send message response: " <> show r diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 50b862758b..428e7c066e 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -379,7 +379,7 @@ data ChatCommand | APIGetChatContentTypes ChatRef | APIGetChatItems {chatPagination :: ChatPagination, search :: Maybe Text} | APIGetChatItemInfo {chatRef :: ChatRef, chatItemId :: ChatItemId} - | APISendMessages {sendRef :: SendRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage} + | APISendMessages {sendRef :: SendRef, liveMessage :: Bool, ttl :: Maybe Int, signMessages :: Bool, composedMessages :: NonEmpty ComposedMessage} | APICreateChatTag ChatTagData | APISetChatTags ChatRef (Maybe (NonEmpty ChatTagId)) | APIDeleteChatTag ChatTagId diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 772e10dfb0..b6d9d4bbf2 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -653,7 +653,7 @@ processChatCommand cxt nm = \case -- TODO [knocking] getAChatItem doesn't differentiate how to read based on scope - it should, instead of using group filter Just <$> withFastStore (\db -> getAChatItem db cxt user (ChatRef CTGroup gId Nothing) fwdItemId) _ -> pure Nothing - APISendMessages sendRef live itemTTL cms -> withUser $ \user -> mapM_ assertAllowedContent' cms >> case sendRef of + APISendMessages sendRef live itemTTL sign cms -> withUser $ \user -> mapM_ assertAllowedContent' cms >> case sendRef of SRDirect chatId -> do mapM_ assertNoMentions cms withContactLock "sendMessage" chatId $ @@ -666,7 +666,7 @@ processChatCommand cxt nm = \case (gInfo, cmrs) <- withFastStore $ \db -> do g <- getGroupInfo db cxt user chatId (g,) <$> mapM (composedMessageReqMentions db user g) cms - sendGroupContentMessages user gInfo gsScope asGroup live itemTTL cmrs + sendGroupContentMessages user gInfo gsScope asGroup live itemTTL sign cmrs APICreateChatTag (ChatTagData emoji text) -> withUser $ \user -> withFastStore' $ \db -> do _ <- createChatTag db user emoji text CRChatTags user <$> getUserChatTags db user @@ -697,7 +697,7 @@ processChatCommand cxt nm = \case gInfo <- withFastStore $ \db -> getGroupInfo db cxt user gId let mc = MCReport reportText reportReason cm = ComposedMessage {fileSource = Nothing, quotedItemId = Just reportedItemId, msgContent = mc, mentions = M.empty} - sendGroupContentMessages user gInfo (Just $ GCSMemberSupport Nothing) False False Nothing [composedMessageReq cm] + sendGroupContentMessages user gInfo (Just $ GCSMemberSupport Nothing) False False Nothing False [composedMessageReq cm] ReportMessage {groupName, contactName_, reportReason, reportedMessage} -> withUser $ \user -> do gId <- withFastStore $ \db -> getGroupIdByName db user groupName reportedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user gId contactName_ reportedMessage @@ -750,7 +750,7 @@ processChatCommand cxt nm = \case let msgScope = toMsgScope gInfo <$> chatScopeInfo mentions' = M.map (\CIMention {memberId} -> MsgMention {memberId}) ciMentions event = XMsgUpdate itemSharedMId mc mentions' (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive) msgScope (Just showGroupAsSender) - SndMessage {msgId} <- sendGroupMessage user gInfo scope recipients event + SndMessage {msgId} <- sendGroupMessage user gInfo scope recipients False event ci' <- withFastStore' $ \db -> do currentTs <- liftIO getCurrentTime when changed $ @@ -811,14 +811,14 @@ processChatCommand cxt nm = \case assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier let msgIds = itemsMsgIds items events = L.nonEmpty $ map (\msgId -> XMsgDel msgId Nothing (toMsgScope gInfo <$> chatScopeInfo) False) msgIds - mapM_ (sendGroupMessages user gInfo Nothing False recipients) events + mapM_ (sendGroupMessages user gInfo Nothing False recipients False) events delGroupChatItems user gInfo chatScopeInfo items False CIDMHistory -> do unless (publicGroupEditor gInfo (membership gInfo)) $ throwChatError CEInvalidChatItemDelete recipients <- getGroupRecipients cxt user gInfo chatScopeInfo groupKnockingVersion let msgIds = itemsMsgIds items events = L.nonEmpty $ map (\msgId -> XMsgDel msgId Nothing (toMsgScope gInfo <$> chatScopeInfo) True) msgIds - mapM_ (sendGroupMessages user gInfo Nothing False recipients) events + mapM_ (sendGroupMessages user gInfo Nothing False recipients False) events delGroupChatItems user gInfo chatScopeInfo items False pure $ CRChatItemsDeleted user deletions True False CTLocal -> do @@ -907,7 +907,7 @@ processChatCommand cxt nm = \case let itemMemberId = memberId' <$> chatItemMember g ci rs <- withFastStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True checkReactionAllowed rs - SndMessage {msgId} <- sendGroupMessage user g scope recipients (XMsgReact itemSharedMId itemMemberId (toMsgScope g <$> chatScopeInfo) reaction add) + SndMessage {msgId} <- sendGroupMessage user g scope recipients False (XMsgReact itemSharedMId itemMemberId (toMsgScope g <$> chatScopeInfo) reaction add) createdAt <- liftIO getCurrentTime reactions <- withFastStore' $ \db -> do setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt @@ -993,7 +993,7 @@ processChatCommand cxt nm = \case Just cmrs' -> withGroupLock "forwardChatItem, to group" toChatId $ do gInfo <- withFastStore $ \db -> getGroupInfo db cxt user toChatId - sendGroupContentMessages user gInfo toScope sendAsGroup False itemTTL cmrs' + sendGroupContentMessages user gInfo toScope sendAsGroup False itemTTL False cmrs' Nothing -> pure $ CRNewChatItems user [] CTLocal -> do cmrs <- prepareForward user @@ -2428,7 +2428,7 @@ processChatCommand cxt nm = \case _ -> throwCmdError "unsupported share target" processChatCommand cxt nm (APIShareChatMsgContent (ChatRef CTGroup groupId Nothing) sendRef) >>= \case CRChatMsgContent _ mc -> - processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc] + processChatCommand cxt nm $ APISendMessages sendRef False Nothing False [composedMessage Nothing mc] r -> pure r SendMessage sendName msg -> withUser $ \user -> do let mc = MCText msg @@ -2437,7 +2437,7 @@ processChatCommand cxt nm = \case withFastStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case Right ctId -> do let sendRef = SRDirect ctId - processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc] + processChatCommand cxt nm $ APISendMessages sendRef False Nothing False [composedMessage Nothing mc] Left _ -> withFastStore' (\db -> runExceptT $ getActiveMembersByName db cxt user name) >>= \case Right [(gInfo, member)] -> do @@ -2457,7 +2457,7 @@ processChatCommand cxt nm = \case GCSMemberSupport <$> mapM (getGroupMemberIdByName db user gId) mName_ (gInfo, cScope_,) <$> liftIO (getMessageMentions db user gId msg) let sendRef = SRGroup (groupId' gInfo) cScope_ (sendAsGroup' gInfo cScope_) - processChatCommand cxt nm $ APISendMessages sendRef False Nothing [ComposedMessage Nothing Nothing mc mentions] + processChatCommand cxt nm $ APISendMessages sendRef False Nothing False [ComposedMessage Nothing Nothing mc mentions] SNLocal -> do folderId <- withFastStore (`getUserNoteFolderId` user) processChatCommand cxt nm $ APICreateChatItems folderId [composedMessage Nothing mc] @@ -2477,7 +2477,7 @@ processChatCommand cxt nm = \case cr -> pure cr Just ctId -> do let sendRef = SRDirect ctId - processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage Nothing mc] + processChatCommand cxt nm $ APISendMessages sendRef False Nothing False [composedMessage Nothing mc] AcceptMemberContact cName -> withUser $ \user -> do contactId <- withFastStore $ \db -> getContactIdByName db user cName processChatCommand cxt nm $ APIAcceptMemberContact contactId @@ -2485,7 +2485,7 @@ processChatCommand cxt nm = \case (chatRef, mentions) <- getChatRefAndMentions user chatName msg withSendRef user chatRef $ \sendRef -> do let mc = MCText msg - processChatCommand cxt nm $ APISendMessages sendRef True Nothing [ComposedMessage Nothing Nothing mc mentions] + processChatCommand cxt nm $ APISendMessages sendRef True Nothing False [ComposedMessage Nothing Nothing mc mentions] SendMessageBroadcast mc -> withUser $ \user -> do contacts <- withFastStore' $ \db -> getUserContacts db cxt user withChatLock "sendMessageBroadcast" $ do @@ -2530,7 +2530,7 @@ processChatCommand cxt nm = \case contactId <- withFastStore $ \db -> getContactIdByName db user cName quotedItemId <- withFastStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg let mc = MCText msg - processChatCommand cxt nm $ APISendMessages (SRDirect contactId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc M.empty] + processChatCommand cxt nm $ APISendMessages (SRDirect contactId) False Nothing False [ComposedMessage Nothing (Just quotedItemId) mc M.empty] DeleteMessage chatName deletedMsg -> withUser $ \user -> do chatRef <- getChatRef user chatName deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg @@ -2755,7 +2755,7 @@ processChatCommand cxt nm = \case modMs <- withFastStore' $ \db -> getGroupModerators db cxt user gInfo let rcpModMs' = filter memberCurrent modMs msg = XGrpLinkAcpt GAAccepted role (memberId' m) - void $ sendGroupMessage user gInfo scope ([m] <> rcpModMs') msg + void $ sendGroupMessage user gInfo scope ([m] <> rcpModMs') False msg when (maxVersion (memberChatVRange m) < groupKnockingVersion) $ forM_ (memberConn m) $ \mConn -> do let msg2 = XMsgNew $ mcSimple (MCText acceptedToGroupMessage) @@ -2857,7 +2857,7 @@ processChatCommand cxt nm = \case let mKey m = if isJust rosterVer then MemberKey <$> memberPubKey m else Nothing events = L.map (\m@GroupMember {memberId} -> XGrpMemRole memberId newRole (mKey m) rosterVer) memsToChange' recipients = filter memberCurrent members - (msgs_, _gsr) <- sendGroupMessages user gInfo Nothing False recipients events + (msgs_, _gsr) <- sendGroupMessages user gInfo Nothing False recipients False events let signed = any (either (const False) (isJust . signedMsg_)) msgs_ itemsData = zipWith (fmap . sndItemData) memsToChange (L.toList msgs_) cis_ <- saveSndChatItems user (CDGroupSnd gInfo Nothing) False itemsData Nothing False @@ -2905,7 +2905,7 @@ processChatCommand cxt nm = \case let mrs = if blockFlag then MRSBlocked else MRSUnrestricted events = L.map (\GroupMember {memberId} -> XGrpMemRestrict memberId MemberRestrictions {restriction = mrs}) blockMems' recipients = filter memberCurrent remainingMems - (msgs_, _gsr) <- sendGroupMessages_ user gInfo recipients events + (msgs_, _gsr) <- sendGroupMessages_ user gInfo recipients False events let msgSigned = any (either (const False) (isJust . signedMsg_)) msgs_ itemsData = zipWith (fmap . sndItemData) blockMems (L.toList msgs_) cis_ <- saveSndChatItems user (CDGroupSnd gInfo Nothing) False itemsData Nothing False @@ -2998,7 +2998,7 @@ processChatCommand cxt nm = \case Just memsToDelete' -> do let chatScope = toChatScope <$> chatScopeInfo events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId withMessages rosterVer) memsToDelete' - (msgs_, _gsr) <- sendGroupMessages user gInfo chatScope False recipients events + (msgs_, _gsr) <- sendGroupMessages user gInfo chatScope False recipients False events let signed = any (either (const False) (isJust . signedMsg_)) msgs_ itemsData_ = zipWith (fmap . sndItemData) memsToDelete (L.toList msgs_) skipUnwantedItem = \case @@ -3059,7 +3059,7 @@ processChatCommand cxt nm = \case -- Relay leaving channel: create delivery job for cursor-based sending and async connection cleanup. leaveChannelRelay gInfo = do msg@SndMessage {msgBody, signedMsg_} <- - liftEither . runIdentity =<< lift (createSndMessages $ Identity (GroupId groupId, groupMsgSigning gInfo XGrpLeave, XGrpLeave)) + liftEither . runIdentity =<< lift (createSndMessages $ Identity (GroupId groupId, groupMsgSigning False gInfo XGrpLeave, XGrpLeave)) let body = encodeBatchElement signedMsg_ msgBody withFastStore' $ \db -> do deleteGroupDeliveryTasks db gInfo @@ -3285,7 +3285,7 @@ processChatCommand cxt nm = \case qiId <- getGroupChatItemIdByText db user gId cName quotedMsg (gInfo, qiId,) <$> liftIO (getMessageMentions db user gId msg) let mc = MCText msg - processChatCommand cxt nm $ APISendMessages (SRGroup (groupId' gInfo) Nothing (sendAsGroup' gInfo Nothing)) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc mentions] + processChatCommand cxt nm $ APISendMessages (SRGroup (groupId' gInfo) Nothing (sendAsGroup' gInfo Nothing)) False Nothing False [ComposedMessage Nothing (Just quotedItemId) mc mentions] ClearNoteFolder -> withUser $ \user -> do folderId <- withFastStore (`getUserNoteFolderId` user) processChatCommand cxt nm $ APIClearChat (ChatRef CTLocal folderId Nothing) @@ -3326,7 +3326,7 @@ processChatCommand cxt nm = \case chatRef <- getChatRef user chatName case chatRef of ChatRef CTLocal folderId _ -> processChatCommand cxt nm $ APICreateChatItems folderId [composedMessage (Just f) (MCFile "")] - _ -> withSendRef user chatRef $ \sendRef -> processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCFile "")] + _ -> withSendRef user chatRef $ \sendRef -> processChatCommand cxt nm $ APISendMessages sendRef False Nothing False [composedMessage (Just f) (MCFile "")] SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do chatRef <- getChatRef user chatName withSendRef user chatRef $ \sendRef -> do @@ -3335,7 +3335,7 @@ processChatCommand cxt nm = \case fileSize <- getFileSize filePath unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath} -- TODO include file description for preview - processChatCommand cxt nm $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCImage "" fixedImagePreview)] + processChatCommand cxt nm $ APISendMessages sendRef False Nothing False [composedMessage (Just f) (MCImage "" fixedImagePreview)] ForwardFile chatName fileId -> forwardFile chatName fileId SendFile ForwardImage chatName fileId -> forwardFile chatName fileId SendImage SendFileDescription _chatName _f -> throwCmdError "TODO" @@ -3374,7 +3374,7 @@ processChatCommand cxt nm = \case (gInfo, sharedMsgId) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user groupId <*> getSharedMsgIdByFileId db userId fileId chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope recipients <- getGroupRecipients cxt user gInfo chatScopeInfo groupKnockingVersion - void . sendGroupMessage user gInfo scope recipients $ XFileCancel sharedMsgId + void . sendGroupMessage user gInfo scope recipients False $ XFileCancel sharedMsgId pure $ CRSndFileCancelled user (Just aci) ftm fts (Just _, _) -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" where @@ -3920,14 +3920,14 @@ processChatCommand cxt nm = \case withStore $ \db -> getGroupMemberByMemberId db cxt user gInfo' businessId let p'' = p' {displayName, fullName, shortDescr, image} :: GroupProfile recipients = filter memberCurrentOrPending oldMs - void $ sendGroupMessage user gInfo' Nothing recipients (XGrpInfo p'') + void $ sendGroupMessage user gInfo' Nothing recipients False (XGrpInfo p'') let ps' = fromMaybe defaultBusinessGroupPrefs $ groupPreferences p' recipients = filter memberCurrentOrPending newMs - sendGroupMessage user gInfo' Nothing recipients $ XGrpPrefs ps' + sendGroupMessage user gInfo' Nothing recipients False $ XGrpPrefs ps' Nothing -> do void $ setGroupLinkData' nm user gInfo' recipients <- getRecipients - sendGroupMessage user gInfo' Nothing recipients (XGrpInfo p') + sendGroupMessage user gInfo' Nothing recipients False (XGrpInfo p') where getRecipients | useRelays' gInfo' = withFastStore' $ \db -> getGroupRelayMembers db cxt user gInfo' @@ -3957,7 +3957,7 @@ processChatCommand cxt nm = \case assertUserGroupRole gInfo GRModerator let msgMemIds = itemsMsgMemIds gInfo items events = L.nonEmpty $ map (\(msgId, memId) -> XMsgDel msgId memId (toMsgScope gInfo <$> chatScopeInfo) False) msgMemIds - mapM_ (sendGroupMessages_ user gInfo ms) events + mapM_ (sendGroupMessages_ user gInfo ms False) events delGroupChatItems user gInfo chatScopeInfo items True where assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM () @@ -4550,17 +4550,17 @@ processChatCommand cxt nm = \case quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True) quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False) quoteData _ = throwError SEInvalidQuote - sendGroupContentMessages :: User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse - sendGroupContentMessages user gInfo scope showGroupAsSender live itemTTL cmrs = do + sendGroupContentMessages :: User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> Bool -> Maybe Int -> Bool -> NonEmpty ComposedMessageReq -> CM ChatResponse + sendGroupContentMessages user gInfo scope showGroupAsSender live itemTTL sign cmrs = do assertMultiSendable live cmrs chatScopeInfo <- mapM (getChatScopeInfo cxt user) scope recipients <- getGroupRecipients cxt user gInfo chatScopeInfo modsCompatVersion - sendGroupContentMessages_ user gInfo scope showGroupAsSender chatScopeInfo recipients live itemTTL cmrs + sendGroupContentMessages_ user gInfo scope showGroupAsSender chatScopeInfo recipients live itemTTL sign cmrs where hasReport = any (\(ComposedMessage {msgContent}, _, _, _) -> isReport msgContent) cmrs modsCompatVersion = if hasReport then contentReportsVersion else groupKnockingVersion - sendGroupContentMessages_ :: User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> Maybe GroupChatScopeInfo -> [GroupMember] -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse - sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} scope showGroupAsSender chatScopeInfo recipients live itemTTL cmrs = do + sendGroupContentMessages_ :: User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> Maybe GroupChatScopeInfo -> [GroupMember] -> Bool -> Maybe Int -> Bool -> NonEmpty ComposedMessageReq -> CM ChatResponse + sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} scope showGroupAsSender chatScopeInfo recipients live itemTTL sign cmrs = do forM_ allowedRole $ assertUserGroupRole gInfo assertGroupContentAllowed processComposedMessages @@ -4589,7 +4589,7 @@ processChatCommand cxt nm = \case (fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers (length recipients) timed_ <- sndGroupCITimed live gInfo itemTTL (chatMsgEvents, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_ - (msgs_, gsr) <- sendGroupMessages user gInfo Nothing showGroupAsSender recipients chatMsgEvents + (msgs_, gsr) <- sendGroupMessages user gInfo Nothing showGroupAsSender recipients sign chatMsgEvents let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) (L.toList msgs_) cis_ <- saveSndChatItems user (CDGroupSnd gInfo chatScopeInfo) showGroupAsSender itemsData timed_ live when (length cis_ /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch" @@ -5259,7 +5259,7 @@ chatCommandP = "/_get content types " *> (APIGetChatContentTypes <$> chatRefP), "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> textP)), "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal), - "/_send " *> (APISendMessages <$> sendRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)), + "/_send " *> (APISendMessages <$> sendRefP <*> liveMessageP <*> sendMessageTTLP <*> pure False <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)), "/_create tag " *> (APICreateChatTag <$> jsonP), "/_tags " *> (APISetChatTags <$> chatRefP <*> optional _strP), "/_delete tag " *> (APIDeleteChatTag <$> A.decimal), diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 62ce525cbd..d43e4ae091 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -2132,16 +2132,19 @@ createSndMessages idsEvents = do encodeMessage sharedMsgId = encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr, msgId = Just sharedMsgId, chatMsgEvent = evnt} -groupMsgSigning :: GroupInfo -> ChatMsgEvent e -> Maybe MsgSigning -groupMsgSigning gInfo@GroupInfo {membership = GroupMember {memberId}, groupKeys = Just GroupKeys {publicGroupId, memberPrivKey}} evt - | useRelays' gInfo && requiresSignature (toCMEventTag evt) = +groupMsgSigning :: Bool -> GroupInfo -> ChatMsgEvent e -> Maybe MsgSigning +groupMsgSigning sign gInfo@GroupInfo {membership = GroupMember {memberId}, groupKeys = Just GroupKeys {publicGroupId, memberPrivKey}} evt + | useRelays' gInfo && shouldSign = Just $ MsgSigning CBGroup (smpEncode (publicGroupId, memberId)) KRMember memberPrivKey -groupMsgSigning _ _ = Nothing + where + tag = toCMEventTag evt + shouldSign = requiresSignature tag || (sign && signableContent tag) +groupMsgSigning _ _ _ = Nothing sendGroupMemberMessages :: forall e. MsgEncodingI e => User -> GroupInfo -> Connection -> NonEmpty (ChatMsgEvent e) -> CM () sendGroupMemberMessages user gInfo@GroupInfo {groupId} conn events = do when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) - let idsEvts = L.map (\evt -> (GroupId groupId, groupMsgSigning gInfo evt, evt)) events + let idsEvts = L.map (\evt -> (GroupId groupId, groupMsgSigning False gInfo evt, evt)) events mode = if useRelays' gInfo then BMBinary else BMJson (errs, msgs) <- lift $ partitionEithers . L.toList <$> createSndMessages idsEvts unless (null errs) $ toView $ CEvtChatErrors errs @@ -2277,15 +2280,15 @@ deliverMessagesB msgReqs = do where updatePQ = updateConnPQSndEnabled db connId pqSndEnabled' -sendGroupMessage :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage -sendGroupMessage user gInfo gcScope members chatMsgEvent = do - sendGroupMessages user gInfo gcScope False members (chatMsgEvent :| []) >>= \case +sendGroupMessage :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> [GroupMember] -> Bool -> ChatMsgEvent e -> CM SndMessage +sendGroupMessage user gInfo gcScope members sign chatMsgEvent = do + sendGroupMessages user gInfo gcScope False members sign (chatMsgEvent :| []) >>= \case ((Right msg) :| [], _) -> pure msg _ -> throwChatError $ CEInternalError "sendGroupMessage: expected 1 message" sendGroupMessage' :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage sendGroupMessage' user gInfo members chatMsgEvent = - sendGroupMessages_ user gInfo members (chatMsgEvent :| []) >>= \case + sendGroupMessages_ user gInfo members False (chatMsgEvent :| []) >>= \case ((Right msg) :| [], _) -> pure msg _ -> throwChatError $ CEInternalError "sendGroupMessage': expected 1 message" @@ -2366,12 +2369,12 @@ sendRelayCapIfNeeded user gInfo = do void $ sendGroupMessage' user gInfo capableOwners (XGrpRelayCap RelayCapabilities {webDomain = currentWebDomain}) withStore' $ \db -> updateRelaySentWebDomain db gInfo currentWebDomain -sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) -sendGroupMessages user gInfo scope asGroup members events = do +sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> [GroupMember] -> Bool -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) +sendGroupMessages user gInfo scope asGroup members sign events = do -- TODO [knocking] send current profile to pending member after approval? when shouldSendProfileUpdate $ sendProfileUpdate `catchAllErrors` eToView - sendGroupMessages_ user gInfo members events + sendGroupMessages_ user gInfo members sign events where User {profile = p, userMemberProfileUpdatedAt} = user GroupInfo {userMemberProfileSentAt} = gInfo @@ -2398,9 +2401,12 @@ data GroupSndResult = GroupSndResult forwarded :: [GroupMember] } -sendGroupMessages_ :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) -sendGroupMessages_ _user gInfo@GroupInfo {groupId} recipientMembers events = do - let idsEvts = L.map (\evt -> (GroupId groupId, groupMsgSigning gInfo evt, evt)) events +sendGroupMessages_ :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> Bool -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) +sendGroupMessages_ _user gInfo recipientMembers sign events = + sendGroupSignedMessages_ gInfo recipientMembers $ L.map (\evt -> (groupMsgSigning sign gInfo evt, evt)) events + +sendGroupSignedMessages_ :: MsgEncodingI e => GroupInfo -> [GroupMember] -> NonEmpty (Maybe MsgSigning, ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) +sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents = do sndMsgs_ <- lift $ createSndMessages idsEvts recipientMembers' <- liftIO $ shuffleMembers recipientMembers let msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events} @@ -2421,6 +2427,8 @@ sendGroupMessages_ _user gInfo@GroupInfo {groupId} recipientMembers events = do pending = zipWith3 (\mId pReq r -> (mId, fmap snd pReq, r)) pendingMemIds pendingReqs stored pure (sndMsgs_, GroupSndResult {sentTo, pending, forwarded}) where + events = L.map snd signedEvents + idsEvts = L.map (\(signing, evt) -> (GroupId groupId, signing, evt)) signedEvents shuffleMembers :: [GroupMember] -> IO [GroupMember] shuffleMembers ms = do let (adminMs, otherMs) = partition isAdmin ms diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 408fae8105..acaa4b0893 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -1420,7 +1420,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = allRelayMembers events = XGrpRelayNew <$> newlyActive unless (null recipients) $ - void $ sendGroupMessages user gInfo Nothing False recipients events + void $ sendGroupMessages user gInfo Nothing False recipients False events where updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact]) -> IO ([GroupRelay], Bool, [ShortLinkContact]) updateRelay db relay@GroupRelay {relayLink, relayStatus} (acc, changed, newlyActiveLinks) = diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 2fb8361fdb..2863b20b4b 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -1350,6 +1350,14 @@ requiresSignature = \case XInfo_ -> True _ -> False +-- | Content events a member may sign (XMsgNew opt-in; XMsgUpdate/XMsgDel when the target was signed). +signableContent :: CMEventTag e -> Bool +signableContent = \case + XMsgNew_ -> True + XMsgUpdate_ -> True + XMsgDel_ -> True + _ -> False + -- TODO [relays] can be tightened — sender keys are now disseminated via -- TODO prepended XGrpMemNew before forwarded XInfo/XGrpLeave reach the recipient. -- Allow signed but unverified XGrpLeave/XInfo between subscribers when sender's key is unknown.