Add and document catchDBTxError and handleDBTxError

src/Gargantext/Database/Transactional.hs

@@ -33,8 +33,10 @@ module Gargantext.Database.Transactional (
   , mkOpaInsert
   , mkOpaDelete
 
-  -- * Throwing errors (which allows rollbacks)
+  -- * Throwing and catching errors (which allows rollbacks)
   , dbFail
+  , catchDBTxError
+  , handleDBTxError
   ) where
 
 import Control.Exception.Safe qualified as Safe
@@ -190,6 +192,12 @@ runDBTx (DBTx m) = do
   pool <- view connPool
   withResourceM pool $ \conn ->
     (withTransactionM conn $ foldF (evalOp conn) m)
+      -- IMPORTANT: We are catching the exception (after 'withTransactionM' has run, so rollback already
+      -- happened) and we are rethrowing this via 'throwError', such that application code can catch this
+      -- via 'catchDBTxError'.
+      -- /NOTA BENE/: the parenthesis around 'withTransactionM' ARE NOT OPTIONAL! If we remove them, we
+      -- would be catching this exception from 'foldF', meaning that we wouldn't let 'withTransactionM'
+      -- handle it, resulting in ROLLBACK NOT HAPPENING!
       `Safe.catches`
         [ Safe.Handler $ \(RollbackRequested err) -> throwError err ]
 
@@ -200,7 +208,12 @@ runDBTx (DBTx m) = do
 runDBQuery :: (Show err, Safe.Typeable err) => DBReadOnly err r a -> DBTxCmd err a
 runDBQuery (DBTx m) = do
   pool <- view connPool
-  withResourceM pool $ \conn -> withReadOnlyTransactionM conn $ foldF (evalOp conn) m
+  withResourceM pool $ \conn ->
+    (withReadOnlyTransactionM conn $ foldF (evalOp conn) m)
+      -- IMPORTANT: Same proviso as for 'runDBTx'. Technically speaking we wouldn't need
+      -- to throw and catch things for a query, but we are doing so for consistency with 'runDBTx'.
+      `Safe.catches`
+        [ Safe.Handler $ \(RollbackRequested err) -> throwError err ]
 
 -- | The main evaluator, turns our pure operations into side-effects that run into the
 -- 'DBCmd'.
@@ -237,6 +250,49 @@ queryOne conn q v = do
     [ ] -> Safe.throwIO $ userError "queryOne: no result returned. Check your SQL!"
     _   -> Safe.throwIO $ userError "queryOne: more than one result returned. Have you used the 'RETURNING' directive?"
 
+{-
+
+Throwing and catching exceptions in a DBTx monad
+================================================
+
+It's /VERY/ important to understand the proper way to throw and catch exceptions in a DBTx monad,
+as not doing so might lead to footguns.
+
+We need to remember that when we are composing 'DBTx' operations, we are just writing a DSL which
+won't get evaluated until we call either 'runDBTx' or 'runDBQuery', therefore if some parts of
+our transaction throw an error, we wouldn't know until there.
+There are two types of errors we might have, and it's important to be precise in terminology:
+
+1. IO Exception: these are being thrown by the evaluators for SQL queries, i.e. we might have
+   IO errors being thrown by wrongly-formatted SQL queries or the Postgres DB dying on us for any reason;
+   These exceptions get caught by 'withTransactionM' which allows proper rollback behavior, but crucially
+   these kind of exceptions gets rethrown by 'withTransactionM' and must be caught via the classic
+   exception handlers in upstream code, but the crucial point is that even if we don't catch them, the
+   transaction has been rolled back successfully;
+2. Domain-specific ERRORS (not exceptions, ERRORS!) being thrown within a transaction itself via things like
+   'nodeError' and friends. These are errors which can be thrown because our transaction code didn't go as
+   planned (look for the implementation of 'insertNodeWithHyperdata' for a concrete example). These errors
+   are translated into the evaluator as proper exception but then caught and rethrown via 'throwError', which
+   is crucial, because it means that them being thrown as an exception means 'withTransactionM' can rollback
+   as we expect to, but upstream application code can still handle these errors via 'catchError' and friends.
+
+In order to facilitate the handling of this, we expose the 'catchDBTxError' and 'handleDBTxError', which are
+just wrappers over 'catchError' -- this is what users should be using if they want to handle domain-specific errors.
+
+But the crucial bit, and let's state this again, is that rollbacks will happen in both scenario, which is
+what we want.
+-}
+
+catchDBTxError :: DBTxCmd err a
+               -> (err -> DBTxCmd err a)
+               -> DBTxCmd err a
+catchDBTxError = catchError
+
+handleDBTxError :: (err -> DBTxCmd err a)
+                -> DBTxCmd err a
+                -> DBTxCmd err a
+handleDBTxError = flip catchError
+
 --
 -- Smart constructors
 --
@@ -244,9 +300,6 @@ queryOne conn q v = do
 -- we are not exposing for information hiding purposes.
 --
 
-dbFail :: err -> DBTx err r b
-dbFail = DBTx . liftF . DBFail
-
 mkPGQuery :: (PG.ToRow q, PG.FromRow a)
            => PG.Query
            -> q
@@ -279,3 +332,6 @@ mkOpaInsert a = DBTx $ liftF (OpaInsert a id)
 
 mkOpaDelete :: Delete a -> DBUpdate err a
 mkOpaDelete a = DBTx $ liftF (OpaDelete a id)
+
+dbFail :: err -> DBTx err r b
+dbFail = DBTx . liftF . DBFail

test/Test/Database/Transactions.hs

@@ -48,7 +48,6 @@ import Test.Tasty.HUnit hiding (assert)
 import Text.RawString.QQ
 import Gargantext.Database.Action.User
 import Gargantext.Database.Query.Table.Node.Error
-import Control.Monad.Except (handleError)
 
 --
 -- For these tests we do not want to test the normal GGTX database queries, but rather
@@ -265,7 +264,7 @@ testRollback env = runTestDBTxMonad env $ do
   liftIO $ counterValue initialCounter `shouldBe` 1
   -- Let's do another transaction where at the very last instruction we
   -- fail.
-  handleError (\(_ :: IOException) -> pure ()) $ runDBTx $ do
+  handleDBTxError (\(_ :: IOException) -> pure ()) $ runDBTx $ do
     _x' <- stepCounter (counterId initialCounter)
     dbFail $ Prelude.userError "urgh"
 
@@ -320,7 +319,7 @@ testGGTXErrorRollback env = runTestMonadM @NodeError env $ do
   void $ (runDBTx $ do
     void $ updateUserEmail (insertedUr { userLight_email = "alfredo@bar.com" })
     nodeError $ NoRootFound -- it doesn't matter which exception
-    ) `catchError` \(_e :: NodeError) -> pure () -- swallow it.
+    ) `catchDBTxError` \(_e :: NodeError) -> pure () -- swallow it.
 
   -- let's check that the email hasn't been changed.
   insertedUr' <- runDBQuery $ getUserLightDB (UserName "alfredo")