diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index d5f06a326f..7ca2f4b948 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -2945,8 +2945,8 @@ processChatCommand' vr = \case msgs_ <- sendDirectContactMessages user ct $ L.map XMsgNew msgContainers let itemsData = prepareSndItemsData msgs_ cmrs ciFiles_ quotedItems_ when (length itemsData /= length cmrs) $ logError "sendContactContentMessages: cmrs and itemsData length mismatch" - (errs, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) itemsData timed_ live - unless (null errs) $ toView $ CRChatErrors (Just user) errs + r@(_, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) itemsData timed_ live + processSendErrs user r forM_ (timed_ >>= timedDeleteAt') $ \deleteAt -> forM_ cis $ \ci -> startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) deleteAt @@ -3010,8 +3010,8 @@ processChatCommand' vr = \case cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData timed_ live when (length itemsData /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch" createMemberSndStatuses cis_ msgs_ gsr - let (errs, cis) = partitionEithers cis_ - unless (null errs) $ toView $ CRChatErrors (Just user) errs + let r@(_, cis) = partitionEithers cis_ + processSendErrs user r forM_ (timed_ >>= timedDeleteAt') $ \deleteAt -> forM_ cis $ \ci -> startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) deleteAt @@ -3103,6 +3103,18 @@ processChatCommand' vr = \case | (msg_, (ComposedMessage {msgContent}, itemForwarded), f, q) <- zipWith4 (,,,) msgs_ (L.toList cmrs') (L.toList ciFiles_) (L.toList quotedItems_) ] + processSendErrs :: User -> ([ChatError], [ChatItem c d]) -> CM () + processSendErrs user = \case + -- no errors + ([], _) -> pure () + -- at least one item is successfully created + (errs, _ci : _) -> toView $ CRChatErrors (Just user) errs + -- single error + ([err], []) -> throwError err + -- multiple errors + (errs@(err : _), []) -> do + toView $ CRChatErrors (Just user) errs + throwError err getCommandDirectChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (Contact, [CChatItem 'CTDirect]) getCommandDirectChatItems user ctId itemIds = do ct <- withFastStore $ \db -> getContact db vr user ctId diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 97a9d89200..c47cf975a1 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -2547,7 +2547,7 @@ setupDesynchronizedRatchet tmp alice = do (bob "/tail @alice 1" bob <# "alice> decryption error, possibly due to the device change (header, 3 messages)" - bob `send` "@alice 1" + bob ##> "@alice 1" bob <## "error: command is prohibited, sendMessagesB: send prohibited" (alice