{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module Test.API.Setup where import Control.Concurrent.Async qualified as Async import Control.Concurrent.MVar import Control.Lens import Control.Monad.Reader 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.Config import Gargantext.Core.Config.Mail qualified as Mail import Gargantext.Core.Config.NLP qualified as NLP import Gargantext.Core.NLP import Gargantext.Core.NodeStory import Gargantext.Core.Types.Individu import Gargantext.Database.Action.Flow import Gargantext.Database.Action.User.New import Gargantext.Database.Admin.Config (userMaster) 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.Database.Query.Tree.Root (MkCorpusUser(..)) import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp) 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 (runSettingsSocket) import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Handler.Warp.Internal import Prelude import Servant.Auth.Client () import Servant.Client import Servant.Job.Async qualified as ServantAsync import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo, fakeSettingsPath) import Test.Database.Types import qualified UnliftIO import Data.Streaming.Network (bindPortTCP) newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env newTestEnv testEnv logger port = do file <- fakeIniPath settingsP <- SettingsFile <$> fakeSettingsPath !manager_env <- newTlsManager !settings' <- devSettings devJwkFile settingsP <&> 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 } -- | Run the gargantext server on a random port, picked by Warp, which allows -- for concurrent tests to be executed in parallel, if we need to. withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO () withTestDBAndPort action = withTestDB $ \testEnv -> do app <- withLoggerHoisted Mock $ \ioLogger -> do env <- newTestEnv testEnv ioLogger 8080 makeApp env Warp.testWithApplication (pure app) $ \port -> action ((testEnv, port), app) -- | Starts the backend server /and/ the microservices proxy, the former at -- a random port, the latter at a predictable port. withBackendServerAndProxy :: (((TestEnv, Warp.Port, Warp.Port)) -> IO ()) -> IO () withBackendServerAndProxy action = withTestDB $ \testEnv -> do gargApp <- withLoggerHoisted Mock $ \ioLogger -> do env <- newTestEnv testEnv ioLogger 8080 makeApp env proxyApp <- withLoggerHoisted Mock $ \ioLogger -> do env <- newTestEnv testEnv ioLogger 8080 pure $ microServicesProxyApp env Warp.testWithApplication (pure gargApp) $ \serverPort -> testWithApplicationOnPort (pure proxyApp) proxyPort $ action (testEnv, serverPort, proxyPort) where proxyPort = 8090 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) <- getOrMkRootWithCorpus MkCorpusUserMaster (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 = do void $ 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 -- | A version of 'withApplication' that allows supplying a user-specified port -- so that we are sure that our garg apps will run on the same port as specified -- in the 'Env' settings. testWithApplicationOnPort :: IO Application -> Warp.Port -> IO a -> IO a testWithApplicationOnPort mkApp userPort action = do app <- mkApp started <- mkWaiter let appSettings = Warp.defaultSettings { settingsBeforeMainLoop = notify started () >> settingsBeforeMainLoop Warp.defaultSettings , settingsPort = userPort } sock <- bindPortTCP userPort "127.0.0.1" result <- Async.race (runSettingsSocket appSettings sock app) (waitFor started >> action) case result of Left () -> UnliftIO.throwString "Unexpected: runSettingsSocket exited" Right x -> return x data Waiter a = Waiter { notify :: a -> IO () , waitFor :: IO a } mkWaiter :: IO (Waiter a) mkWaiter = do mvar <- newEmptyMVar return Waiter { notify = putMVar mvar , waitFor = readMVar mvar }