From 532cd2f39c7c22da19a47424eaefa7eafb0aeff8 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 9 Jul 2023 21:36:23 +0100
Subject: [PATCH] fix allFinally

---
 src/Simplex/Messaging/Agent/Env/SQLite.hs | 2 +-
 src/Simplex/Messaging/Util.hs             | 4 ++--
 tests/CoreTests/UtilTests.hs              | 4 ++--
 3 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index ad1d882bb..5e779cc22 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -239,7 +239,7 @@ catchAgentError :: AgentMonad m => m a -> (AgentErrorType -> m a) -> m a
 catchAgentError = catchAllErrors mkInternal
 {-# INLINE catchAgentError #-}
 
-agentFinally :: AgentMonad m => m a -> m a -> m a
+agentFinally :: AgentMonad m => m a -> m b -> m a
 agentFinally = allFinally mkInternal
 {-# INLINE agentFinally #-}
 
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index aecb59aa3..3a0113b71 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -111,8 +111,8 @@ catchThrow :: (MonadUnliftIO m, MonadError e m) => m a -> (E.SomeException -> e)
 catchThrow action err  = catchAllErrors err action throwError
 {-# INLINE catchThrow #-}
 
-allFinally :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> m a -> m a
-allFinally err action final = tryAllErrors err action >>= either (\e -> final >> throwError e) (const final)
+allFinally :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> m b -> m a
+allFinally err action final = tryAllErrors err action >>= \r -> final >> either throwError pure r
 {-# INLINE allFinally #-}
 
 eitherToMaybe :: Either a b -> Maybe b
diff --git a/tests/CoreTests/UtilTests.hs b/tests/CoreTests/UtilTests.hs
index f3c78c07b..ded4d9aad 100644
--- a/tests/CoreTests/UtilTests.hs
+++ b/tests/CoreTests/UtilTests.hs
@@ -84,7 +84,7 @@ utilTests = do
     it "then throw SomeException as ExceptT error" $ withFinal $ \final ->
       runExceptT (allFinally testErr throwTestException final) `shouldReturn` Left (TestException "user error (error)")
     it "and should not throw if there are no exceptions" $ withFinal $ \final ->
-      runExceptT (allFinally testErr noErrors final) `shouldReturn` Right "final"
+      runExceptT (allFinally testErr noErrors final) `shouldReturn` Right "no errors"
   describe "allFinally specialized as testFinally should run final action" $ do
     let testFinally = allFinally testErr
     it "then throw ExceptT error" $ withFinal $ \final ->
@@ -92,7 +92,7 @@ utilTests = do
     it "then throw SomeException as ExceptT error" $ withFinal $ \final ->
       runExceptT (throwTestException `testFinally` final) `shouldReturn` Left (TestException "user error (error)")
     it "and should not throw if there are no exceptions" $ withFinal $ \final ->
-      runExceptT (noErrors `testFinally` final) `shouldReturn` Right "final"
+      runExceptT (noErrors `testFinally` final) `shouldReturn` Right "no errors"
   where
     throwTestError :: ExceptT TestError IO String
     throwTestError = throwError $ TestError "error"