Merge branch 'master' into chat-relays

src/Simplex/Chat/Library/Commands.hs

@@ -3917,7 +3917,6 @@ processChatCommand vr nm = \case
       ( CRContactUri crData {crScheme = SSSimplex},
         CRContactUri crData {crScheme = simplexChat}
       )
-
     -- This function is needed, as UI uses simplex:/ schema in message view, so that the links can be handled without browser,
     -- and short links are stored with server hostname schema, so they wouldn't match without it.
     serverShortLink :: ConnShortLink m -> ConnShortLink m
@@ -4362,7 +4361,7 @@ agentSubscriber :: CM' ()
 agentSubscriber = do
   q <- asks $ subQ . smpAgent
   forever (atomically (readTBQueue q) >>= process)
-    `E.catchAny` \e -> do
+    `catchOwn` \e -> do
       eToView' $ ChatErrorAgent (CRITICAL True $ "Message reception stopped: " <> show e) (AgentConnId "") Nothing
       E.throwIO e
   where
@@ -4373,7 +4372,7 @@ agentSubscriber = do
       SAERcvFile -> processAgentMsgRcvFile corrId entId msg
       SAESndFile -> processAgentMsgSndFile corrId entId msg
       where
-        run action = action `catchAllErrors'` (eToView')
+        run action = action `catchAllOwnErrors'` eToView'
 
 type AgentSubResult = Map ConnId (Either AgentErrorType (Maybe ClientServiceId))
 

src/Simplex/Chat/Library/Internal.hs

@@ -2301,7 +2301,7 @@ saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} shared
       if (ciRequiresAttention content || contactChatDeleted cd)
         then updateChatTsStats db vr user cd createdAt (memberChatStats userMention)
         else pure $ toChatInfo cd
-    let hasLink_ = ciContentHasLink content ft_        
+    let hasLink_ = ciContentHasLink content ft_
     (ciId, quotedItem, itemForwarded) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live userMention hasLink_ brokerTs createdAt
     forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
     let ci = mkChatItem_ cd False ciId content (t, ft_) ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live userMention hasLink_ brokerTs forwardedByMember createdAt
@@ -2349,8 +2349,8 @@ createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do
 joinAgentConnectionAsync :: User -> Maybe Connection -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM (CommandId, ConnId)
 joinAgentConnectionAsync user conn_ enableNtfs cReqUri cInfo subMode = do
   cmdId <- withStore' $ \db -> createCommand db user (dbConnId <$> conn_) CFJoinConn
-  connId' <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) (aConnId <$> conn_) enableNtfs cReqUri cInfo PQSupportOff subMode
-  pure (cmdId, connId')
+  connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) (aConnId <$> conn_) enableNtfs cReqUri cInfo PQSupportOff subMode
+  pure (cmdId, connId)
 
 allowAgentConnectionAsync :: MsgEncodingI e => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> CM ()
 allowAgentConnectionAsync user conn@Connection {connId, pqSupport, connChatVersion} confId msg = do

src/Simplex/Chat/Protocol.hs

@@ -646,6 +646,9 @@ maxEncodedMsgLength = 15602
 maxCompressedMsgLength :: Int
 maxCompressedMsgLength = 13380
 
+maxDecompressedMsgLength :: Int
+maxDecompressedMsgLength = 65536
+
 -- maxEncodedMsgLength - delta between MSG and INFO + 100 (returned for forward overhead)
 -- delta between MSG and INFO = e2eEncUserMsgLength (no PQ) - e2eEncConnInfoLength (no PQ) = 1008
 maxEncodedInfoLength :: Int
@@ -668,20 +671,24 @@ encodeChatMessage maxSize msg = do
 
 parseChatMessages :: ByteString -> [Either String AChatMessage]
 parseChatMessages "" = [Left "empty string"]
-parseChatMessages s = case B.head s of
-  '{' -> [ACMsg SJson <$> J.eitherDecodeStrict' s]
-  '[' -> case J.eitherDecodeStrict' s of
-    Right v -> map parseItem v
-    Left e -> [Left e]
-  'X' -> decodeCompressed (B.drop 1 s)
-  _ -> [ACMsg SBinary <$> (appBinaryToCM =<< strDecode s)]
+parseChatMessages msg = case B.head msg of
+  'X' -> decodeCompressed (B.tail msg)
+  c -> parseUncompressed c msg
   where
+    parseUncompressed c s = case c of
+      '{' -> [ACMsg SJson <$> J.eitherDecodeStrict' s]
+      '[' -> case J.eitherDecodeStrict' s of
+        Right v -> map parseItem v
+        Left e -> [Left e]
+      _ -> [ACMsg SBinary <$> (appBinaryToCM =<< strDecode s)]
     parseItem :: J.Value -> Either String AChatMessage
     parseItem v = ACMsg SJson <$> JT.parseEither parseJSON v
     decodeCompressed :: ByteString -> [Either String AChatMessage]
     decodeCompressed s' = case smpDecode s' of
       Left e -> [Left e]
-      Right (compressed :: L.NonEmpty Compressed) -> concatMap (either (pure . Left) parseChatMessages . decompress1) compressed
+      Right (compressed :: L.NonEmpty Compressed) -> concatMap (either (pure . Left) parseUncompressed' . decompress1 maxDecompressedMsgLength) compressed
+    parseUncompressed' "" = [Left "empty string"]
+    parseUncompressed' s = parseUncompressed (B.head s) s
 
 compressedBatchMsgBody_ :: MsgBody -> ByteString
 compressedBatchMsgBody_ = markCompressedBatch . smpEncode . (L.:| []) . compress1