[tests] propose rewriting of tests

This has custom triggers as a separate step, before all tests.

src/Gargantext/API/Ngrams.hs

@@ -59,7 +59,6 @@ module Gargantext.API.Ngrams
   , r_state
   , r_history
   , NgramsRepoElement(..)
-  , saveNodeStory
   , saveNodeStoryImmediate
   , initRepo
 
@@ -173,16 +172,6 @@ mkChildrenGroups addOrRem nt patches =
 
 ------------------------------------------------------------------------
 
-saveNodeStory :: ( MonadReader env m, MonadBase IO m, HasNodeStoryImmediateSaver env )
-              => m ()
-saveNodeStory = do
-  saver <- view hasNodeStoryImmediateSaver
-  liftBase $ do
-    --Gargantext.Prelude.putStrLn "---- Running node story saver ----"
-    saver
-    --Gargantext.Prelude.putStrLn "---- Node story saver finished ----"
-
-
 saveNodeStoryImmediate :: ( MonadReader env m, MonadBase IO m, HasNodeStoryImmediateSaver env )
                        => m ()
 saveNodeStoryImmediate = do
@@ -268,7 +257,7 @@ setListNgrams listId ngramsType ns = do
                Nothing -> Just ns
                Just ns' -> Just $ ns <> ns')
       ) nls
-  saveNodeStory
+  saveNodeStoryImmediate
 
 
 newNgramsFromNgramsStatePatch :: NgramsStatePatch' -> [Ngrams]

src/Gargantext/Core/NodeStory.hs

@@ -78,9 +78,6 @@ module Gargantext.Core.NodeStory
   , a_version
   , nodeExists
   , runPGSQuery
-  , runPGSAdvisoryLock
-  , runPGSAdvisoryUnlock
-  , runPGSAdvisoryXactLock
   , getNodesIdWithType
   , fromDBNodeStoryEnv
   , upsertNodeStories
@@ -449,6 +446,7 @@ insertArchiveStateList c nodeId version as = do
     query :: PGS.Query
     query = [sql|INSERT INTO node_stories(node_id, ngrams_id, version, ngrams_type_id, ngrams_repo_element)
                 VALUES (?, ?, ?, ?, ? :: jsonb)
+                ON CONFLICT DO NOTHING
                 |]
 
 deleteArchiveStateList :: PGS.Connection -> NodeId -> ArchiveStateList -> IO ()
@@ -474,8 +472,8 @@ updateArchiveStateList c nodeId version as = do
                   |]
 
 -- | This function updates the node story and archive for given node_id.
-updateNodeStory :: PGS.Connection -> NodeId -> ArchiveList -> ArchiveList -> IO ()
-updateNodeStory c nodeId currentArchive newArchive = do
+insertUpdateDeleteNodeStory :: PGS.Connection -> NodeId -> ArchiveList -> ArchiveList -> IO ()
+insertUpdateDeleteNodeStory c nodeId currentArchive newArchive = do
   -- STEPS
 
   -- 0. We assume we're inside an advisory lock
@@ -486,32 +484,32 @@ updateNodeStory c nodeId currentArchive newArchive = do
   let currentSet = archiveStateSet currentList
   let newSet = archiveStateSet newList
 
-  -- printDebug "[updateNodeStory] new - current = " $ Set.difference newSet currentSet
+  -- printDebug "[insertUpdateDeleteNodeStory] new - current = " $ Set.difference newSet currentSet
   let inserts = archiveStateListFilterFromSet (Set.difference newSet currentSet) newList
-  -- printDebug "[updateNodeStory] inserts" inserts
+  -- printDebug "[insertUpdateDeleteNodeStory] inserts" inserts
 
-  -- printDebug "[updateNodeStory] current - new" $ Set.difference currentSet newSet
+  -- printDebug "[insertUpdateDeleteNodeStory] current - new" $ Set.difference currentSet newSet
   let deletes = archiveStateListFilterFromSet (Set.difference currentSet newSet) currentList
-  -- printDebug "[updateNodeStory] deletes" deletes
+  -- printDebug "[insertUpdateDeleteNodeStory] deletes" deletes
 
   -- updates are the things that are in new but not in current
   let commonSet = Set.intersection currentSet newSet
   let commonNewList = archiveStateListFilterFromSet commonSet newList
   let commonCurrentList = archiveStateListFilterFromSet commonSet currentList
   let updates = Set.toList $ Set.difference (Set.fromList commonNewList) (Set.fromList commonCurrentList)
-  -- printDebug "[updateNodeStory] updates" $ Text.unlines $ (Text.pack . show) <$> updates
+  -- printDebug "[insertUpdateDeleteNodeStory] updates" $ Text.unlines $ (Text.pack . show) <$> updates
 
   -- 2. Perform inserts/deletes/updates
-  -- printDebug "[updateNodeStory] applying inserts" inserts
+  -- printDebug "[insertUpdateDeleteNodeStory] applying inserts" inserts
   insertArchiveStateList c nodeId (newArchive ^. a_version) inserts
-  --printDebug "[updateNodeStory] insert applied" ()
+  --printDebug "[insertUpdateDeleteNodeStory] insert applied" ()
     --TODO Use currentArchive ^. a_version in delete and report error
   -- if entries with (node_id, ngrams_type_id, ngrams_id) but
   -- different version are found.
   deleteArchiveStateList c nodeId deletes
-  --printDebug "[updateNodeStory] delete applied" ()
+  --printDebug "[insertUpdateDeleteNodeStory] delete applied" ()
   updateArchiveStateList c nodeId (newArchive ^. a_version) updates
-  --printDebug "[updateNodeStory] update applied" ()
+  --printDebug "[insertUpdateDeleteNodeStory] update applied" ()
 
   pure ()
   -- where
@@ -543,7 +541,7 @@ upsertNodeStories c nodeId newArchive = do
         _ <- insertNodeStory c nodeId newArchive
         pure ()
       Just currentArchive  -> do
-        _ <- updateNodeStory c nodeId currentArchive newArchive
+        _ <- insertUpdateDeleteNodeStory c nodeId currentArchive newArchive
         pure ()
 
     -- 3. Now we need to set versions of all node state to be the same

src/Gargantext/Database/Action/Flow/List.hs

@@ -23,7 +23,7 @@ import Data.List qualified as List
 import Data.Map.Strict (toList)
 import Data.Map.Strict qualified as Map
 import Data.Map.Strict.Patch qualified as PM
-import Gargantext.API.Ngrams (saveNodeStory)
+import Gargantext.API.Ngrams (saveNodeStoryImmediate)
 import Gargantext.API.Ngrams.Tools (getNodeStoryVar)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.NodeStory
@@ -208,4 +208,4 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
           r & unNodeStory . at listId . _Just . a_version +~ 1
             & unNodeStory . at listId . _Just . a_history %~ (p :)
             & unNodeStory . at listId . _Just . a_state . at ngramsType' .~ Just ns
-      saveNodeStory
+      saveNodeStoryImmediate

test/Test/API/Authentication.hs

@@ -21,7 +21,7 @@ import Network.HTTP.Client hiding (Proxy)
 import Prelude qualified
 import Servant.Auth.Client ()
 import Servant.Client
-import Test.API.Setup (withTestDBAndPort, setupEnvironment)
+import Test.API.Setup (withTestDBAndPort)
 import Test.Database.Types
 import Test.Hspec
 
@@ -33,8 +33,6 @@ cannedToken = "eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW1
 
 tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv
   describe "Authentication" $ do
     baseUrl <- runIO $ parseBaseUrl "http://localhost"
     manager <- runIO $ newManager defaultManagerSettings

test/Test/API/Errors.hs

@@ -11,7 +11,8 @@ import Servant
 import Servant.Auth.Client ()
 import Servant.Client
 import Test.API.Private (protected, withValidLogin, protectedNewError)
-import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob)
+import Test.API.Setup (withTestDBAndPort, mkUrl, createAliceAndBob)
+import Test.Database.Setup (MasterUserEnv(..), getMasterUserEnvOrFail)
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
 import Text.RawString.QQ (r)
@@ -21,13 +22,12 @@ tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
   describe "Errors API" $ do
     describe "Prelude" $ do
-      it "setup DB triggers and users" $ \((testEnv, port), _) -> do
-        setupEnvironment testEnv
+      it "setup DB users" $ \((testEnv, port), _) -> do
         baseUrl <- parseBaseUrl "http://localhost"
         manager <- newManager defaultManagerSettings
         let clientEnv prt = mkClientEnv manager (baseUrl { baseUrlPort = prt })
 
-        createAliceAndBob testEnv
+        void $ createAliceAndBob testEnv
 
         let ( roots_api :<|> _nodes_api
               ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token "bogus")
@@ -38,9 +38,11 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
 
     describe "GET /api/v1.0/node" $ do
 
-      it "returns the old error by default" $ \((_testEnv, port), app) -> do
+      it "returns the old error by default" $ \((testEnv, port), app) -> do
         withApplication app $ do
-          withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do
+          mue <- getMasterUserEnvOrFail testEnv
+
+          withValidLogin port (userName mue) (GargPassword $ secretKey mue) $ \token -> do
             res <- protected token "GET" (mkUrl port "/node/99") ""
             case res of
               SResponse{..}
@@ -49,9 +51,11 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                     statusCode `shouldBe` 404
                     simpleBody `shouldBe` [r|{"error":"Node does not exist","node":99}|]
 
-      it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do
+      it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((testEnv, port), app) -> do
         withApplication app $ do
-          withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do
+          mue <- getMasterUserEnvOrFail testEnv
+          
+          withValidLogin port (userName mue) (GargPassword $ secretKey mue) $ \token -> do
             res <- protectedNewError token "GET" (mkUrl port "/node/99") ""
             case res of
               SResponse{..}

test/Test/API/GraphQL.hs

@@ -8,10 +8,11 @@ module Test.API.GraphQL (
   ) where
 
 import Gargantext.Core.Types.Individu
-import Prelude
+import Gargantext.Prelude
 import Servant.Auth.Client ()
 import Test.API.Private (withValidLogin, protected, protectedNewError)
-import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob)
+import Test.API.Setup (withTestDBAndPort, createAliceAndBob)
+import Test.Database.Setup (MasterUserEnv(..), getMasterUserEnvOrFail)
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Hspec.Wai.JSON (json)
@@ -20,14 +21,12 @@ import Text.RawString.QQ (r)
 
 tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv
   describe "GraphQL" $ do
 
 
     describe "get_user_infos" $ do
       it "allows 'alice' to see her own info" $ \((testEnv, port), app) -> do
-        createAliceAndBob testEnv
+        void $ createAliceAndBob testEnv
 
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \token -> do
@@ -37,23 +36,29 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
 
 
     describe "check error format" $ do
-      it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do
+      it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((testEnv, port), app) -> do
         withApplication app $ do
-          withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do
+          mue <- getMasterUserEnvOrFail testEnv
+          
+          withValidLogin port (userName mue) (GargPassword $ secretKey mue) $ \token -> do
             let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
             let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
             protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected
 
-      it "returns the old error (though this is deprecated)" $ \((_testEnv, port), app) -> do
+      it "returns the old error (though this is deprecated)" $ \((testEnv, port), app) -> do
         withApplication app $ do
-          withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do
+          mue <- getMasterUserEnvOrFail testEnv
+          
+          withValidLogin port (userName mue) (GargPassword $ secretKey mue) $ \token -> do
             let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
             let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
             protected token "POST" "/gql" query `shouldRespondWithFragment` expected
 
-      it "check new errors with 'type'" $ \((_testEnv, port), app) -> do
+      it "check new errors with 'type'" $ \((testEnv, port), app) -> do
         withApplication app $ do
-          withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do
+          mue <- getMasterUserEnvOrFail testEnv
+
+          withValidLogin port (userName mue) (GargPassword $ secretKey mue) $ \token -> do
             let query = [r| { "query": "mutation { delete_team_membership(shared_folder_id:1, team_node_id:1, token:\"abc\") }" } |]
             let expected = [json| {"errors":[{"extensions":{"data":{"msg":"This user is not team owner","user_id":1},"diagnostic":"User not authorized. ","type":"EC_403__user_not_authorized"},"message":"User not authorized. "}]} |]
             shouldRespondWithFragmentCustomStatus 403

test/Test/API/Private.hs

@@ -36,7 +36,7 @@ import Servant.Auth.Client ()
 import Servant.Auth.Client qualified as SA
 import Servant.Client
 import Test.API.Authentication (auth_api)
-import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob)
+import Test.API.Setup (withTestDBAndPort, mkUrl, createAliceAndBob)
 import Test.Hspec
 import Test.Hspec.Wai hiding (pendingWith)
 import Test.Hspec.Wai.Internal (withApplication)
@@ -120,19 +120,18 @@ withValidLogin port ur pwd act = do
 
 tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv
   describe "Private API" $ do
     baseUrl <- runIO $ parseBaseUrl "http://localhost"
     manager <- runIO $ newManager defaultManagerSettings
     let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })
 
+    -- around setupAliceAndBob $ describe "GET /api/v1.0/user" $ do
     describe "GET /api/v1.0/user" $ do
 
       -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
       it "doesn't allow someone with an invalid token to show the results" $ \((testEnv, port), _) -> do
 
-        createAliceAndBob testEnv
+        _ <- createAliceAndBob testEnv
 
         let ( roots_api :<|> _nodes_api
               ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token "bogus")

test/Test/API/Setup.hs

@@ -3,6 +3,7 @@
 
 module Test.API.Setup where
 
+-- import Gargantext.Prelude (printDebug)
 import Control.Lens
 import Control.Monad.Reader
 import Data.ByteString (ByteString)
@@ -15,33 +16,28 @@ import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
 import Gargantext.Core.NLP
 import Gargantext.Core.NodeStory
+import Gargantext.Core.Types (UserId)
 import Gargantext.Core.Types.Individu
-import Gargantext.Database.Action.Flow
 import Gargantext.Database.Action.User.New
-import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
-import Gargantext.Database.Admin.Trigger.Init
-import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Prelude
-import Gargantext.Database.Query.Table.Node (getOrMkList)
--- import Gargantext.Prelude (printDebug)
 import Gargantext.Prelude.Config
+import Gargantext.Prelude.Mail qualified as Mail
+import Gargantext.Prelude.NLP qualified as NLP
 import Gargantext.System.Logging
+import Gargantext.Utils.Jobs qualified as Jobs
+import Gargantext.Utils.Jobs.Monad qualified as Jobs
+import Gargantext.Utils.Jobs.Queue qualified as Jobs
+import Gargantext.Utils.Jobs.Settings qualified as Jobs
 import Network.HTTP.Client.TLS (newTlsManager)
 import Network.Wai (Application)
+import Network.Wai.Handler.Warp qualified as Wai
+import Network.Wai.Handler.Warp qualified as Warp
 import Prelude
 import Servant.Auth.Client ()
 import Servant.Client
-import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo)
+import Servant.Job.Async qualified as ServantAsync
+import Test.Database.Setup (withTestDBWithTriggers, fakeIniPath, testEnvToPgConnectionInfo, MasterUserEnv)
 import Test.Database.Types
-import qualified Gargantext.Prelude.Mail as Mail
-import qualified Gargantext.Prelude.NLP as NLP
-import qualified Gargantext.Utils.Jobs as Jobs
-import qualified Gargantext.Utils.Jobs.Monad as Jobs
-import qualified Gargantext.Utils.Jobs.Queue as Jobs
-import qualified Gargantext.Utils.Jobs.Settings as Jobs
-import qualified Network.Wai.Handler.Warp         as Warp
-import qualified Network.Wai.Handler.Warp as Wai
-import qualified Servant.Job.Async as ServantAsync
 
 
 newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env
@@ -88,35 +84,28 @@ withGargApp app action = do
 
 withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
 withTestDBAndPort action =
-  withTestDB $ \testEnv -> do
+  withTestDBWithTriggers $ \testEnv -> do
     app <- withLoggerHoisted Mock $ \ioLogger -> do
              env <- newTestEnv testEnv ioLogger 8080
              makeApp env
     withGargApp app $ \port ->
       action ((testEnv, port), app)
 
-setupEnvironment :: TestEnv -> IO ()
-setupEnvironment env = flip runReaderT env $ runTestMonad $ do
-  void $ initFirstTriggers "secret_key"
-  void $ new_user $ mkNewUser (userMaster <> "@cnrs.com") (GargPassword "secret_key")
-  (masterUserId, _masterRootId, masterCorpusId)
-              <- getOrMk_RootWithCorpus (UserName userMaster)
-                                        (Left corpusMasterName)
-                                        (Nothing :: Maybe HyperdataCorpus)
-  masterListId <- getOrMkList masterCorpusId masterUserId
-  -- printDebug "[setupEnvironment] masterListId: " masterListId
-  void $ initLastTriggers masterListId
-
 -- | Creates two users, Alice & Bob. Alice shouldn't be able to see
 -- Bob's private data and vice-versa.
-createAliceAndBob :: TestEnv -> IO ()
+createAliceAndBob :: TestEnv -> IO (UserId, UserId)
 createAliceAndBob testEnv = do
-  void $ flip runReaderT testEnv $ runTestMonad $ do
+  flip runReaderT testEnv $ runTestMonad $ do
     let nur1 = mkNewUser "alice@gargan.text" (GargPassword "alice")
     let nur2 = mkNewUser "bob@gargan.text" (GargPassword "bob")
 
-    void $ new_user nur1
-    void $ new_user nur2
+    aliceId <- new_user nur1
+    bobId <- new_user nur2
+
+    pure (aliceId, bobId)
+
+-- setupAliceAndBob :: (((TestEnv, Warp.Port), Application) -> IO (UserId, UserId)) -> IO ()
+-- setupAliceAndBob action = do
 
 curApi :: Builder
 curApi = "v1.0"

test/Test/API/UpdateList.hs

@@ -35,7 +35,7 @@ import Gargantext.Prelude hiding (get)
 import Network.Wai.Handler.Warp qualified as Wai
 import Paths_gargantext (getDataFileName)
 import Test.API.Private (withValidLogin, protectedJSON, postJSONUrlEncoded, getJSON)
-import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob)
+import Test.API.Setup (withTestDBAndPort, mkUrl, createAliceAndBob)
 import Test.Database.Types
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication, WaiSession)
@@ -102,8 +102,7 @@ tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
   describe "UpdateList API" $ do
     it "setup DB triggers and users" $ \((testEnv, _), _) -> do
-      setupEnvironment testEnv
-      createAliceAndBob testEnv
+      void $ createAliceAndBob testEnv
 
     describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do
 

test/Test/Database/Operations.hs

@@ -28,10 +28,9 @@ import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Prelude
-import Test.API.Setup (setupEnvironment)
 import Test.Database.Operations.DocumentSearch
 import Test.Database.Operations.NodeStory
-import Test.Database.Setup (withTestDB)
+import Test.Database.Setup (withTestDBWithTriggers)
 import Test.Database.Types
 import Test.Hspec
 import Test.QuickCheck.Monadic
@@ -50,9 +49,7 @@ uniqueArbitraryNewUser currentIx = do
    ascii_txt = fmap (T.pack . getPrintableString) arbitrary
 
 tests :: Spec
-tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
-  describe "Prelude" $ do
-    it "setup DB triggers" setupEnvironment
+tests = sequential $ aroundAll withTestDBWithTriggers $ describe "Database" $ do
   describe "Read/Writes" $ do
     describe "User creation" $ do
       it "Simple write/read" writeRead01
@@ -84,8 +81,7 @@ nodeStoryTests = sequential $
       it "[#281] When 'setListNgrams' is called, childrens' parents are updated" setListNgramsUpdatesNodeStoryWithChildrenTest
       it "[#281] Correctly commits patches to node story - simple" commitPatchSimpleTest
   where
-    setupDBAndCorpus testsFunc = withTestDB $ \env -> do
-      setupEnvironment env
+    setupDBAndCorpus testsFunc = withTestDBWithTriggers $ \env -> do
       testsFunc env
   
 data ExpectedActual a =

test/Test/Database/Operations/DocumentSearch.hs

@@ -31,6 +31,7 @@ import Gargantext.Database.Query.Tree.Root
 import Gargantext.Database.Schema.Node (NodePoly(..))
 -- import Network.URI (parseURI)
 
+import Test.Database.Setup (getMasterUserEnvOrFail)
 import Test.Database.Types
 import Test.Hspec.Expectations
 import Test.Tasty.HUnit
@@ -193,8 +194,9 @@ corpusSearch03 env = do
 corpusScore01 :: TestEnv -> Assertion
 corpusScore01 env = do
   flip runReaderT env $ runTestMonad $ do
+    masterUserEnv <- getMasterUserEnvOrFail env
 
-    parentId <- getRootId (UserName userMaster)
+    parentId <- getRootId (UserName $ userName masterUserEnv)
     [corpus] <- getCorporaWithParentId parentId
 
     results <- searchInCorpus (_node_id corpus) False (mkQ "Haskell") Nothing Nothing Nothing

test/Test/Database/Setup.hs

 {-# LANGUAGE TupleSections #-}
 module Test.Database.Setup (
     withTestDB
+  , withTestDBWithTriggers
+  , getMasterUserEnvOrFail
   , fakeIniPath
   , testEnvToPgConnectionInfo
+  , MasterUserEnv(..)
   ) where
 
 import Data.Pool hiding (withResource)
@@ -16,6 +19,13 @@ import Database.PostgreSQL.Simple.Options qualified as Opts
 import Database.Postgres.Temp qualified as Tmp
 import Gargantext.API.Admin.EnvTypes (Mode(Mock))
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
+import Gargantext.Core.Types.Individu (GargPassword(..), User(..))
+import Gargantext.Database.Action.Flow (getOrMk_RootWithCorpus)
+import Gargantext.Database.Action.User.New (mkNewUser, new_user)
+import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
+import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
+import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config
 import Gargantext.System.Logging (withLoggerHoisted)
@@ -24,6 +34,8 @@ import Prelude qualified
 import Shelly hiding (FilePath, run)
 import Shelly qualified as SH
 import Test.Database.Types
+import Test.Tasty.HUnit (assertFailure)
+
 
 -- | Test DB settings.
 dbUser, dbPassword, dbName :: Prelude.String
@@ -78,11 +90,44 @@ setup = do
                        , test_config = gargConfig
                        , test_nodeStory
                        , test_usernameGen = ugen
-                       , test_logger = logger }
+                       , test_logger = logger
+                       , test_masterUserEnv = Nothing }
 
 withTestDB :: (TestEnv -> IO ()) -> IO ()
 withTestDB = bracket setup teardown
 
+setupEnvironment :: TestEnv -> IO MasterUserEnv
+setupEnvironment env = flip runReaderT env $ runTestMonad $ do
+  let secretKey = "secret_key"
+  void $ initFirstTriggers secretKey
+  void $ new_user $ mkNewUser (userMaster <> "@cnrs.com") (GargPassword secretKey)
+  let userName = userMaster
+  (masterUserId, _masterRootId, masterCorpusId)
+              <- getOrMk_RootWithCorpus (UserName userName)
+                                        (Left corpusMasterName)
+                                        (Nothing :: Maybe HyperdataCorpus)
+  masterListId <- getOrMkList masterCorpusId masterUserId
+  -- printDebug "[setupEnvironment] masterListId: " masterListId
+  void $ initLastTriggers masterListId
+  pure $ MasterUserEnv { userId = masterUserId
+                       , userName
+                       , secretKey
+                       , corpusId = masterCorpusId
+                       , listId = masterListId }
+
+withTestDBWithTriggers :: (TestEnv -> IO ()) -> IO ()
+withTestDBWithTriggers action = withTestDB $ \testEnv -> do
+  (bracket (setupTriggers testEnv) (const $ pure ()) action)
+  where
+    setupTriggers testEnv = do
+      masterUserEnv <- setupEnvironment testEnv
+      pure $ testEnv { test_masterUserEnv = Just masterUserEnv }
+
+getMasterUserEnvOrFail :: (MonadIO m) => TestEnv -> m MasterUserEnv
+getMasterUserEnvOrFail (TestEnv { test_masterUserEnv = Nothing }) =
+  liftIO $ assertFailure "MasterUserEnv not initialized"
+getMasterUserEnvOrFail (TestEnv { test_masterUserEnv = Just mue }) = pure mue
+
 testEnvToPgConnectionInfo :: TestEnv -> PG.ConnectInfo
 testEnvToPgConnectionInfo TestEnv{..} =
   PG.ConnectInfo { PG.connectHost     = "0.0.0.0"

test/Test/Database/Types.hs

@@ -33,6 +33,7 @@ import Gargantext.API.Prelude
 import Gargantext.Core.Mail.Types (HasMail(..))
 import Gargantext.Core.NLP (HasNLPServer(..))
 import Gargantext.Core.NodeStory
+import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, UserId)
 import Gargantext.Database.Prelude (HasConfig(..), HasConnectionPool(..))
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Prelude.Config
@@ -55,12 +56,23 @@ emptyCounter = Counter <$> newIORef 0
 nextCounter :: Counter -> IO Int
 nextCounter (Counter ref) = atomicModifyIORef' ref (\old -> (succ old, old))
 
+data MasterUserEnv = MasterUserEnv { userId    :: UserId
+                                   , userName  :: Text
+                                   , secretKey :: Text
+                                   , corpusId  :: CorpusId
+                                   , listId    :: ListId }
+
 data TestEnv = TestEnv {
     test_db                  :: !DBHandle
   , test_config              :: !GargConfig
   , test_nodeStory           :: !NodeStoryEnv
   , test_usernameGen         :: !Counter
   , test_logger              :: !(Logger (GargM TestEnv BackendInternalError))
+
+  -- additional initialization of the master user
+  -- NOTE Maybe it's better to do a 2-step process with TestEnv', TestEnv
+  --      but it seems a bigger rewrite
+  , test_masterUserEnv       :: !(Maybe MasterUserEnv)
   }
 
 newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }

[Alfredo Di Napoli]

Is it really advisable to silently do nothing in case of conflicts?

[Alfredo Di Napoli]

Do we need a separate function here? If withTestDBWithTriggers is what we are always going to use, cannot we just call this simply withTestDB, removing the other (existing) function? Or do you envisage scenario where you want to call one but not the other?

[Alfredo Di Napoli]

Perhaps you could explain what to do in order to initialise the MasteruserEnv, like calling a particular function, for example?

An alternative approach to get rid of getMatserUserEnvOrFail would be to have two separate types, one for an UninitialisedTestEnv which would be given as input to setupEnvironment, so that you could write withTestDBWithTriggers as having signature UninitialisedEnv -> (TestEnv -> m a) -> m a or something like that.

Is that possible?