{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module Test.API.Setup where 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 (..)) 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 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 Servant.Job.Async qualified as ServantAsync import Test.Database.Setup (withTestDBWithTriggers, fakeIniPath, testEnvToPgConnectionInfo) import Test.Database.Types newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env newTestEnv testEnv logger port = do file <- fakeIniPath !manager_env <- newTlsManager !settings' <- devSettings devJwkFile <&> appPort .~ port !config_env <- readConfig file prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (file <> ".jobs") let prios' = Jobs.applyPrios prios Jobs.defaultPrios !self_url_env <- parseBaseUrl $ "http://0.0.0.0:" <> show port dbParam <- pure $ testEnvToPgConnectionInfo testEnv !pool <- newPool dbParam !nodeStory_env <- fromDBNodeStoryEnv pool !scrapers_env <- ServantAsync.newJobEnv ServantAsync.defaultSettings manager_env secret <- Jobs.genSecret let jobs_settings = (Jobs.defaultJobSettings 1 secret) & Jobs.l_jsJobTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_job_timeout) & Jobs.l_jsIDTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_id_timeout) !jobs_env <- Jobs.newJobEnv jobs_settings prios' manager_env !config_mail <- Mail.readConfig file !nlp_env <- nlpServerMap <$> NLP.readConfig file pure $ Env { _env_settings = settings' , _env_logger = logger , _env_pool = pool , _env_nodeStory = nodeStory_env , _env_manager = manager_env , _env_scrapers = scrapers_env , _env_jobs = jobs_env , _env_self_url = self_url_env , _env_config = config_env , _env_mail = config_mail , _env_nlp = nlp_env } 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 = withAliceAndBob $ \testEnv -> do app <- withLoggerHoisted Mock $ \ioLogger -> do env <- newTestEnv testEnv ioLogger 8080 makeApp env 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 let nur1 = mkNewUser "alice@gargan.text" (GargPassword "alice") let nur2 = mkNewUser "bob@gargan.text" (GargPassword "bob") 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" mkUrl :: Wai.Port -> Builder -> ByteString mkUrl _port urlPiece = "/api/" +| curApi |+ urlPiece