From 106916fd2917a79ca2e6d6c54073374cce467a55 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 21 Dec 2023 11:39:20 +0400 Subject: [PATCH] EncodedChatMessage type --- src/Simplex/Chat.hs | 21 ++++++++++----------- src/Simplex/Chat/Controller.hs | 1 - src/Simplex/Chat/Messages.hs | 2 +- src/Simplex/Chat/Protocol.hs | 10 ++++++---- src/Simplex/Chat/Store/Messages.hs | 10 +++++----- src/Simplex/Chat/Store/Shared.hs | 2 +- src/Simplex/Chat/View.hs | 1 - tests/ProtocolTests.hs | 4 ++-- 8 files changed, 25 insertions(+), 26 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 4849b5043c..a62acd14c0 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -5607,11 +5607,10 @@ createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGro createSndMessage chatMsgEvent connOrGroupId = do gVar <- asks idsDrg ChatConfig {chatVRange} <- asks config - withStore $ \db -> createNewSndMessage db gVar connOrGroupId (newMsg chatVRange) + withStore $ \db -> createNewSndMessage db gVar connOrGroupId chatMsgEvent (encodeMessage chatVRange) where - newMsg chatVRange sharedMsgId = do - let r = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} - fmap (NewMessage chatMsgEvent) r + encodeMessage chatVRange sharedMsgId = + encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} sendBatchedDirectMessages :: forall e m. (MsgEncodingI e, ChatMonad m) => Connection -> NonEmpty (ChatMsgEvent e) -> ConnOrGroupId -> m () sendBatchedDirectMessages conn@Connection {connId} events connOrGroupId = do @@ -5620,7 +5619,8 @@ sendBatchedDirectMessages conn@Connection {connId} events connOrGroupId = do unless (null errs) $ toView $ CRChatErrors Nothing errs forM_ (L.nonEmpty msgs) $ \msgs' -> do let (largeMsgs, msgBatches) = partitionBatches $ batchChatMessages msgs' - errs' = map (\SndMessage {msgId} -> ChatError $ CELargeChatMsg msgId) largeMsgs + -- shouldn't happen, as large messages would have caused createNewSndMessage to throw SELargeMsg + errs' = map (\SndMessage {msgId} -> ChatError $ CEInternalError ("large message " <> show msgId)) largeMsgs unless (null errs') $ toView $ CRChatErrors Nothing errs' forM_ msgBatches $ \(MessagesBatch batchBuilder sndMsgs) -> do let batchBody = LB.toStrict $ Builder.toLazyByteString batchBuilder @@ -5634,11 +5634,10 @@ sendBatchedDirectMessages conn@Connection {connId} events connOrGroupId = do ChatConfig {chatVRange} <- asks config withStoreBatch $ \db -> map (createMsg db gVar chatVRange) (toList events) createMsg db gVar chatVRange evnt = do - r <- runExceptT $ createNewSndMessage db gVar connOrGroupId (newMsg chatVRange evnt) + r <- runExceptT $ createNewSndMessage db gVar connOrGroupId evnt (encodeMessage chatVRange evnt) pure $ first ChatErrorStore r - newMsg chatVRange chatMsgEvent sharedMsgId = do - let r = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} - fmap (NewMessage chatMsgEvent) r + encodeMessage chatVRange evnt sharedMsgId = + encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent = evnt} partitionBatches :: [ChatMessageBatch] -> ([SndMessage], [MessagesBatch]) partitionBatches = foldr partition' ([], []) where @@ -5708,8 +5707,8 @@ directMessage chatMsgEvent = do ChatConfig {chatVRange} <- asks config let r = encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} case r of - Left e -> throwChatError $ CEException e - Right encodedBody -> pure . LB.toStrict $ encodedBody + ECMEncoded encodedBody -> pure . LB.toStrict $ encodedBody + ECMLarge -> throwChatError $ CEException "large message" deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> LazyMsgBody -> MessageId -> m Int64 deliverMessage conn cmEventTag msgBody msgId = do diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 747bddaa73..70e0cc64fc 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -1036,7 +1036,6 @@ data ChatErrorType | CEContactNotActive {contact :: Contact} | CEContactDisabled {contact :: Contact} | CEConnectionDisabled {connection :: Connection} - | CELargeChatMsg {messageId :: Int64} | CEGroupUserRole {groupInfo :: GroupInfo, requiredRole :: GroupMemberRole} | CEGroupMemberInitialRole {groupInfo :: GroupInfo, initialRole :: GroupMemberRole} | CEContactIncognitoCantInvite diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index cc269be2c9..e703747bbc 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -766,7 +766,7 @@ checkChatType x = case testEquality (chatTypeI @c) (chatTypeI @c') of type LazyMsgBody = L.ByteString -data NewSndMessage e = NewMessage +data NewSndMessage e = NewSndMessage { chatMsgEvent :: ChatMsgEvent e, msgBody :: LazyMsgBody } diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index c2dfd2e418..5cda18c298 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -490,15 +490,17 @@ $(JQ.deriveJSON defaultJSON ''QuotedMsg) maxChatMsgSize :: Int64 maxChatMsgSize = 15610 -encodeChatMessage :: MsgEncodingI e => ChatMessage e -> Either String L.ByteString +data EncodedChatMessage = ECMEncoded L.ByteString | ECMLarge + +encodeChatMessage :: MsgEncodingI e => ChatMessage e -> EncodedChatMessage encodeChatMessage msg = do case chatToAppMessage msg of AMJson m -> do let body = J.encode m if LB.length body > maxChatMsgSize - then Left "large message" - else Right body - AMBinary m -> Right . LB.fromStrict $ strEncode m + then ECMLarge + else ECMEncoded body + AMBinary m -> ECMEncoded . LB.fromStrict $ strEncode m parseChatMessages :: ByteString -> [Either String AChatMessage] parseChatMessages "" = [Left "empty string"] diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 3e1159735e..deb92aead0 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -160,12 +160,12 @@ deleteGroupCIs db User {userId} GroupInfo {groupId} = do DB.execute db "DELETE FROM chat_item_reactions WHERE group_id = ?" (Only groupId) DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId) -createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> (SharedMsgId -> Either String (NewSndMessage e)) -> ExceptT StoreError IO SndMessage -createNewSndMessage db gVar connOrGroupId mkMessage = +createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> ChatMsgEvent e -> (SharedMsgId -> EncodedChatMessage) -> ExceptT StoreError IO SndMessage +createNewSndMessage db gVar connOrGroupId chatMsgEvent encodeMessage = createWithRandomId' gVar $ \sharedMsgId -> - case mkMessage (SharedMsgId sharedMsgId) of - Left err -> pure $ Left (SEErrorSavingMessage err) - Right NewMessage {chatMsgEvent, msgBody} -> do + case encodeMessage (SharedMsgId sharedMsgId) of + ECMLarge -> pure $ Left SELargeMsg + ECMEncoded msgBody -> do createdAt <- getCurrentTime DB.execute db diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index b2b95f05d6..a4228f57c4 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -85,7 +85,7 @@ data StoreError | SEPendingConnectionNotFound {connId :: Int64} | SEIntroNotFound | SEUniqueID - | SEErrorSavingMessage {message :: String} + | SELargeMsg | SEInternalError {message :: String} | SEBadChatItem {itemId :: ChatItemId} | SEChatItemNotFound {itemId :: ChatItemId} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 8194e1bb2f..b0408690ae 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1794,7 +1794,6 @@ viewChatError logLevel testView = \case CEContactDisabled ct -> [ttyContact' ct <> ": disabled, to enable: " <> highlight ("/enable " <> viewContactName ct) <> ", to delete: " <> highlight ("/d " <> viewContactName ct)] CEContactNotActive c -> [ttyContact' c <> ": not active"] CEConnectionDisabled Connection {connId, connType} -> [plain $ "connection " <> textEncode connType <> " (" <> tshow connId <> ") is disabled" | logLevel <= CLLWarning] - CELargeChatMsg msgId -> ["large chat message, message_id=" <> sShow msgId] CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"] CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"] CEGroupUserRole g role -> diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 925f5e6a7d..f99579c8ec 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -73,10 +73,10 @@ s ==## msg = do s ##== msg = do let r = encodeChatMessage msg case r of - Left e -> expectationFailure $ "encode error: " <> show e - Right encodedBody -> + ECMEncoded encodedBody -> J.eitherDecodeStrict' (LB.toStrict encodedBody) `shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value) + ECMLarge -> expectationFailure $ "large message" (##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation s ##==## msg = do