Merge branch 'stable'

src/Simplex/Chat/Library/Commands.hs

@@ -3720,7 +3720,7 @@ processChatCommand vr nm = \case
     getShortLinkConnReq :: User -> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
     getShortLinkConnReq user l = do
       l' <- restoreShortLink' l
-      (cReq, cData) <- withAgent $ \a -> getConnShortLink a nm (aUserId user) l'
+      (FixedLinkData {linkConnReq = cReq}, cData) <- withAgent $ \a -> getConnShortLink a nm (aUserId user) l'
       case cData of
         ContactLinkData _ UserContactData {direct} | not direct -> throwChatError CEUnsupportedConnReq
         _ -> pure ()
@@ -4155,7 +4155,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
@@ -4166,7 +4166,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

@@ -2271,7 +2271,7 @@ createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do
 joinAgentConnectionAsync :: User -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM (CommandId, ConnId)
 joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do
   cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn
-  connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo PQSupportOff subMode
+  connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) Nothing enableNtfs cReqUri cInfo PQSupportOff subMode
   pure (cmdId, connId)
 
 allowAgentConnectionAsync :: MsgEncodingI e => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> CM ()

src/Simplex/Chat/Protocol.hs

@@ -227,8 +227,7 @@ instance StrEncoding AppMessageBinary where
     let msgId = if B.null msgId' then Nothing else Just (SharedMsgId msgId')
     pure AppMessageBinary {tag, msgId, body}
 
-data MsgScope
-  = MSMember {memberId :: MemberId} -- Admins can use any member id; members can use only their own id
+data MsgScope = MSMember {memberId :: MemberId} -- Admins can use any member id; members can use only their own id
   deriving (Eq, Show)
 
 $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MS") ''MsgScope)
@@ -644,6 +643,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
@@ -666,20 +668,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