diff --git a/simplexmq.cabal b/simplexmq.cabal index 6a39cc028..4011dda0a 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -34,7 +34,6 @@ library Simplex.Messaging.Agent Simplex.Messaging.Agent.Client Simplex.Messaging.Agent.Env.SQLite - Simplex.Messaging.Agent.ExceptT Simplex.Messaging.Agent.Protocol Simplex.Messaging.Agent.QueryString Simplex.Messaging.Agent.RetryInterval diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index b9aecd401..69adeb4c4 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -2,11 +2,14 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Simplex.Messaging.Agent.Client ( AgentClient (..), @@ -50,7 +53,6 @@ import Data.Set (Set) import qualified Data.Set as S import Data.Text.Encoding import Simplex.Messaging.Agent.Env.SQLite -import Simplex.Messaging.Agent.ExceptT () import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Agent.Store @@ -61,7 +63,7 @@ import Simplex.Messaging.Protocol (QueueId, QueueIdsKeys (..), SndPublicVerifyKe import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Util (bshow, liftEitherError, liftError) import Simplex.Messaging.Version -import UnliftIO.Exception (IOException) +import UnliftIO.Exception (Exception, IOException) import qualified UnliftIO.Exception as E import UnliftIO.STM @@ -102,6 +104,18 @@ newAgentClient agentEnv = do -- | Agent monad with MonadReader Env and MonadError AgentErrorType type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m) +newtype InternalException e = InternalException {unInternalException :: e} + deriving (Eq, Show) + +instance Exception e => Exception (InternalException e) + +instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where + withRunInIO :: ((forall a. ExceptT e m a -> IO a) -> IO b) -> ExceptT e m b + withRunInIO exceptToIO = + withExceptT unInternalException . ExceptT . E.try $ + withRunInIO $ \run -> + exceptToIO $ run . (either (E.throwIO . InternalException) return <=< runExceptT) + getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPServer -> m SMPClient getSMPServerClient c@AgentClient {smpClients, msgQ} srv = readTVarIO smpClients diff --git a/src/Simplex/Messaging/Agent/ExceptT.hs b/src/Simplex/Messaging/Agent/ExceptT.hs deleted file mode 100644 index 9fccaaadd..000000000 --- a/src/Simplex/Messaging/Agent/ExceptT.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Simplex.Messaging.Agent.ExceptT where - -import Control.Monad.Except -import Control.Monad.IO.Unlift -import UnliftIO.Exception (Exception) -import qualified UnliftIO.Exception as E - -newtype InternalException e = InternalException {unInternalException :: e} - deriving (Eq, Show) - -instance Exception e => Exception (InternalException e) - -instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where - withRunInIO :: ((forall a. ExceptT e m a -> IO a) -> IO b) -> ExceptT e m b - withRunInIO exceptToIO = - withExceptT unInternalException . ExceptT . E.try $ - withRunInIO $ \run -> - exceptToIO $ run . (either (E.throwIO . InternalException) return <=< runExceptT) diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 350c6f808..2bbbbe884 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -21,7 +21,7 @@ import Data.Word (Word32) import qualified Database.SQLite.Simple as DB import Database.SQLite.Simple.QQ (sql) import SMPClient (testKeyHash) -import Simplex.Messaging.Agent.ExceptT () +import Simplex.Messaging.Agent.Client () import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store import Simplex.Messaging.Agent.Store.SQLite