Add tests for rollback and RW consistency

gargantext.cabal

@@ -764,9 +764,9 @@ common commonTestDependencies
     , postgres-options >= 0.2 && < 0.3
     , postgresql-simple >= 0.6.4 && <= 0.7.0.0
     , quickcheck-instances ^>= 0.3.25.2
+    , random
     , raw-strings-qq
     , resource-pool >= 0.4.0.0 && < 0.5
-    , recover-rtti
     , safe-exceptions >= 0.1.7.4 && < 0.2
     , servant-auth-client
     , servant-client >= 0.20 && < 0.21

test/Test/Database/Transactions.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE TupleSections        #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 {-| Tests for the transactional DB API -}
 
@@ -9,6 +10,7 @@ module Test.Database.Transactions (
      tests
   ) where
 
+import System.Random.Stateful
 import Control.Exception.Safe
 import Control.Exception.Safe qualified as Safe
 import Control.Monad.Reader
@@ -32,6 +34,7 @@ import Test.Database.Types hiding (Counter)
 import Test.Hspec
 import Test.Tasty.HUnit hiding (assert)
 import Text.RawString.QQ
+import Control.Concurrent.Async (forConcurrently)
 
 --
 -- For these tests we do not want to test the normal GGTX database queries, but rather
@@ -170,6 +173,10 @@ tests = parallel $ around withTestCounterDB $
       it "Simple updates works" simplePGUpdateWorks
     describe "PG Queries and Updates" $ do
       it "Supports mixing queries and updates" mixQueriesAndUpdates
+    describe "Rollback support" $ do
+      it "can rollback in case of errors" testRollback
+    describe "Read/Write Consistency" $ do
+      it "should return a consistent state to different actors" testConsistency
 
 simplePGQueryWorks :: DBHandle -> Assertion
 simplePGQueryWorks env = flip runReaderT env $ runTestMonad $ do
@@ -197,3 +204,37 @@ mixQueriesAndUpdates env = flip runReaderT env $ runTestMonad $ do
   liftIO $ do
     final_1 `shouldBe` (Counter (CounterId 2) 0)
     final_2 `shouldBe` (Counter (CounterId 3) 1)
+
+testRollback :: DBHandle -> Assertion
+testRollback env = flip runReaderT env $ runTestMonad $ do
+  initialCounter <- runDBTx $ insertCounter >>= stepCounter . counterId
+  liftIO $ counterValue initialCounter `shouldBe` 1
+  -- Let's do another transaction where at the very last instruction we
+  -- fail.
+  Safe.handle (\(_ :: SomeException) -> pure ()) $ runDBTx $ do
+    _x' <- stepCounter (counterId initialCounter)
+    dbFail (Prelude.userError "urgh")
+
+  -- Let's check that the second 'stepCounter' didn't actually modified the counter's value.
+  finalCounter <- runDBTx $ getCounterById (counterId initialCounter)
+  liftIO $ counterValue finalCounter `shouldBe` 1
+
+-- | In this test we create concurrent actors all writing to the /same/ counter.
+-- Each one should observe only the state it's updating.
+testConsistency :: DBHandle -> Assertion
+testConsistency env = do
+
+  let competing_actors = 10
+  initialCounter <- flip runReaderT env $ runTestMonad $ runDBTx insertCounter
+
+  results <- forConcurrently [ 1 .. competing_actors ] $ \x -> flip runReaderT env $ runTestMonad $ do
+    -- random delay
+    liftIO $ do
+      delay_us <- uniformRM (100, 2_000_000) globalStdGen
+      threadDelay delay_us
+    runDBTx $ do
+      _ <- updateCounter (counterId initialCounter) x
+      getCounterById (counterId initialCounter)
+
+  -- Each actor should observe a consistent state.
+  liftIO $ results `shouldBe` map (Counter (CounterId 2)) [ 1 .. competing_actors ]