better MonadUnliftIO instance for ExceptT; fix tests

src/Simplex/Messaging/Util.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE RankNTypes #-}
+
 module Simplex.Messaging.Util where
 
 import Control.Monad.Except
@@ -6,10 +9,17 @@ import UnliftIO.Async
 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 inner = ExceptT . E.try $
-    withRunInIO $ \run ->
-      inner (run . (either E.throwIO pure <=< runExceptT))
+  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)
 
 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
 raceAny_ = r []

tests/AgentTests/SQLite.hs

@@ -8,6 +8,7 @@ import Control.Monad.Except
 import qualified Database.SQLite.Simple as DB
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
+import Simplex.Messaging.Agent.Store.Types
 import Simplex.Messaging.Agent.Transmission
 import Test.Hspec
 import UnliftIO.Directory