EncodedChatMessage type

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

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

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
   }

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"]

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

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}

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 ->

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