dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-09-25 09:05:02 +00:00
Code Issues Packages Projects Releases Wiki Activity

check size in encodeChatMessage

Browse Source
This commit is contained in:
spaced4ndy
2023-12-20 18:59:18 +04:00
parent fe20975b06
commit d2b6494b19
5 changed files with 60 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+13 -12
View File
@@ -118,11 +118,6 @@ import qualified UnliftIO.Exception as E
import UnliftIO.IO (hClose, hSeek, hTell, openFile)
import UnliftIO.STM
-- this limit reserves space for metadata in forwarded messages
-- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, round to 15610
maxChatMsgSize :: Int
maxChatMsgSize = 15610
defaultChatConfig :: ChatConfig
defaultChatConfig =
ChatConfig
@@ -3714,6 +3709,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure ()
cmdId <- createAckCmd conn
let aChatMsgs = parseChatMessages msgBody
when (length aChatMsgs > 1) $ liftIO $ putStrLn (show msgBody)
withAckMessage agentConnId cmdId msgMeta $ do
forM_ aChatMsgs $ \case
Right (ACMsg _ chatMsg) ->
@@ -5611,9 +5607,11 @@ 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 $ \sharedMsgId ->
let msgBody = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
in NewMessage {chatMsgEvent, msgBody}
withStore $ \db -> createNewSndMessage db gVar connOrGroupId (newMsg chatVRange)
where
newMsg chatVRange sharedMsgId = do
let r = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
fmap (NewMessage chatMsgEvent) r
sendBatchedDirectMessages :: forall e m. (MsgEncodingI e, ChatMonad m) => Connection -> NonEmpty (ChatMsgEvent e) -> ConnOrGroupId -> m ()
sendBatchedDirectMessages conn@Connection {connId} events connOrGroupId = do
@@ -5636,9 +5634,9 @@ sendBatchedDirectMessages conn@Connection {connId} events connOrGroupId = do
ChatConfig {chatVRange} <- asks config
withStore' $ \db -> forM (toList events) $ \event ->
runExceptT $ createNewSndMessage db gVar connOrGroupId (newMsg chatVRange event)
newMsg chatVRange chatMsgEvent sharedMsgId =
let msgBody = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
in NewMessage {chatMsgEvent, msgBody}
newMsg chatVRange chatMsgEvent sharedMsgId = do
let r = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
fmap (NewMessage chatMsgEvent) r
partitionBatches :: [ChatMessageBatch] -> ([SndMessage], [MessagesBatch])
partitionBatches = foldr partition' ([], [])
where
@@ -5679,7 +5677,10 @@ batchChatMessages = mkBatch []
directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString
directMessage chatMsgEvent = do
ChatConfig {chatVRange} <- asks config
pure $ encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
let r = encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
case r of
Left e -> throwChatError $ CEException e
Right encodedBody -> pure encodedBody
deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m Int64
deliverMessage conn cmEventTag msgBody msgId = do
src/Simplex/Chat/Protocol.hs
+13 -4
View File
@@ -483,10 +483,19 @@ data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInv
$(JQ.deriveJSON defaultJSON ''QuotedMsg)
encodeChatMessage :: MsgEncodingI e => ChatMessage e -> ByteString
encodeChatMessage msg = case chatToAppMessage msg of
AMJson m -> LB.toStrict $ J.encode m
AMBinary m -> strEncode m
-- this limit reserves space for metadata in forwarded messages
-- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, round to 15610
maxChatMsgSize :: Int
maxChatMsgSize = 15610
encodeChatMessage :: MsgEncodingI e => ChatMessage e -> Either String ByteString
encodeChatMessage msg = do
let body = case chatToAppMessage msg of
AMJson m -> LB.toStrict $ J.encode m
AMBinary m -> strEncode m
if B.length body > maxChatMsgSize
then Left "large message"
else Right body
parseChatMessages :: ByteString -> [Either String AChatMessage]
parseChatMessages "" = [Left "empty string"]
src/Simplex/Chat/Store/Messages.hs
+17 -15
View File
@@ -160,22 +160,24 @@ 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 -> NewMessage e) -> ExceptT StoreError IO SndMessage
createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> (SharedMsgId -> Either String (NewMessage e)) -> ExceptT StoreError IO SndMessage
createNewSndMessage db gVar connOrGroupId mkMessage =
createWithRandomId gVar $ \sharedMsgId -> do
let NewMessage {chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId
createdAt <- getCurrentTime
DB.execute
db
[sql|
INSERT INTO messages (
msg_sent, chat_msg_event, msg_body, connection_id, group_id,
shared_msg_id, shared_msg_id_user, created_at, updated_at
) VALUES (?,?,?,?,?,?,?,?,?)
|]
(MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, sharedMsgId, Just True, createdAt, createdAt)
msgId <- insertedRowId db
pure SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody}
createWithRandomId' gVar $ \sharedMsgId ->
case mkMessage (SharedMsgId sharedMsgId) of
Left err -> pure $ Left (SEErrorSavingMessage err)
Right NewMessage {chatMsgEvent, msgBody} -> do
createdAt <- getCurrentTime
DB.execute
db
[sql|
INSERT INTO messages (
msg_sent, chat_msg_event, msg_body, connection_id, group_id,
shared_msg_id, shared_msg_id_user, created_at, updated_at
) VALUES (?,?,?,?,?,?,?,?,?)
|]
(MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, sharedMsgId, Just True, createdAt, createdAt)
msgId <- insertedRowId db
pure $ Right SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody}
where
(connId_, groupId_) = case connOrGroupId of
ConnectionId connId -> (Just connId, Nothing)
src/Simplex/Chat/Store/Shared.hs
+10 -2
View File
@@ -85,6 +85,7 @@ data StoreError
| SEPendingConnectionNotFound {connId :: Int64}
| SEIntroNotFound
| SEUniqueID
| SEErrorSavingMessage {message :: String}
| SEInternalError {message :: String}
| SEBadChatItem {itemId :: ChatItemId}
| SEChatItemNotFound {itemId :: ChatItemId}
@@ -374,15 +375,22 @@ withLocalDisplayName db userId displayName action = getLdnSuffix >>= (`tryCreate
createWithRandomId :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
createWithRandomId = createWithRandomBytes 12
createWithRandomId' :: forall a. TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomId' = createWithRandomBytes' 12
createWithRandomBytes :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
createWithRandomBytes size gVar create = tryCreate 3
createWithRandomBytes size gVar create = createWithRandomBytes' size gVar (fmap Right . create)
createWithRandomBytes' :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomBytes' size gVar create = tryCreate 3
where
tryCreate :: Int -> ExceptT StoreError IO a
tryCreate 0 = throwError SEUniqueID
tryCreate n = do
id' <- liftIO $ encodedRandomBytes gVar size
liftIO (E.try $ create id') >>= \case
Right x -> pure x
Right (Right x) -> pure x
Right (Left e) -> throwError e
Left e
| SQL.sqlError e == SQL.ErrorConstraint -> tryCreate (n - 1)
| otherwise -> throwError . SEInternalError $ show e
tests/ProtocolTests.hs
+7 -3
View File
@@ -69,9 +69,13 @@ s ==## msg = do
_ -> expectationFailure "exactly one message expected"
(##==) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
s ##== msg =
J.eitherDecodeStrict' (encodeChatMessage msg)
`shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
s ##== msg = do
let r = encodeChatMessage msg
case r of
Left e -> expectationFailure $ "encode error: " <> show e
Right encodedBody ->
J.eitherDecodeStrict' encodedBody
`shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
(##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
s ##==## msg = do