[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 }