dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-04-14 05:16:01 +00:00
Code Issues Packages Projects Releases Wiki Activity

agent: make agent workers usable from other contexts (#1614)

Browse Source
This commit is contained in:
Evgeny
2025-08-29 08:33:55 +01:00
committed by GitHub
parent a2d777bda0
commit beafac1f73
12 changed files with 119 additions and 160 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/Simplex/RemoteControl/Client.hs
View File

@@ -306,14 +306,8 @@ connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca,
atomically $ takeTMVar endSession
logDebug "Session ended"
catchRCError :: ExceptT RCErrorType IO a -> (RCErrorType -> ExceptT RCErrorType IO a) -> ExceptT RCErrorType IO a
catchRCError = catchAllErrors $ \e -> case fromException e of
Just (TLS.Terminated _ _ (TLS.Error_Protocol _ TLS.UnknownCa)) -> RCEIdentity
_ -> RCEException $ show e
{-# INLINE catchRCError #-}
putRCError :: ExceptT RCErrorType IO a -> TMVar (Either RCErrorType b) -> ExceptT RCErrorType IO a
a `putRCError` r = a `catchRCError` \e -> atomically (tryPutTMVar r $ Left e) >> throwE e
a `putRCError` r = a `catchAllErrors` \e -> atomically (tryPutTMVar r $ Left e) >> throwE e
sendRCPacket :: Encoding a => TLS p -> a -> ExceptT RCErrorType IO ()
sendRCPacket tls pkt = do
@@ -395,7 +389,7 @@ discoverRCCtrl subscribers pairings =
pure r
where
loop :: ExceptT RCErrorType IO a -> ExceptT RCErrorType IO a
loop action = action `catchRCError` \e -> logError (tshow e) >> loop action
loop action = action `catchAllErrors` \e -> logError (tshow e) >> loop action
findRCCtrlPairing :: NonEmpty RCCtrlPairing -> RCEncInvitation -> ExceptT RCErrorType IO (RCCtrlPairing, RCVerifiedInvitation)
findRCCtrlPairing pairings RCEncInvitation {dhPubKey, nonce, encInvitation} = do

9
src/Simplex/RemoteControl/Types.hs
View File

@@ -19,6 +19,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word16)
import qualified Data.X509 as X
import qualified Network.TLS as TLS
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.SNTRUP761.Bindings
import Simplex.Messaging.Encoding
@@ -26,7 +27,7 @@ import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
import Simplex.Messaging.Transport (TLS, TSbChainKeys, TransportPeer (..))
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (safeDecodeUtf8)
import Simplex.Messaging.Util (AnyError (..), safeDecodeUtf8)
import Simplex.Messaging.Version (VersionRange, VersionScope, mkVersionRange)
import Simplex.Messaging.Version.Internal
import UnliftIO
@@ -50,6 +51,12 @@ data RCErrorType
| RCESyntax {syntaxErr :: String}
deriving (Eq, Show, Exception)
instance AnyError RCErrorType where
fromSomeException e = case fromException e of
Just (TLS.Terminated _ _ (TLS.Error_Protocol _ TLS.UnknownCa)) -> RCEIdentity
_ -> RCEException $ show e
{-# INLINE fromSomeException #-}
instance StrEncoding RCErrorType where
strEncode = \case
RCEInternal err -> "INTERNAL" <> text err