[tests] more refactoring of tests with alice and bob

gargantext.cabal

@@ -85,6 +85,7 @@ library
       Gargantext.API.Prelude
       Gargantext.API.Routes
       Gargantext.Core
+      Gargantext.Core.Mail
       Gargantext.Core.Mail.Types
       Gargantext.Core.Methods.Similarities
       Gargantext.Core.NLP
@@ -228,7 +229,6 @@ library
       Gargantext.Core.Ext.IMTUser
       Gargantext.Core.Flow.Ngrams
       Gargantext.Core.Flow.Types
-      Gargantext.Core.Mail
       Gargantext.Core.Methods.Graph.BAC.Proxemy
       Gargantext.Core.Methods.Graph.MaxClique
       Gargantext.Core.Methods.Matrix.Accelerate.Utils
@@ -1021,6 +1021,7 @@ test-suite garg-test-tasty
     , hspec ^>= 2.7.10
     , hspec-core
     , hspec-expectations >= 0.8 && < 0.9
+    , hspec-expectations-json ^>= 1.0.2.1
     , hspec-wai
     , hspec-wai-json
     , http-api-data
@@ -1060,6 +1061,7 @@ test-suite garg-test-tasty
     , tmp-postgres >= 1.34.1 && < 1.35
     , unordered-containers ^>= 0.2.16.0
     , validity ^>= 0.11.0.1
+    , vector ^>= 0.13.1
     , wai
     , wai-extra
     , warp
@@ -1132,6 +1134,7 @@ test-suite garg-test-hspec
     , hspec ^>= 2.7.10
     , hspec-core
     , hspec-expectations >= 0.8 && < 0.9
+    , hspec-expectations-json ^>= 1.0.2.1
     , hspec-wai
     , hspec-wai-json
     , http-api-data
@@ -1170,6 +1173,7 @@ test-suite garg-test-hspec
     , tmp-postgres >= 1.34.1 && < 1.35
     , unordered-containers ^>= 0.2.16.0
     , validity ^>= 0.11.0.1
+    , vector ^>= 0.13.1
     , wai
     , wai-extra
     , warp

test/Test/API/Authentication.hs

@@ -15,14 +15,13 @@ import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Routes
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu
-import Gargantext.Database.Action.User.New
 import Gargantext.Prelude
 import Network.HTTP.Client hiding (Proxy)
 import Prelude qualified
 import Servant.Auth.Client ()
 import Servant.Client
 import Test.API.Setup (withTestDBAndPort)
-import Test.Database.Types
+import Test.Database.Setup (getUserOrFail)
 import Test.Hspec
 
 auth_api :: AuthRequest -> ClientM AuthResponse
@@ -50,18 +49,19 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
     describe "POST /api/v1.0/auth" $ do
 
       it "requires no auth and authenticates the user 'alice'" $ \((testEnv, port), _) -> do
+        (_aliceEmail, alicePassword, aliceId, aliceNodeId) <- getUserOrFail testEnv "alice"
 
         -- Let's create the Alice user.
-        void $ flip runReaderT testEnv $ runTestMonad $ do
-          void $ new_user $ mkNewUser "alice@gargan.text" (GargPassword "alice")
+        -- void $ flip runReaderT testEnv $ runTestMonad $ do
+        --   void $ new_user $ mkNewUser "alice@gargan.text" (GargPassword "alice")
 
-        let authPayload = AuthRequest "alice" (GargPassword "alice")
+        let authPayload = AuthRequest "alice" alicePassword
         result0 <- runClientM (auth_api authPayload) (clientEnv port)
         let result = over (_Right . authRes_token) (const cannedToken) result0
         let expected = AuthResponse {
                 _authRes_token = cannedToken
-              , _authRes_tree_id = fromMaybe (UnsafeMkNodeId 1) $ listToMaybe $ result0 ^.. _Right . authRes_tree_id
-              , _authRes_user_id = fromMaybe (UnsafeMkUserId 1) $ listToMaybe $ result0 ^.. _Right . authRes_user_id
+              , _authRes_tree_id = fromMaybe (UnsafeMkNodeId aliceNodeId) $ listToMaybe $ result0 ^.. _Right . authRes_tree_id
+              , _authRes_user_id = fromMaybe aliceId $ listToMaybe $ result0 ^.. _Right . authRes_user_id
               }
 
         result `shouldBe` (Right expected)

test/Test/API/Errors.hs

@@ -11,7 +11,7 @@ import Servant
 import Servant.Auth.Client ()
 import Servant.Client
 import Test.API.Private (protected, withValidLogin, protectedNewError)
-import Test.API.Setup (withTestDBAndPort, mkUrl, createAliceAndBob)
+import Test.API.Setup (withTestDBAndPort, mkUrl)
 import Test.Database.Setup (MasterUserEnv(..), getMasterUserEnvOrFail)
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
@@ -22,13 +22,11 @@ tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
   describe "Errors API" $ do
     describe "Prelude" $ do
-      it "setup DB users" $ \((testEnv, port), _) -> do
+      it "setup DB users" $ \((_testEnv, port), _) -> do
         baseUrl <- parseBaseUrl "http://localhost"
         manager <- newManager defaultManagerSettings
         let clientEnv prt = mkClientEnv manager (baseUrl { baseUrlPort = prt })
 
-        void $ createAliceAndBob testEnv
-
         let ( roots_api :<|> _nodes_api
               ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token "bogus")
         let ( admin_user_api_get :<|> _) = roots_api
@@ -63,3 +61,5 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                 ->liftIO $ do
                     statusCode `shouldBe` 404
                     simpleBody `shouldBe` [r|{"data":{"node_id":99},"diagnostic":"FE_node_lookup_failed_not_found {nenf_node_id = nodeId-99}","type":"EC_404__node_lookup_failed_not_found"}|]
+
+

test/Test/API/GraphQL.hs

@@ -7,12 +7,16 @@ module Test.API.GraphQL (
     tests
   ) where
 
+import Data.Aeson ((.=))
+import Data.Aeson qualified as JSON
+import Data.Vector qualified as V
 import Gargantext.Core.Types.Individu
+import Gargantext.Database.Admin.Types.Node (UserId(..))
 import Gargantext.Prelude
 import Servant.Auth.Client ()
 import Test.API.Private (withValidLogin, protected, protectedNewError)
-import Test.API.Setup (withTestDBAndPort, createAliceAndBob)
-import Test.Database.Setup (MasterUserEnv(..), getMasterUserEnvOrFail)
+import Test.API.Setup (withTestDBAndPort)
+import Test.Database.Setup (MasterUserEnv(..), getMasterUserEnvOrFail, getUserOrFail)
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Hspec.Wai.JSON (json)
@@ -26,13 +30,18 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
 
     describe "get_user_infos" $ do
       it "allows 'alice' to see her own info" $ \((testEnv, port), app) -> do
-        void $ createAliceAndBob testEnv
-
+        (aliceEmail, alicePassword, aliceId, _aliceNodeId) <- getUserOrFail testEnv "alice"
+        
         withApplication app $ do
-          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
-            let query = [r| { "query": "{ user_infos(user_id: 2) { ui_id, ui_email } }" } |]
-            let expected = [json| {"data":{"user_infos":[{"ui_id":2,"ui_email":"alice@gargan.text"}]}} |]
-            protected token "POST" "/gql" query `shouldRespondWithFragment` expected
+          withValidLogin port "alice" alicePassword $ \token -> do
+            let query' = "{ user_infos(user_id:" <> show (_UserId aliceId) <> ") { ui_id, ui_email } }" :: Text
+            let query = JSON.encode $ JSON.object [ "query" .= query' ]
+            liftIO $ printDebug "[get_user_infos] query" query
+            let userInfo = JSON.object [ "ui_id" .= aliceId
+                                       ,  "ui_email" .= aliceEmail ]
+            let expected = 
+                  JSON.object [ "data" .= JSON.object [ "user_infos" .= JSON.Array (V.singleton userInfo) ] ]
+            protected token "POST" "/gql" query `matchSimpleJSON` expected
 
 
     describe "check error format" $ do
@@ -41,18 +50,28 @@ tests = sequential $ aroundAll withTestDBAndPort $ 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
+            let query' = "{ languages(id:5) { lt_lang } }" :: Text
+            let query = JSON.encode $ JSON.object [ "query" .= query' ]
+            let location = JSON.object [ "column" .= (13 :: Int)
+                                       , "line" .= (1 :: Int) ]
+            let err = JSON.object [ "locations" .= JSON.Array (V.singleton location)
+                                  , "message" .= ("Unknown Argument \"id\" on Field \"languages\"." :: Text) ]
+            let expected = JSON.object [ "errors" .= JSON.Array (V.singleton err) ]
+            protectedNewError token "POST" "/gql" query `matchSimpleJSON` expected
 
       it "returns the old error (though this is deprecated)" $ \((testEnv, port), app) -> do
         withApplication app $ 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
+            let query' = "{ languages(id:5) { lt_lang } }" :: Text
+            let query = JSON.encode $ JSON.object [ "query" .= query' ]
+            let location = JSON.object [ "column" .= (13 :: Int)
+                                       , "line" .= (1 :: Int) ]
+            let err = JSON.object [ "locations" .= JSON.Array (V.singleton location)
+                                  , "message" .= ("Unknown Argument \"id\" on Field \"languages\"." :: Text) ]
+            let expected = JSON.object [ "errors" .= JSON.Array (V.singleton err) ]
+            protected token "POST" "/gql" query `matchSimpleJSON` expected
 
       it "check new errors with 'type'" $ \((testEnv, port), app) -> do
         withApplication app $ do

test/Test/API/Private.hs

@@ -16,6 +16,7 @@ module Test.API.Private (
   , protectedWith
   ) where
 
+import Data.Aeson ((.=))
 import Data.Aeson qualified as JSON
 import Data.ByteString.Lazy qualified as L
 import Data.ByteString.Lazy.Char8 qualified as C8L
@@ -36,12 +37,12 @@ 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, mkUrl, createAliceAndBob)
+import Test.API.Setup (withTestDBAndPort, mkUrl)
+import Test.Database.Setup (getUserOrFail)
 import Test.Hspec
 import Test.Hspec.Wai hiding (pendingWith)
 import Test.Hspec.Wai.Internal (withApplication)
-import Test.Hspec.Wai.JSON (json)
-import Test.Utils (shouldRespondWithFragment)
+import Test.Utils (matchSimpleJSON)
 
 -- | Issue a request with a valid 'Authorization: Bearer' inside.
 protected :: HasCallStack
@@ -125,13 +126,10 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
     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
+      it "doesn't allow someone with an invalid token to show the results" $ \((_testEnv, port), _) -> do
 
         let ( roots_api :<|> _nodes_api
               ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token "bogus")
@@ -141,9 +139,10 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
         length result `shouldBe` 0
 
       -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
-      it "allows 'alice' to see the results" $ \((_testEnv, port), _) -> do
+      it "allows 'alice' to see the results" $ \((testEnv, port), _) -> do
+        (_aliceEmail, alicePassword, _aliceId, _aliceNodeId) <- getUserOrFail testEnv "alice"
 
-        withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+        withValidLogin port "alice" alicePassword $ \token -> do
           let ( roots_api :<|> _nodes_api
                 ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token $ TE.encodeUtf8 $ token)
           let ( admin_user_api_get :<|> _) = roots_api
@@ -153,31 +152,51 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
 
     describe "GET /api/v1.0/node" $ do
 
-      it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do
+      it "unauthorised users shouldn't see anything" $ \((testEnv, port), app) -> do
+        (_aliceEmail, _alicePassword, _aliceId, aliceNodeId) <- getUserOrFail testEnv "alice"
+        (_bobEmail, _bobPassword, _bobId, bobNodeId) <- getUserOrFail testEnv "bob"
+        
         withApplication app $ do
-          get (mkUrl port "/node/1") `shouldRespondWith` 401
+          get (mkUrl port "/node/" <> show aliceNodeId) `shouldRespondWith` 401
+          get (mkUrl port "/node/" <> show bobNodeId) `shouldRespondWith` 401
 
-      it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do
+      it "allows 'alice' to see her own node info" $ \((testEnv, port), app) -> do
+        (_aliceEmail, alicePassword, aliceId, aliceNodeId) <- getUserOrFail testEnv "alice"
+        
         withApplication app $ do
-          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
-            protected token "GET" (mkUrl port "/node/8") ""
-              `shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |]
+          withValidLogin port "alice" alicePassword $ \token -> do
+            protected token "GET" (mkUrl port "/node/" <> show aliceNodeId) ""
+              `matchSimpleJSON`
+              (JSON.object [ "id" .= aliceNodeId
+                           , "user_id" .= aliceId
+                           , "name" .= ("alice" :: Text) ])
+  
+      it "forbids 'alice' to see others node private info" $ \((testEnv, port), app) -> do
+        (_aliceEmail, alicePassword, _aliceId, _aliceNodeId) <- getUserOrFail testEnv "alice"
+        (_bobEmail, _bobPassword, _bobId, bobNodeId) <- getUserOrFail testEnv "bob"
 
-      it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do
         withApplication app $ do
-          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
-            protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403
+          withValidLogin port "alice" alicePassword $ \token -> do
+            protected token "GET" (mkUrl port "/node/" <> show bobNodeId) "" `shouldRespondWith` 403
 
     describe "GET /api/v1.0/tree" $ do
-      it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do
+      it "unauthorised users shouldn't see anything" $ \((testEnv, port), app) -> do
+        (_aliceEmail, _alicePassword, _aliceId, aliceNodeId) <- getUserOrFail testEnv "alice"
+        
         withApplication app $ do
-          get (mkUrl port "/tree/1") `shouldRespondWith` 401
+          get (mkUrl port "/tree/" <> show aliceNodeId) `shouldRespondWith` 401
 
-      it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do
+      it "allows 'alice' to see her own node info" $ \((testEnv, port), app) -> do
+        (_aliceEmail, alicePassword, _aliceId, aliceNodeId) <- getUserOrFail testEnv "alice"
+        
         withApplication app $ do
-          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
-            protected token "GET" (mkUrl port "/tree/8") ""
-              `shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
+          withValidLogin port "alice" alicePassword $ \token -> do
+            protected token "GET" (mkUrl port "/tree/" <> show aliceNodeId) ""
+              `matchSimpleJSON`  -- [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
+              (JSON.object [ "node" .= JSON.object [ "id" .= aliceNodeId
+                                                   , "name" .= ("alice" :: Text)
+                                                   , "type" .= ("NodeUser" :: Text)]
+                           ])
 
       it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do
         withApplication app $ do

test/Test/API/Setup.hs

@@ -3,10 +3,11 @@
 
 module Test.API.Setup where
 
--- import Gargantext.Prelude (printDebug)
+import Control.Exception (bracket)
 import Control.Lens
 import Control.Monad.Reader
 import Data.ByteString (ByteString)
+import Data.Map.Strict qualified as Map
 import Fmt (Builder, (+|), (|+))
 import Gargantext.API (makeApp)
 import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
@@ -14,12 +15,15 @@ import Gargantext.API.Admin.Settings
 import Gargantext.API.Admin.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
+import Gargantext.Core.Mail (EmailAddress)
 import Gargantext.Core.NLP
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Types (UserId)
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.User.New
+import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Prelude.Config
 import Gargantext.Prelude.Mail qualified as Mail
 import Gargantext.Prelude.NLP qualified as NLP
@@ -82,17 +86,41 @@ withGargApp :: Application -> (Warp.Port -> IO ()) -> IO ()
 withGargApp app action = do
   Warp.testWithApplication (pure app) action
 
+withAliceAndBob :: (TestEnv -> IO ()) -> IO ()
+withAliceAndBob action =
+  withTestDBWithTriggers $ \testEnv -> do
+    bracket (setupAliceAndBob testEnv) (removeAliceAndBob) action
+  where
+    setupAliceAndBob testEnv = do
+      testEnvAlice <- createUser testEnv "alice@gargan.text" (GargPassword "alice")
+      testEnvAliceBob <- createUser testEnvAlice "bob@gargan.text" (GargPassword "bob")
+      pure testEnvAliceBob
+    removeAliceAndBob _ = do
+      -- TODO
+      pure ()
+
 withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
 withTestDBAndPort action =
-  withTestDBWithTriggers $ \testEnv -> do
+  withAliceAndBob $ \testEnv -> do
     app <- withLoggerHoisted Mock $ \ioLogger -> do
              env <- newTestEnv testEnv ioLogger 8080
              makeApp env
-    withGargApp app $ \port ->
+    withGargApp app $ \port -> do
       action ((testEnv, port), app)
 
 -- | Creates two users, Alice & Bob. Alice shouldn't be able to see
 -- Bob's private data and vice-versa.
+createUser :: TestEnv -> EmailAddress -> GargPassword -> IO TestEnv
+createUser testEnv email pass = do
+  flip runReaderT testEnv $ runTestMonad $ do
+    let nur = mkNewUser email pass
+    let NewUser username _ _ = nur
+    
+    userId <- new_user nur
+    rootId <- getRootId (UserName username)
+  
+    pure $ testEnv { test_users = Map.insert username (email, pass, userId, _NodeId rootId) $ test_users testEnv }
+
 createAliceAndBob :: TestEnv -> IO (UserId, UserId)
 createAliceAndBob testEnv = do
   flip runReaderT testEnv $ runTestMonad $ do

test/Test/API/UpdateList.hs

@@ -35,7 +35,8 @@ 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, mkUrl, createAliceAndBob)
+import Test.API.Setup (withTestDBAndPort, mkUrl)
+import Test.Database.Setup (getUserOrFail)
 import Test.Database.Types
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication, WaiSession)
@@ -101,15 +102,14 @@ pollUntilFinished tkn port mkUrlPiece = go 60
 tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
   describe "UpdateList API" $ do
-    it "setup DB triggers and users" $ \((testEnv, _), _) -> do
-      void $ createAliceAndBob testEnv
-
     describe "POST /api/v1.0/lists/:id/add/form/async (JSON)" $ do
 
       it "allows uploading a JSON ngrams file" $ \((testEnv, port), app) -> do
+        (_aliceEmail, alicePassword, _aliceId, _aliceNodeId) <- getUserOrFail testEnv "alice"
+
         cId <- newCorpusForUser testEnv "alice"
         withApplication app $ do
-          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+          withValidLogin port "alice" alicePassword $ \token -> do
             ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
             -- Upload the JSON doc
             simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.json")
@@ -150,9 +150,11 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                               ])])
 
       it "allows uploading a CSV ngrams file" $ \((testEnv, port), app) -> do
+        (_aliceEmail, alicePassword, _aliceId, _aliceNodeId) <- getUserOrFail testEnv "alice"
+
         cId <- newCorpusForUser testEnv "alice"
         withApplication app $ do
-          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+          withValidLogin port "alice" alicePassword $ \token -> do
             ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
             -- Upload the CSV doc
             simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.csv")

test/Test/Database/Setup.hs

@@ -3,11 +3,13 @@ module Test.Database.Setup (
     withTestDB
   , withTestDBWithTriggers
   , getMasterUserEnvOrFail
+  , getUserOrFail
   , fakeIniPath
   , testEnvToPgConnectionInfo
   , MasterUserEnv(..)
   ) where
 
+import Data.Map.Strict qualified as Map
 import Data.Pool hiding (withResource)
 import Data.Pool qualified as Pool
 import Data.String (fromString)
@@ -18,13 +20,15 @@ import Database.PostgreSQL.Simple.Options qualified as Client
 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.Mail (EmailAddress)
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
-import Gargantext.Core.Types.Individu (GargPassword(..), User(..))
+import Gargantext.Core.Types.Individu (GargPassword(..), User(..), Username)
 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.Admin.Types.Node (NodeId, UserId)
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config
@@ -91,7 +95,8 @@ setup = do
                        , test_nodeStory
                        , test_usernameGen = ugen
                        , test_logger = logger
-                       , test_masterUserEnv = Nothing }
+                       , test_masterUserEnv = Nothing
+                       , test_users = mempty }
 
 withTestDB :: (TestEnv -> IO ()) -> IO ()
 withTestDB = bracket setup teardown
@@ -117,7 +122,7 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
 
 withTestDBWithTriggers :: (TestEnv -> IO ()) -> IO ()
 withTestDBWithTriggers action = withTestDB $ \testEnv -> do
-  (bracket (setupTriggers testEnv) (const $ pure ()) action)
+  bracket (setupTriggers testEnv) (const $ pure ()) action
   where
     setupTriggers testEnv = do
       masterUserEnv <- setupEnvironment testEnv
@@ -128,6 +133,12 @@ getMasterUserEnvOrFail (TestEnv { test_masterUserEnv = Nothing }) =
   liftIO $ assertFailure "MasterUserEnv not initialized"
 getMasterUserEnvOrFail (TestEnv { test_masterUserEnv = Just mue }) = pure mue
 
+getUserOrFail :: (MonadIO m) => TestEnv -> Username -> m (EmailAddress, GargPassword, UserId, Int)
+getUserOrFail (TestEnv { test_users }) username =
+  case Map.lookup username test_users of
+    Nothing -> liftIO $ assertFailure ("user " <> T.unpack username <> " not initialized")
+    Just u -> pure u
+
 testEnvToPgConnectionInfo :: TestEnv -> PG.ConnectInfo
 testEnvToPgConnectionInfo TestEnv{..} =
   PG.ConnectInfo { PG.connectHost     = "0.0.0.0"

test/Test/Database/Types.hs

@@ -30,10 +30,12 @@ import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
+import Gargantext.Core.Mail (EmailAddress)
 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.Core.Types.Individu (Username, GargPassword)
+import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeId, UserId)
 import Gargantext.Database.Prelude (HasConfig(..), HasConnectionPool(..))
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Prelude.Config
@@ -73,6 +75,8 @@ data TestEnv = TestEnv {
   -- NOTE Maybe it's better to do a 2-step process with TestEnv', TestEnv
   --      but it seems a bigger rewrite
   , test_masterUserEnv       :: !(Maybe MasterUserEnv)
+
+  , test_users               :: !(Map Username (EmailAddress, GargPassword, UserId, Int))
   }
 
 newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }

test/Test/Utils.hs

@@ -10,11 +10,15 @@ import Data.Aeson
 import Data.Aeson qualified as JSON
 import Data.Aeson.KeyMap qualified as KM
 import Data.ByteString.Char8 qualified as B
+import Data.ByteString.Lazy qualified as BSL
 import Data.Char (isSpace)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
 import Network.HTTP.Types
 import Network.Wai.Test
 import Prelude
 import Test.Hspec.Expectations
+import Test.Hspec.Expectations.Json (shouldMatchJson)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON (FromValue(..))
 import Test.Hspec.Wai.Matcher
@@ -49,7 +53,7 @@ shouldRespondWithFragmentCustomStatus :: HasCallStack
 shouldRespondWithFragmentCustomStatus status action matcher = do
   let m = (getJsonMatcher matcher) { matchStatus = status }
   r <- action
-  forM_ (match r (getJsonMatcher $ JsonFragmentResponseMatcher m)) (liftIO . expectationFailure)
+  forM_ (match r m) (liftIO . expectationFailure)
 
 
 instance FromValue JsonFragmentResponseMatcher where
@@ -89,3 +93,18 @@ containsJSON expected = MatchBody matcher
     isSubsetOf (Object sub) (Object sup) =
       all (\(key, value) -> KM.lookup key sup == Just value) (KM.toList sub)
     isSubsetOf x y = x == y
+
+matchSimpleJSON :: WaiSession st SResponse
+                -> Value
+                -> WaiExpectation st
+matchSimpleJSON action value = do
+  SResponse { simpleStatus
+            , simpleBody } <- action
+  let fail' = liftIO . expectationFailure
+  if simpleStatus /= status200 then
+    fail' $ "status mismatch: expected 200, but got " ++ (show simpleStatus)
+  else
+    pure ()
+  case JSON.decode simpleBody of
+    Nothing -> fail' $ "can't decode json for " ++ (T.unpack $ TE.decodeUtf8 $ BSL.toStrict simpleBody)
+    Just sb -> liftIO $ sb `shouldMatchJson` value