core: update simplexmq (error handling) (#6231)

* core: update simplexmq (error handling)

* update simplexmq

cabal.project

@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: a2d777bda0af2a7ee7cd68952eaf7c86329427ad
+    tag: beafac1f73f7d61b99c79d609731f94a05ced97f
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."a2d777bda0af2a7ee7cd68952eaf7c86329427ad" = "04h8vdxf732jwsim2fcrql47gsmv680lgg2kylgmfk4al0pnpkdk";
+  "https://github.com/simplex-chat/simplexmq.git"."beafac1f73f7d61b99c79d609731f94a05ced97f" = "11f1d0h5n7lkwsjz1csyxkrrcxqsyf2rv7339qcfbpdmqhq6k3ni";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

src/Simplex/Chat/Archive.hs

@@ -158,7 +158,7 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
     -- closing after encryption prevents closing in case wrong encryption key was passed
     liftIO $ closeDBStore `withStores` fs
     (moveExported `withStores` fs)
-      `catchChatError` \e -> (restore `withDBs` fs) >> throwError e
+      `catchAllErrors` \e -> (restore `withDBs` fs) >> throwError e
   where
     backup f = copyFile f (f <> ".bak")
     restore f = copyFile (f <> ".bak") f

src/Simplex/Chat/Controller.hs

@@ -19,7 +19,7 @@ module Simplex.Chat.Controller where
 
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.Async (Async)
-import Control.Exception (Exception, SomeException)
+import Control.Exception (Exception)
 import qualified Control.Exception as E
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
@@ -88,7 +88,7 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), Msg
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (TLS, TransportPeer (..), simplexMQVersion)
 import Simplex.Messaging.Transport.Client (SocksProxyWithAuth, TransportHost)
-import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors', (<$$>))
+import Simplex.Messaging.Util (AnyError (..), catchAllErrors, (<$$>))
 import Simplex.RemoteControl.Client
 import Simplex.RemoteControl.Invitation (RCSignedInvitation, RCVerifiedInvitation)
 import Simplex.RemoteControl.Types
@@ -1419,6 +1419,10 @@ data ArchiveError
   | AEFileError {file :: String, fileError :: String}
   deriving (Show, Exception)
 
+instance AnyError ChatError where
+  fromSomeException = ChatError . CEException . show
+  {-# INLINE fromSomeException #-}
+
 -- | Host (mobile) side of transport to process remote commands and forward notifications
 data RemoteCtrlSession
   = RCSessionStarting
@@ -1505,46 +1509,10 @@ setContactNetworkStatus :: Contact -> NetworkStatus -> CM' ()
 setContactNetworkStatus Contact {activeConn = Nothing} _ = pure ()
 setContactNetworkStatus Contact {activeConn = Just Connection {agentConnId}} status = chatModifyVar' connNetworkStatuses $ M.insert agentConnId status
 
-tryChatError :: CM a -> CM (Either ChatError a)
-tryChatError = tryAllErrors mkChatError
-{-# INLINE tryChatError #-}
-
-tryChatError' :: CM a -> CM' (Either ChatError a)
-tryChatError' = tryAllErrors' mkChatError
-{-# INLINE tryChatError' #-}
-
-catchChatError :: CM a -> (ChatError -> CM a) -> CM a
-catchChatError = catchAllErrors mkChatError
-{-# INLINE catchChatError #-}
-
-catchChatError' :: CM a -> (ChatError -> CM' a) -> CM' a
-catchChatError' = catchAllErrors' mkChatError
-{-# INLINE catchChatError' #-}
-
-chatFinally :: CM a -> CM b -> CM a
-chatFinally = allFinally mkChatError
-{-# INLINE chatFinally #-}
-
 onChatError :: CM a -> CM b -> CM a
-a `onChatError` onErr = a `catchChatError` \e -> onErr >> throwError e
+a `onChatError` onErr = a `catchAllErrors` \e -> onErr >> throwError e
 {-# INLINE onChatError #-}
 
-mkChatError :: SomeException -> ChatError
-mkChatError = ChatError . CEException . show
-{-# INLINE mkChatError #-}
-
-catchStoreError :: ExceptT StoreError IO a -> (StoreError -> ExceptT StoreError IO a) -> ExceptT StoreError IO a
-catchStoreError = catchAllErrors mkStoreError
-{-# INLINE catchStoreError #-}
-
-tryStoreError' :: ExceptT StoreError IO a -> IO (Either StoreError a)
-tryStoreError' = tryAllErrors' mkStoreError
-{-# INLINE tryStoreError' #-}
-
-mkStoreError :: SomeException -> StoreError
-mkStoreError = SEInternalError . show
-{-# INLINE mkStoreError #-}
-
 throwCmdError :: String -> CM a
 throwCmdError = throwError . ChatError . CECommandError
 {-# INLINE throwCmdError #-}

src/Simplex/Chat/Library/Commands.hs

@@ -230,7 +230,7 @@ startReceiveUserFiles :: User -> CM ()
 startReceiveUserFiles user = do
   filesToReceive <- withStore' (`getRcvFilesToReceive` user)
   forM_ filesToReceive $ \ft ->
-    flip catchChatError eToView $
+    flip catchAllErrors eToView $
       toView =<< receiveFileEvt' user ft False Nothing Nothing
 
 restoreCalls :: CM' ()
@@ -300,7 +300,7 @@ handleCommandError a = runExceptT a `E.catches` ioErrors
   where
     ioErrors =
       [ E.Handler $ \(e :: ExitCode) -> E.throwIO e,
-        E.Handler $ pure . Left . mkChatError
+        E.Handler $ pure . Left . fromSomeException
       ]
 
 parseChatCommand :: ByteString -> Either String ChatCommand
@@ -324,7 +324,7 @@ processChatCommand vr nm = \case
     user <- withFastStore $ \db -> do
       user <- createUserRecordAt db (AgentUserId auId) p True ts
       mapM_ (setUserServers db user ts) uss
-      createPresetContactCards db user `catchStoreError` \_ -> pure ()
+      createPresetContactCards db user `catchAllErrors` \_ -> pure ()
       createNoteFolder db user
       pure user
     atomically . writeTVar u $ Just user
@@ -363,7 +363,7 @@ processChatCommand vr nm = \case
     chatWriteVar currentUser $ Just user''
     pure $ CRActiveUser user''
   SetActiveUser uName viewPwd_ -> do
-    tryChatError (withFastStore (`getUserIdByName` uName)) >>= \case
+    tryAllErrors (withFastStore (`getUserIdByName` uName)) >>= \case
       Left _ -> throwChatError CEUserUnknown
       Right userId -> processChatCommand vr nm $ APISetActiveUser userId viewPwd_
   SetAllContactReceipts onOff -> withUser $ \_ -> withFastStore' (`updateAllContactReceipts` onOff) >> ok_
@@ -1101,7 +1101,7 @@ processChatCommand vr nm = \case
       where
         sendDelDeleteConns ct notify = do
           let doSendDel = contactReady ct && contactActive ct && notify
-          when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchChatError` const (pure ())
+          when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchAllErrors` const (pure ())
           contactConnIds <- map aConnId <$> withFastStore' (\db -> getContactConnections db vr userId ct)
           deleteAgentConnectionsAsync' contactConnIds doSendDel
     CTContactConnection -> withConnectionLock "deleteChat contactConnection" chatId $ do
@@ -1123,7 +1123,7 @@ processChatCommand vr nm = \case
         when doSendDel . void $ sendGroupMessage' user gInfo recipients XGrpDel
         deleteGroupLinkIfExists user gInfo
         deleteMembersConnections' user members doSendDel
-        updateCIGroupInvitationStatus user gInfo CIGISRejected `catchChatError` \_ -> pure ()
+        updateCIGroupInvitationStatus user gInfo CIGISRejected `catchAllErrors` \_ -> pure ()
         withFastStore' $ \db -> deleteGroupChatItems db user gInfo
         withFastStore' $ \db -> cleanupHostGroupLinkConn db user gInfo
         withFastStore' $ \db -> deleteGroupMembers db user gInfo
@@ -1467,7 +1467,7 @@ processChatCommand vr nm = \case
           oldTTL = fromMaybe globalTTL oldTTL_
       when (newTTL > 0 && (newTTL < oldTTL || oldTTL == 0)) $ do
         lift $ setExpireCIFlag user False
-        expireChat user globalTTL `catchChatError` eToView
+        expireChat user globalTTL `catchAllErrors` eToView
       lift $ setChatItemsExpiration user globalTTL ttlCount
       ok user
     where
@@ -1538,7 +1538,7 @@ processChatCommand vr nm = \case
         liftIO $ updateGroupSettings db user chatId chatSettings
         pure ms
       forM_ (filter memberActive ms) $ \m -> forM_ (memberConnId m) $ \connId ->
-        withAgent (\a -> toggleConnectionNtfs a connId $ chatHasNtfs chatSettings) `catchChatError` eToView
+        withAgent (\a -> toggleConnectionNtfs a connId $ chatHasNtfs chatSettings) `catchAllErrors` eToView
       ok user
     _ -> throwCmdError "not supported"
   APISetMemberSettings gId gMemberId settings -> withUser $ \user -> do
@@ -1829,7 +1829,7 @@ processChatCommand vr nm = \case
     case preparedContact of
       Nothing -> throwCmdError "contact doesn't have link to connect"
       Just PreparedContact {connLinkToConnect = ACCL SCMInvitation ccLink} -> do
-        (_, customUserProfile) <- connectViaInvitation user incognito ccLink (Just contactId) `catchChatError` \e -> do
+        (_, customUserProfile) <- connectViaInvitation user incognito ccLink (Just contactId) `catchAllErrors` \e -> do
           -- get updated contact, in case connection was started - in UI it would lock ability to change
           -- user or incognito profile for contact, in case server received request while client got network error
           ct' <- withFastStore $ \db -> getContact db vr user contactId
@@ -1852,7 +1852,7 @@ processChatCommand vr nm = \case
             smId <- getSharedMsgId
             withFastStore' $ \db -> setRequestSharedMsgIdForContact db contactId smId
             pure (smId, mc)
-        r <- connectViaContact user (Just $ PCEContact ct) incognito ccLink welcomeSharedMsgId msg_ `catchChatError` \e -> do
+        r <- connectViaContact user (Just $ PCEContact ct) incognito ccLink welcomeSharedMsgId msg_ `catchAllErrors` \e -> do
           -- get updated contact, in case connection was started - in UI it would lock ability to change
           -- user or incognito profile for contact, in case server received request while client got network error
           ct' <- withFastStore $ \db -> getContact db vr user contactId
@@ -1880,7 +1880,7 @@ processChatCommand vr nm = \case
             smId <- getSharedMsgId
             withFastStore' $ \db -> setRequestSharedMsgIdForGroup db groupId smId
             pure (smId, mc)
-        r <- connectViaContact user (Just $ PCEGroup gInfo hostMember) incognito connLinkToConnect welcomeSharedMsgId msg_ `catchChatError` \e -> do
+        r <- connectViaContact user (Just $ PCEGroup gInfo hostMember) incognito connLinkToConnect welcomeSharedMsgId msg_ `catchAllErrors` \e -> do
           -- get updated group info, in case connection was started (connLinkPreparedConnection) - in UI it would lock ability to change
           -- user or incognito profile for group or business chat, in case server received request while client got network error
           gInfo' <- withFastStore $ \db -> getGroupInfo db vr user groupId
@@ -1908,7 +1908,7 @@ processChatCommand vr nm = \case
         CVRSentInvitation conn incognitoProfile -> pure $ CRSentInvitation user (mkPendingContactConnection conn Nothing) incognitoProfile
   APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
   Connect incognito (Just cLink@(ACL m cLink')) -> withUser $ \user -> do
-    (ccLink, plan) <- connectPlan user cLink `catchChatError` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing)); _ -> throwError e
+    (ccLink, plan) <- connectPlan user cLink `catchAllErrors` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing)); _ -> throwError e
     connectWithPlan user incognito ccLink plan
   Connect _ Nothing -> throwChatError CEInvalidConnReq
   APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do
@@ -1919,14 +1919,14 @@ processChatCommand vr nm = \case
         (cReq, _cData) <- getShortLinkConnReq user sLnk
         pure $ CCLink cReq $ Just sLnk
       Nothing -> throwCmdError "no address in contact profile"
-    connectContactViaAddress user incognito ct ccLink `catchChatError` \e -> do
+    connectContactViaAddress user incognito ct ccLink `catchAllErrors` \e -> do
       -- get updated contact, in case connection was started - in UI it would lock ability to change incognito choice
       -- on next connection attempt, in case server received request while client got network error
       ct' <- withFastStore $ \db -> getContact db vr user contactId
       toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
       throwError e
   ConnectSimplex incognito -> withUser $ \user -> do
-    plan <- contactRequestPlan user adminContactReq Nothing `catchChatError` const (pure $ CPContactAddress (CAPOk Nothing))
+    plan <- contactRequestPlan user adminContactReq Nothing `catchAllErrors` const (pure $ CPContactAddress (CAPOk Nothing))
     connectWithPlan user incognito (ACCL SCMContact (CCLink adminContactReq Nothing)) plan
   DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId Nothing) cdm
   ClearContact cName -> withContactName cName $ \chatId -> APIClearChat $ ChatRef CTDirect chatId Nothing
@@ -2200,12 +2200,12 @@ processChatCommand vr nm = \case
             -- MFAll is default for new groups
             unless (enableNtfs == MFAll) $ updateGroupSettings db user groupId chatSettings {enableNtfs}
           void (withAgent $ \a -> joinConnection a nm (aUserId user) agentConnId (enableNtfs /= MFNone) connRequest dm PQSupportOff subMode)
-            `catchChatError` \e -> do
+            `catchAllErrors` \e -> do
               withFastStore' $ \db -> do
                 updateGroupMemberStatus db userId fromMember GSMemInvited
                 updateGroupMemberStatus db userId membership GSMemInvited
               throwError e
-          updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` eToView
+          updateCIGroupInvitationStatus user g CIGISAccepted `catchAllErrors` eToView
           pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
         Nothing -> throwChatError $ CEContactNotActive ct
   APIAcceptMember groupId gmId role -> withUser $ \user@User {userId} -> do
@@ -2308,7 +2308,7 @@ processChatCommand vr nm = \case
       changeRoleInvitedMems :: User -> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
       changeRoleInvitedMems user gInfo memsToChange = do
         -- not batched, as we need to send different invitations to different connections anyway
-        mems_ <- forM memsToChange $ \m -> (Right <$> changeRole m) `catchChatError` (pure . Left)
+        mems_ <- forM memsToChange $ \m -> (Right <$> changeRole m) `catchAllErrors` (pure . Left)
         pure $ partitionEithers mems_
         where
           changeRole :: GroupMember -> CM GroupMember
@@ -2620,7 +2620,7 @@ processChatCommand vr nm = \case
   APIAcceptMemberContact contactId -> withUser $ \user -> do
     (g, mConn, ct, groupDirectInv) <- withFastStore $ \db -> getMemberContactInvited db vr user contactId
     when (groupDirectInvStartedConnection groupDirectInv) $ throwCmdError "connection already started"
-    connectMemberContact user g mConn ct groupDirectInv `catchChatError` \e -> do
+    connectMemberContact user g mConn ct groupDirectInv `catchAllErrors` \e -> do
       -- get updated contact, in case connection was started
       ct' <- withFastStore $ \db -> getContact db vr user contactId
       toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
@@ -3233,7 +3233,7 @@ processChatCommand vr nm = \case
               mergedProfile' = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') False
           when (mergedProfile' /= mergedProfile) $
             withContactLock "updateContactPrefs" (contactId' ct) $ do
-              void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` eToView
+              void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchAllErrors` eToView
               lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct'
           pure $ CRContactPrefsUpdated user ct ct'
     runUpdateGroupProfile :: User -> Group -> GroupProfile -> CM ChatResponse
@@ -3411,7 +3411,7 @@ processChatCommand vr nm = \case
     drgRandomBytes n = asks random >>= atomically . C.randomBytes n
     privateGetUser :: UserId -> CM User
     privateGetUser userId =
-      tryChatError (withStore (`getUser` userId)) >>= \case
+      tryAllErrors (withStore (`getUser` userId)) >>= \case
         Left _ -> throwChatError CEUserUnknown
         Right user -> pure user
     validateUserPassword :: User -> User -> Maybe UserPwd -> CM ()
@@ -3452,7 +3452,7 @@ processChatCommand vr nm = \case
       filesInfo <- withFastStore' (`getUserFileInfo` user)
       deleteCIFiles user filesInfo
       withAgent (\a -> deleteUser a (aUserId user) delSMPQueues)
-        `catchChatError` \case
+        `catchAllErrors` \case
           e@(ChatErrorAgent NO_USER _) -> eToView e
           e -> throwError e
       withFastStore' (`deleteUserRecord` user)
@@ -3491,11 +3491,11 @@ processChatCommand vr nm = \case
             -- deleted contact is returned as known, as invitation link cannot be re-used too connect anyway
             Nothing -> bimap inv (CPInvitationLink . ILPKnown) <$$> getContactViaShortLinkToConnect db vr user l'
         invitationReqAndPlan cReq sLnk_ contactSLinkData_ = do
-          plan <- invitationRequestPlan user cReq contactSLinkData_ `catchChatError` (pure . CPError)
+          plan <- invitationRequestPlan user cReq contactSLinkData_ `catchAllErrors` (pure . CPError)
           pure (ACCL SCMInvitation (CCLink cReq sLnk_), plan)
     connectPlan user (ACL SCMContact cLink) = case cLink of
       CLFull cReq -> do
-        plan <- contactOrGroupRequestPlan user cReq `catchChatError` (pure . CPError)
+        plan <- contactOrGroupRequestPlan user cReq `catchAllErrors` (pure . CPError)
         pure (ACCL SCMContact $ CCLink cReq Nothing, plan)
       CLShort l@(CSLContact _ ct _ _) -> do
         let l' = serverShortLink l
@@ -3875,7 +3875,7 @@ processChatCommand vr nm = \case
       case contactOrGroup of
         CGContact Contact {activeConn} -> forM_ activeConn $ \conn ->
           withFastStore' $ \db -> createSndFTDescrXFTP db user Nothing conn ft dummyFileDescr
-        CGGroup _ ms -> forM_ ms $ \m -> saveMemberFD m `catchChatError` eToView
+        CGGroup _ ms -> forM_ ms $ \m -> saveMemberFD m `catchAllErrors` eToView
           where
             -- we are not sending files to pending members, same as with inline files
             saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
@@ -4061,7 +4061,7 @@ startExpireCIThread user@User {userId} = do
       liftIO $ threadDelay' delay
       interval <- asks $ ciExpirationInterval . config
       forever $ do
-        flip catchChatError' (eToView') $ do
+        flip catchAllErrors' (eToView') $ do
           expireFlags <- asks expireCIFlags
           atomically $ TM.lookup userId expireFlags >>= \b -> unless (b == Just True) retry
           lift waitChatStartedAndActivated
@@ -4103,7 +4103,7 @@ agentSubscriber = do
       SAERcvFile -> processAgentMsgRcvFile corrId entId msg
       SAESndFile -> processAgentMsgSndFile corrId entId msg
       where
-        run action = action `catchChatError'` (eToView')
+        run action = action `catchAllErrors'` (eToView')
 
 type AgentBatchSubscribe = AgentClient -> [ConnId] -> ExceptT AgentErrorType IO (Map ConnId (Either AgentErrorType (Maybe ClientServiceId)))
 
@@ -4251,7 +4251,7 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
     pendingConnSubsToView :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Map ConnId PendingContactConnection -> CM ()
     pendingConnSubsToView rs = toViewTE . TEPendingSubSummary user . map (uncurry PendingSubStatus) . resultsFor rs
     withStore_ :: (DB.Connection -> User -> IO [a]) -> CM [a]
-    withStore_ a = withStore' (`a` user) `catchChatError` \e -> eToView e $> []
+    withStore_ a = withStore' (`a` user) `catchAllErrors` \e -> eToView e $> []
     filterErrors :: [(a, Maybe ChatError)] -> [(a, ChatError)]
     filterErrors = mapMaybe (\(a, e_) -> (a,) <$> e_)
     resultsFor :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Map ConnId a -> [(a, Maybe ChatError)]
@@ -4273,40 +4273,40 @@ cleanupManager = do
   liftIO $ threadDelay' initialDelay
   stepDelay <- asks (cleanupManagerStepDelay . config)
   forever $ do
-    flip catchChatError eToView $ do
+    flip catchAllErrors eToView $ do
       lift waitChatStartedAndActivated
       users <- withStore' getUsers
       let (us, us') = partition activeUser users
       forM_ us $ cleanupUser interval stepDelay
       forM_ us' $ cleanupUser interval stepDelay
-      cleanupMessages `catchChatError` eToView
+      cleanupMessages `catchAllErrors` eToView
       -- TODO possibly, also cleanup async commands
-      cleanupProbes `catchChatError` eToView
+      cleanupProbes `catchAllErrors` eToView
     liftIO $ threadDelay' $ diffToMicroseconds interval
   where
-    runWithoutInitialDelay cleanupInterval = flip catchChatError eToView $ do
+    runWithoutInitialDelay cleanupInterval = flip catchAllErrors eToView $ do
       lift waitChatStartedAndActivated
       users <- withStore' getUsers
       let (us, us') = partition activeUser users
-      forM_ us $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` eToView
-      forM_ us' $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` eToView
+      forM_ us $ \u -> cleanupTimedItems cleanupInterval u `catchAllErrors` eToView
+      forM_ us' $ \u -> cleanupTimedItems cleanupInterval u `catchAllErrors` eToView
     cleanupUser cleanupInterval stepDelay user = do
-      cleanupTimedItems cleanupInterval user `catchChatError` eToView
+      cleanupTimedItems cleanupInterval user `catchAllErrors` eToView
       liftIO $ threadDelay' stepDelay
       -- TODO remove in future versions: legacy step - contacts are no longer marked as deleted
-      cleanupDeletedContacts user `catchChatError` eToView
+      cleanupDeletedContacts user `catchAllErrors` eToView
       liftIO $ threadDelay' stepDelay
     cleanupTimedItems cleanupInterval user = do
       ts <- liftIO getCurrentTime
       let startTimedThreadCutoff = addUTCTime cleanupInterval ts
       timedItems <- withStore' $ \db -> getTimedItems db user startTimedThreadCutoff
-      forM_ timedItems $ \(itemRef, deleteAt) -> startTimedItemThread user itemRef deleteAt `catchChatError` const (pure ())
+      forM_ timedItems $ \(itemRef, deleteAt) -> startTimedItemThread user itemRef deleteAt `catchAllErrors` const (pure ())
     cleanupDeletedContacts user = do
       vr <- chatVersionRange
       contacts <- withStore' $ \db -> getDeletedContacts db vr user
       forM_ contacts $ \ct ->
         withStore (\db -> deleteContactWithoutGroups db user ct)
-          `catchChatError` eToView
+          `catchAllErrors` eToView
     cleanupMessages = do
       ts <- liftIO getCurrentTime
       let cutoffTs = addUTCTime (-(30 * nominalDay)) ts
@@ -4332,7 +4332,7 @@ expireChatItems user@User {userId} globalTTL sync = do
     loop :: [Int64] -> (Int64 -> CM ()) -> CM ()
     loop [] _ = pure ()
     loop (a : as) process = continue $ do
-      process a `catchChatError` eToView
+      process a `catchAllErrors` eToView
       loop as process
     continue :: CM () -> CM ()
     continue a =
@@ -4347,7 +4347,7 @@ expireContactChatItems :: User -> VersionRangeChat -> Int64 -> ContactId -> CM (
 expireContactChatItems user vr globalTTL ctId =
   -- reading contacts and groups inside the loop,
   -- to allow ttl changing while processing and to reduce memory usage
-  tryChatError (withStore $ \db -> getContact db vr user ctId) >>= mapM_ process
+  tryAllErrors (withStore $ \db -> getContact db vr user ctId) >>= mapM_ process
   where
     process ct@Contact {chatItemTTL} =
       withExpirationDate globalTTL chatItemTTL $ \expirationDate -> do
@@ -4358,7 +4358,7 @@ expireContactChatItems user vr globalTTL ctId =
 
 expireGroupChatItems :: User -> VersionRangeChat -> Int64 -> UTCTime -> GroupId -> CM ()
 expireGroupChatItems user vr globalTTL createdAtCutoff groupId =
-  tryChatError (withStore $ \db -> getGroupInfo db vr user groupId) >>= mapM_ process
+  tryAllErrors (withStore $ \db -> getGroupInfo db vr user groupId) >>= mapM_ process
   where
     process gInfo@GroupInfo {chatItemTTL} =
       withExpirationDate globalTTL chatItemTTL $ \expirationDate -> do

src/Simplex/Chat/Library/Internal.hs

@@ -193,7 +193,7 @@ toggleNtf :: GroupMember -> Bool -> CM ()
 toggleNtf m ntfOn =
   when (memberActive m) $
     forM_ (memberConnId m) $ \connId ->
-      withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` eToView
+      withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchAllErrors` eToView
 
 prepareGroupMsg :: DB.Connection -> User -> GroupInfo -> Maybe MsgScope -> MsgContent -> Map MemberName MsgMention -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> ExceptT StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))
 prepareGroupMsg db user g@GroupInfo {membership} msgScope mc mentions quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of
@@ -385,7 +385,7 @@ cancelFilesInProgress :: User -> [CIFileInfo] -> CM ()
 cancelFilesInProgress user filesInfo = do
   let filesInfo' = filter (not . fileEnded) filesInfo
   (sfs, rfs) <- lift $ splitFTTypes <$> withStoreBatch (\db -> map (getFT db) filesInfo')
-  forM_ rfs $ \RcvFileTransfer {fileId} -> lift (closeFileHandle fileId rcvFiles) `catchChatError` \_ -> pure ()
+  forM_ rfs $ \RcvFileTransfer {fileId} -> lift (closeFileHandle fileId rcvFiles) `catchAllErrors` \_ -> pure ()
   lift . void . withStoreBatch' $ \db -> map (updateSndFileCancelled db) sfs
   lift . void . withStoreBatch' $ \db -> map (updateRcvFileCancelled db) rfs
   let xsfIds = mapMaybe (\(FileTransferMeta {fileId, xftpSndFile}, _) -> (,fileId) <$> xftpSndFile) sfs
@@ -655,7 +655,7 @@ setFileToEncrypt ft@RcvFileTransfer {fileId} = do
 
 receiveFile' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM ChatResponse
 receiveFile' user ft userApprovedRelays rcvInline_ filePath_ = do
-  (CRRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchChatError` processError
+  (CRRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchAllErrors` processError
   where
     -- TODO AChatItem in Cancelled events
     processError e
@@ -664,7 +664,7 @@ receiveFile' user ft userApprovedRelays rcvInline_ filePath_ = do
 
 receiveFileEvt' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM ChatEvent
 receiveFileEvt' user ft userApprovedRelays rcvInline_ filePath_ = do
-  (CEvtRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchChatError` processError
+  (CEvtRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchAllErrors` processError
   where
     -- TODO AChatItem in Cancelled events
     processError e
@@ -788,7 +788,7 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
 cleanupACIFile :: AChatItem -> CM ()
 cleanupACIFile (AChatItem _ _ _ ChatItem {file = Just CIFile {fileSource = Just CryptoFile {filePath}}}) = do
   fsFilePath <- lift $ toFSFilePath filePath
-  removeFile fsFilePath `catchChatError` \_ -> pure ()
+  removeFile fsFilePath `catchAllErrors` \_ -> pure ()
 cleanupACIFile _ = pure ()
 
 getKnownAgentServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> User -> CM (NonEmpty (ServerCfg p))
@@ -1089,7 +1089,7 @@ introduceMember vr user gInfo@GroupInfo {groupId} m@GroupMember {activeConn = Ju
           forM_ (L.nonEmpty events) $ \events' ->
             sendGroupMemberMessages user conn events' groupId
         else forM_ shuffledIntros $ \intro ->
-          processIntro intro `catchChatError` eToView
+          processIntro intro `catchAllErrors` eToView
     memberIntro :: GroupMember -> ChatMsgEvent 'Json
     memberIntro reMember =
       let mInfo = memberInfo reMember
@@ -1113,7 +1113,7 @@ sendHistory _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternal
 sendHistory user gInfo@GroupInfo {groupId, membership} m@GroupMember {activeConn = Just conn} =
   when (m `supportsVersion` batchSendVersion) $ do
     (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100)
-    (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items
+    (errs', events) <- partitionEithers <$> mapM (tryAllErrors . itemForwardEvents) items
     let errors = map ChatErrorStore errs <> errs'
     unless (null errors) $ toView $ CEvtChatErrors errors
     let events' = concat events
@@ -1286,7 +1286,7 @@ metaBrokerTs MsgMeta {broker = (_, brokerTs)} = brokerTs
 
 createContactPQSndItem :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection)
 createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' =
-  flip catchChatError (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of
+  flip catchAllErrors (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of
     (Just b, b') | b' /= b -> createPQItem $ CISndConnEvent (SCEPqEnabled pqSndEnabled')
     (Nothing, PQEncOn) -> createPQItem $ CISndDirectE2EEInfo (E2EInfo $ Just pqSndEnabled')
     _ -> pure (ct, conn)
@@ -1301,7 +1301,7 @@ createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' =
 
 updateContactPQRcv :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection)
 updateContactPQRcv user ct conn@Connection {connId, pqRcvEnabled} pqRcvEnabled' =
-  flip catchChatError (const $ pure (ct, conn)) $ case (pqRcvEnabled, pqRcvEnabled') of
+  flip catchAllErrors (const $ pure (ct, conn)) $ case (pqRcvEnabled, pqRcvEnabled') of
     (Just b, b') | b' /= b -> updatePQ $ CIRcvConnEvent (RCEPqEnabled pqRcvEnabled')
     (Nothing, PQEncOn) -> updatePQ $ CIRcvDirectE2EEInfo (E2EInfo $ Just pqRcvEnabled')
     _ -> pure (ct, conn)
@@ -1539,13 +1539,13 @@ appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs, fileInvitati
         lift $ closeFileHandle fileId rcvFiles
         forM_ cryptoArgs $ \cfArgs -> do
           tmpFile <- lift getChatTempDirectory >>= liftIO . (`uniqueCombine` fileName)
-          tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case
+          tryAllErrors (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case
             Right () -> do
-              removeFile fsFilePath `catchChatError` \_ -> pure ()
+              removeFile fsFilePath `catchAllErrors` \_ -> pure ()
               renameFile tmpFile fsFilePath
             Left e -> do
               eToView e
-              removeFile tmpFile `catchChatError` \_ -> pure ()
+              removeFile tmpFile `catchAllErrors` \_ -> pure ()
               withStore' (`removeFileCryptoArgs` fileId)
       where
         encryptErr e = fileErr $ e <> ", received file not encrypted"
@@ -1569,7 +1569,7 @@ isFileActive fileId files = do
 
 cancelRcvFileTransfer :: User -> RcvFileTransfer -> CM (Maybe ConnId)
 cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInline} =
-  cancel' `catchChatError` (\e -> eToView e $> fileConnId)
+  cancel' `catchAllErrors` (\e -> eToView e $> fileConnId)
   where
     cancel' = do
       lift $ closeFileHandle fileId rcvFiles
@@ -1587,13 +1587,13 @@ cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInlin
 cancelSndFile :: User -> FileTransferMeta -> [SndFileTransfer] -> Bool -> CM [ConnId]
 cancelSndFile user FileTransferMeta {fileId, xftpSndFile} fts sendCancel = do
   withStore' (\db -> updateFileCancelled db user fileId CIFSSndCancelled)
-    `catchChatError` eToView
+    `catchAllErrors` eToView
   case xftpSndFile of
     Nothing ->
       catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel)
     Just xsf -> do
       forM_ fts (\ft -> cancelSndFileTransfer user ft False)
-      lift (agentXFTPDeleteSndFileRemote user xsf fileId) `catchChatError` eToView
+      lift (agentXFTPDeleteSndFileRemote user xsf fileId) `catchAllErrors` eToView
       pure []
 
 -- TODO v6.0 remove
@@ -1601,7 +1601,7 @@ cancelSndFileTransfer :: User -> SndFileTransfer -> Bool -> CM (Maybe ConnId)
 cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel =
   if fileStatus == FSCancelled || fileStatus == FSComplete
     then pure Nothing
-    else cancel' `catchChatError` (\e -> eToView e $> fileConnId)
+    else cancel' `catchAllErrors` (\e -> eToView e $> fileConnId)
   where
     cancel' = do
       withStore' $ \db -> do
@@ -1661,7 +1661,7 @@ sendDirectContactMessages user ct events = do
   if v >= batchSend2Version
     then sendDirectContactMessages' user ct events
     else forM (L.toList events) $ \evt ->
-      (Right . fst <$> sendDirectContactMessage user ct evt) `catchChatError` \e -> pure (Left e)
+      (Right . fst <$> sendDirectContactMessage user ct evt) `catchAllErrors` \e -> pure (Left e)
 
 sendDirectContactMessages' :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage]
 sendDirectContactMessages' user ct events = do
@@ -1856,7 +1856,7 @@ sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope
 sendGroupMessages user gInfo scope members events = do
   -- TODO [knocking] send current profile to pending member after approval?
   when shouldSendProfileUpdate $
-    sendProfileUpdate `catchChatError` eToView
+    sendProfileUpdate `catchAllErrors` eToView
   sendGroupMessages_ user gInfo members events
   where
     User {profile = p, userMemberProfileUpdatedAt} = user
@@ -2013,7 +2013,7 @@ memberSendAction gInfo events members m@GroupMember {memberRole, memberStatus} =
 sendGroupMemberMessage :: MsgEncodingI e => GroupInfo -> GroupMember -> ChatMsgEvent e -> Maybe Int64 -> CM () -> CM ()
 sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} chatMsgEvent introId_ postDeliver = do
   msg <- createSndMessage chatMsgEvent (GroupId groupId)
-  messageMember msg `catchChatError` eToView
+  messageMember msg `catchAllErrors` eToView
   where
     messageMember :: SndMessage -> CM ()
     messageMember SndMessage {msgId, msgBody} = forM_ (memberSendAction gInfo (chatMsgEvent :| []) [m] m) $ \case
@@ -2054,7 +2054,7 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta
       rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta}
   msg <-
     withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery $ Just amGroupMemId)
-      `catchChatError` \e -> case e of
+      `catchAllErrors` \e -> case e of
         ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do
           vr <- chatVersionRange
           fm <- withStore $ \db -> getGroupMember db vr user groupId forwardedByGroupMemberId
@@ -2070,7 +2070,7 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {me
       fwdMemberId = Just $ groupMemberId' forwardingMember
       refAuthorId = Just $ groupMemberId' refAuthorMember
   withStore (\db -> createNewRcvMessage db (GroupId groupId) newMsg sharedMsgId_ refAuthorId fwdMemberId)
-    `catchChatError` \e -> case e of
+    `catchAllErrors` \e -> case e of
       ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do
         vr <- chatVersionRange
         am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db vr user groupId authorGroupMemberId
@@ -2213,7 +2213,7 @@ deleteAgentConnectionAsync acId = deleteAgentConnectionAsync' acId False
 
 deleteAgentConnectionAsync' :: ConnId -> Bool -> CM ()
 deleteAgentConnectionAsync' acId waitDelivery = do
-  withAgent (\a -> deleteConnectionAsync a waitDelivery acId) `catchChatError` eToView
+  withAgent (\a -> deleteConnectionAsync a waitDelivery acId) `catchAllErrors` eToView
 
 deleteAgentConnectionsAsync :: [ConnId] -> CM ()
 deleteAgentConnectionsAsync acIds = deleteAgentConnectionsAsync' acIds False
@@ -2222,7 +2222,7 @@ deleteAgentConnectionsAsync acIds = deleteAgentConnectionsAsync' acIds False
 deleteAgentConnectionsAsync' :: [ConnId] -> Bool -> CM ()
 deleteAgentConnectionsAsync' [] _ = pure ()
 deleteAgentConnectionsAsync' acIds waitDelivery = do
-  withAgent (\a -> deleteConnectionsAsync a waitDelivery acIds) `catchChatError` eToView
+  withAgent (\a -> deleteConnectionsAsync a waitDelivery acIds) `catchAllErrors` eToView
 
 agentXFTPDeleteRcvFile :: RcvFileId -> FileTransferId -> CM ()
 agentXFTPDeleteRcvFile aFileId fileId = do
@@ -2271,7 +2271,7 @@ agentXFTPDeleteSndFilesRemote user sndFiles = do
       case privateSndFileDescr of
         Nothing -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr
         Just sfdText ->
-          tryChatError' (parseFileDescription sfdText) >>= \case
+          tryAllErrors' (parseFileDescription sfdText) >>= \case
             Left _ -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr
             Right sfd -> partitionSndDescr xsfs filesWithoutDescr ((aFileId, sfd) : filesWithDescr)
 

src/Simplex/Chat/Library/Subscriber.hs

@@ -103,7 +103,7 @@ processAgentMessage corrId connId msg = do
     vr <- chatVersionRange
     -- getUserByAConnId never throws logical errors, only SEDBBusyError can be thrown here
     critical (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case
-      Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` eToView
+      Just user -> processAgentMessageConn vr user corrId connId msg `catchAllErrors` eToView
       _ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
 
 -- CRITICAL error will be shown to the user as alert with restart button in Android/desktop apps.
@@ -115,7 +115,7 @@ processAgentMessage corrId connId msg = do
 -- Full app restart is likely to resolve database condition and the message will be received and processed again.
 critical :: CM a -> CM a
 critical a =
-  a `catchChatError` \case
+  a `catchAllErrors` \case
     ChatErrorStore SEDBBusyError {message} -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing
     e -> throwError e
 
@@ -156,7 +156,7 @@ processAgentMsgSndFile _corrId aFileId msg = do
   (cRef_, fileId) <- withStore (`getXFTPSndFileDBIds` AgentSndFileId aFileId)
   withEntityLock_ cRef_ . withFileLock "processAgentMsgSndFile" fileId $
     withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case
-      Just user -> process user fileId `catchChatError` eToView
+      Just user -> process user fileId `catchAllErrors` eToView
       _ -> do
         lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
         throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId
@@ -298,7 +298,7 @@ processAgentMsgRcvFile _corrId aFileId msg = do
   (cRef_, fileId) <- withStore (`getXFTPRcvFileDBIds` AgentRcvFileId aFileId)
   withEntityLock_ cRef_ . withFileLock "processAgentMsgRcvFile" fileId $
     withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case
-      Just user -> process user fileId `catchChatError` eToView
+      Just user -> process user fileId `catchAllErrors` eToView
       _ -> do
         lift $ withAgent' (`xftpDeleteRcvFile` aFileId)
         throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId
@@ -472,10 +472,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           withAckMessage "contact msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do
             let MsgMeta {pqEncryption} = msgMeta
             (ct', conn') <- updateContactPQRcv user ct conn pqEncryption
-            checkIntegrityCreateItem (CDDirectRcv ct') msgMeta `catchChatError` \_ -> pure ()
+            checkIntegrityCreateItem (CDDirectRcv ct') msgMeta `catchAllErrors` \_ -> pure ()
             forM_ aChatMsgs $ \case
               Right (ACMsg _ chatMsg) ->
-                processEvent ct' conn' tags eInfo chatMsg `catchChatError` \e -> eToView e
+                processEvent ct' conn' tags eInfo chatMsg `catchAllErrors` \e -> eToView e
               Left e -> do
                 atomically $ modifyTVar' tags ("error" :)
                 logInfo $ "contact msg=error " <> eInfo <> " " <> tshow e
@@ -537,7 +537,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               -- [async agent commands] no continuation needed, but command should be asynchronous for stability
               allowAgentConnectionAsync user conn'' confId XOk
             XInfo profile -> do
-              ct' <- processContactProfileUpdate ct profile False `catchChatError` const (pure ct)
+              ct' <- processContactProfileUpdate ct profile False `catchAllErrors` const (pure ct)
               -- [incognito] send incognito profile
               incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
               let p = userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True
@@ -897,12 +897,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         withAckMessage "group msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do
           -- possible improvement is to choose scope based on event (some events specify scope)
           (gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m
-          checkIntegrityCreateItem (CDGroupRcv gInfo' scopeInfo m') msgMeta `catchChatError` \_ -> pure ()
+          checkIntegrityCreateItem (CDGroupRcv gInfo' scopeInfo m') msgMeta `catchAllErrors` \_ -> pure ()
           (fwdScopesMsgs, shouldDelConns) <- foldM (processAChatMsg gInfo' m' tags eInfo) (M.empty, False) aChatMsgs
           when (isUserGrpFwdRelay gInfo') $ do
             unless (blockedByAdmin m) $
               forM_ (M.assocs fwdScopesMsgs) $ \(groupForwardScope, fwdMsgs) ->
-                forwardMsgs groupForwardScope (L.reverse fwdMsgs) `catchChatError` eToView
+                forwardMsgs groupForwardScope (L.reverse fwdMsgs) `catchAllErrors` eToView
             when shouldDelConns $ deleteGroupConnections gInfo' True
           withRcpt <- checkSendRcpt $ rights aChatMsgs
           pure (withRcpt, shouldDelConns)
@@ -920,7 +920,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           processAChatMsg gInfo' m' tags eInfo (fwdScopeMap, shouldDelConns) = \case
             Right (ACMsg SJson chatMsg) -> do
               (cmFwdScope_, cmShouldDelConns) <-
-                processEvent gInfo' m' tags eInfo chatMsg `catchChatError` \e -> eToView e $> (Nothing, False)
+                processEvent gInfo' m' tags eInfo chatMsg `catchAllErrors` \e -> eToView e $> (Nothing, False)
               let fwdScopeMap' =
                     case cmFwdScope_ of
                       Nothing -> fwdScopeMap
@@ -928,7 +928,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                   shouldDelConns' = shouldDelConns || cmShouldDelConns
               pure (fwdScopeMap', shouldDelConns')
             Right (ACMsg SBinary chatMsg) -> do
-              void (processEvent gInfo' m' tags eInfo chatMsg) `catchChatError` \e -> eToView e
+              void (processEvent gInfo' m' tags eInfo chatMsg) `catchAllErrors` \e -> eToView e
               pure (fwdScopeMap, shouldDelConns)
             Left e -> do
               atomically $ modifyTVar' tags ("error" :)
@@ -1559,7 +1559,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       -- 3) show screen of death to the user asking to restart
       eInfo <- eventInfo
       logInfo $ label <> ": " <> eInfo
-      tryChatError (action eInfo) >>= \case
+      tryAllErrors (action eInfo) >>= \case
         Right (withRcpt, shouldDelConns) ->
           unless shouldDelConns $ withLog (eInfo <> " ok") $ ackMsg msgMeta $ if withRcpt then Just "" else Nothing
         -- If showCritical is True, then these errors don't result in ACK and show user visible alert
@@ -1666,7 +1666,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
 
     sendProbeHashes :: [ContactOrMember] -> Probe -> Int64 -> CM ()
     sendProbeHashes cgms probe probeId =
-      forM_ cgms $ \cgm -> sendProbeHash cgm `catchChatError` \_ -> pure ()
+      forM_ cgms $ \cgm -> sendProbeHash cgm `catchAllErrors` \_ -> pure ()
       where
         probeHash = ProbeHash $ C.sha256Hash (unProbe probe)
         sendProbeHash :: ContactOrMember -> CM ()
@@ -1738,7 +1738,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               -- in processFDMessage some paths are programmed as errors,
               -- for example failure on not approved relays (CEFileNotApproved).
               -- we catch error, so that even if processFDMessage fails, message can still be forwarded.
-              processFDMessage fileId aci fileDescr `catchChatError` \_ -> pure ()
+              processFDMessage fileId aci fileDescr `catchAllErrors` \_ -> pure ()
               pure $ Just $ toGroupForwardScope g scopeInfo
             else
               messageError "x.msg.file.descr: file of another member" $> Nothing
@@ -1900,7 +1900,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
 
     catchCINotFound :: CM a -> (SharedMsgId -> CM a) -> CM a
     catchCINotFound f handle =
-      f `catchChatError` \case
+      f `catchAllErrors` \case
         ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId
         e -> throwError e
 
@@ -2497,7 +2497,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         probeMatches :: [ContactOrMember] -> ContactOrMember -> CM ()
         probeMatches [] _ = pure ()
         probeMatches (cgm1' : cgm1s') cgm2' = do
-          cgm2''_ <- probeMatch cgm1' cgm2' probe `catchChatError` \_ -> pure (Just cgm2')
+          cgm2''_ <- probeMatch cgm1' cgm2' probe `catchAllErrors` \_ -> pure (Just cgm2')
           let cgm2'' = fromMaybe cgm2' cgm2''_
           probeMatches cgm1s' cgm2''
 
@@ -3225,7 +3225,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
 
     directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM ()
     directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
-      checkIntegrityCreateItem (CDDirectRcv ct) msgMeta `catchChatError` \_ -> pure ()
+      checkIntegrityCreateItem (CDDirectRcv ct) msgMeta `catchAllErrors` \_ -> pure ()
       forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
         withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus
         updateDirectItemStatus ct conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
@@ -3233,7 +3233,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM ()
     groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do
       (gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m
-      checkIntegrityCreateItem (CDGroupRcv gInfo' scopeInfo m') msgMeta `catchChatError` \_ -> pure ()
+      checkIntegrityCreateItem (CDGroupRcv gInfo' scopeInfo m') msgMeta `catchAllErrors` \_ -> pure ()
       forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
         withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus
         updateGroupItemsStatus gInfo' m' conn agentMsgId (GSSRcvd msgRcptStatus) Nothing

src/Simplex/Chat/Remote.hs

@@ -175,13 +175,13 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
       pure hostInfo
     handleConnectError :: RHKey -> SessionSeq -> CM a -> CM a
     handleConnectError rhKey sessSeq action =
-      action `catchChatError` \err -> do
+      action `catchAllErrors` \err -> do
         logError $ "startRemoteHost.rcConnectHost crashed: " <> tshow err
         cancelRemoteHostSession (Just (sessSeq, RHSRConnectionFailed err)) rhKey
         throwError err
     handleHostError :: SessionSeq -> TVar RHKey -> CM () -> CM ()
     handleHostError sessSeq rhKeyVar action =
-      action `catchChatError` \err -> do
+      action `catchAllErrors` \err -> do
         logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err
         readTVarIO rhKeyVar >>= cancelRemoteHostSession (Just (sessSeq, RHSRCrashed err))
     waitForHostSession :: Maybe RemoteHostInfo -> RHKey -> SessionSeq -> Maybe RCCtrlAddress -> TVar RHKey -> RCStepTMVar (ByteString, TLS 'TServer, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> CM ()
@@ -411,7 +411,7 @@ findKnownRemoteCtrl = do
     atomically $ takeTMVar cmdOk
     (RCCtrlPairing {ctrlFingerprint}, inv@(RCVerifiedInvitation RCInvitation {app})) <-
       timeoutThrow (ChatErrorRemoteCtrl RCETimeout) discoveryTimeout . withAgent $ \a -> rcDiscoverCtrl a pairings
-    ctrlAppInfo_ <- (Just <$> parseCtrlAppInfo app) `catchChatError` const (pure Nothing)
+    ctrlAppInfo_ <- (Just <$> parseCtrlAppInfo app) `catchAllErrors` const (pure Nothing)
     rc <-
       withStore' (`getRemoteCtrlByFingerprint` ctrlFingerprint) >>= \case
         Nothing -> throwChatError $ CEInternalError "connecting with a stored ctrl"
@@ -500,11 +500,11 @@ parseCtrlAppInfo ctrlAppInfo = do
 handleRemoteCommand :: (ByteString -> Int -> CM' (Either ChatError ChatResponse)) -> RemoteCrypto -> TBQueue (Either ChatError ChatEvent) -> HTTP2Request -> CM' ()
 handleRemoteCommand execCC encryption remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
   logDebug "handleRemoteCommand"
-  liftIO (tryRemoteError' parseRequest) >>= \case
+  liftIO (tryAllErrors' parseRequest) >>= \case
     Right (rfKN, getNext, rc) -> do
       chatReadVar' currentUser >>= \case
         Nothing -> replyError $ ChatError CENoActiveUser
-        Just user -> processCommand user rfKN getNext rc `catchChatError'` replyError
+        Just user -> processCommand user rfKN getNext rc `catchAllErrors'` replyError
     Left e -> reply $ RRProtocolError e
   where
     parseRequest :: ExceptT RemoteProtocolError IO (C.SbKeyNonce, GetChunk, RemoteCommand)
@@ -523,7 +523,7 @@ handleRemoteCommand execCC encryption remoteOutputQ HTTP2Request {request, reqBo
     replyWith :: Respond
     replyWith rr attach = do
       (corrId, cmdKN, sfKN) <- atomically $ getRemoteSndKeys encryption
-      liftIO (tryRemoteError' . encryptEncodeHTTP2Body corrId cmdKN encryption $ J.encode rr) >>= \case
+      liftIO (tryAllErrors' . encryptEncodeHTTP2Body corrId cmdKN encryption $ J.encode rr) >>= \case
         Right resp -> liftIO . sendResponse . responseStreaming N.status200 [] $ \send flush -> do
           send resp
           attach sfKN send
@@ -542,14 +542,6 @@ type Respond = RemoteResponse -> (C.SbKeyNonce -> SendChunk -> IO ()) -> CM' ()
 liftRC :: ExceptT RemoteProtocolError IO a -> CM a
 liftRC = liftError (ChatErrorRemoteCtrl . RCEProtocolError)
 
-tryRemoteError :: ExceptT RemoteProtocolError IO a -> ExceptT RemoteProtocolError IO (Either RemoteProtocolError a)
-tryRemoteError = tryAllErrors (RPEException . tshow)
-{-# INLINE tryRemoteError #-}
-
-tryRemoteError' :: ExceptT RemoteProtocolError IO a -> IO (Either RemoteProtocolError a)
-tryRemoteError' = tryAllErrors' (RPEException . tshow)
-{-# INLINE tryRemoteError' #-}
-
 handleSend :: (ByteString -> Int -> CM' (Either ChatError ChatResponse)) -> Text -> Int -> CM' RemoteResponse
 handleSend execCC command retryNum = do
   logDebug $ "Send: " <> tshow command
@@ -573,7 +565,7 @@ handleStoreFile rfKN fileName fileSize fileDigest getChunk =
       Just ff -> takeFileName <$$> storeFileTo ff
       Nothing -> storeFileTo =<< getDefaultFilesFolder
     storeFileTo :: FilePath -> CM' (Either RemoteProtocolError FilePath)
-    storeFileTo dir = liftIO . tryRemoteError' $ do
+    storeFileTo dir = liftIO . tryAllErrors' $ do
       filePath <- liftIO $ dir `uniqueCombine` fileName
       receiveEncryptedFile rfKN getChunk fileSize fileDigest filePath
       pure filePath
@@ -586,7 +578,7 @@ handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fi
   withStore $ \db -> do
     cf <- getLocalCryptoFile db commandUserId fileId sent
     unless (cf == cf') $ throwError $ SEFileNotFound fileId
-  liftRC (tryRemoteError $ getFileInfo path) >>= \case
+  liftRC (tryAllErrors $ getFileInfo path) >>= \case
     Left e -> lift $ reply (RRProtocolError e) $ \_ _ -> pure ()
     Right (fileSize, fileDigest) ->
       lift . withFile path ReadMode $ \h -> do
@@ -658,7 +650,7 @@ stopRemoteCtrl = cancelActiveRemoteCtrl Nothing
 
 handleCtrlError :: SessionSeq -> (ChatError -> RemoteCtrlStopReason) -> Text -> CM a -> CM a
 handleCtrlError sseq mkReason name action =
-  action `catchChatError` \e -> do
+  action `catchAllErrors` \e -> do
     logError $ name <> " remote ctrl error: " <> tshow e
     cancelActiveRemoteCtrl $ Just (sseq, mkReason e)
     throwError e

src/Simplex/Chat/Remote/Types.hs

@@ -28,6 +28,7 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON
 import Simplex.Messaging.Transport (TLS (..), TSbChainKeys (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (AnyError (..), tshow)
 import Simplex.RemoteControl.Client
 import Simplex.RemoteControl.Types
 
@@ -155,6 +156,9 @@ data RemoteProtocolError
   | RPEException {someException :: Text}
   deriving (Show, Exception)
 
+instance AnyError RemoteProtocolError where
+  fromSomeException = RPEException . tshow
+
 type RemoteHostId = Int64
 
 data RHKey = RHNew | RHId {remoteHostId :: RemoteHostId}

src/Simplex/Chat/Store/Shared.hs

@@ -46,6 +46,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..))
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
+import Simplex.Messaging.Util (AnyError (..))
 import Simplex.Messaging.Version
 import UnliftIO.STM
 #if defined(dbPostgres)
@@ -149,6 +150,10 @@ data StoreError
   | SEInvalidMention
   deriving (Show, Exception)
 
+instance AnyError StoreError where
+  fromSomeException = SEInternalError . show
+  {-# INLINE fromSomeException #-}
+
 $(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
 
 insertedRowId :: DB.Connection -> IO Int64