{-| Module : Gargantext.API.Dev Description : Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} -- Use only for dev/repl module Gargantext.API.Dev where import Control.Lens (view) import Control.Monad (fail) import Database.PostgreSQL.Simple qualified as PGS import Data.Pool (withResource) import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) ) import Gargantext.API.Admin.Settings ( newPool ) import Gargantext.API.Errors.Types ( BackendInternalError ) import Gargantext.API.Prelude ( GargM ) import Gargantext.Core.Config (_gc_database_config) import Gargantext.Core.Config.Types (SettingsFile(..)) import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.NodeStory (fromDBNodeStoryEnv) import Gargantext.Database.Prelude (Cmd, CmdRandom, connPool, runCmd) import Gargantext.Prelude import Gargantext.System.Logging ( withLoggerIO ) import Network.HTTP.Client.TLS (newTlsManager) import Servant ( ServerError ) ------------------------------------------------------------------- withDevEnv :: SettingsFile -> (DevEnv -> IO a) -> IO a withDevEnv settingsFile k = withLoggerIO Dev $ \logger -> do env <- newDevEnv logger k env -- `finally` cleanEnv env where newDevEnv logger = do cfg <- readConfig settingsFile --nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg) pool <- newPool (_gc_database_config cfg) nodeStory_env <- fromDBNodeStoryEnv pool manager <- newTlsManager pure $ DevEnv { _dev_env_pool = pool , _dev_env_manager = manager , _dev_env_logger = logger , _dev_env_nodeStory = nodeStory_env , _dev_env_config = cfg } defaultSettingsFile :: SettingsFile defaultSettingsFile = SettingsFile "gargantext-settings.toml" -- | Run Cmd Sugar for the Repl (GHCI) runCmdRepl :: Show err => CmdRandom DevEnv err a -> IO a runCmdRepl f = withDevEnv defaultSettingsFile $ \env -> runCmdDev env f runCmdReplServantErr :: CmdRandom DevEnv ServerError a -> IO a runCmdReplServantErr = runCmdRepl -- In particular this writes the repo file after running -- the command. -- This function is constrained to the DevEnv rather than -- using HasConnectionPool and HasRepoVar. runCmdDev :: Show err => DevEnv -> CmdRandom DevEnv err a -> IO a runCmdDev env f = either (fail . show) pure =<< runCmd env f runCmdGargDev :: DevEnv -> GargM DevEnv BackendInternalError a -> IO a runCmdGargDev env cmd = either (fail . show) pure =<< runExceptT (runReaderT cmd env) runCmdDevNoErr :: DevEnv -> Cmd DevEnv () a -> IO a runCmdDevNoErr = runCmdDev runCmdDevServantErr :: DevEnv -> Cmd DevEnv ServerError a -> IO a runCmdDevServantErr = runCmdDev runCmdReplEasy :: CmdRandom DevEnv BackendInternalError a -> IO a runCmdReplEasy f = withDevEnv defaultSettingsFile $ \env -> runCmdDev env f -- | Execute a function that takes PSQL.Connection from the DB pool as -- first parameter. -- e.g.: runCmdReplEasyDB $ \c -> getNodeStory' c runCmdReplEasyDB :: (PGS.Connection -> IO a) -> IO a runCmdReplEasyDB f = runCmdReplEasy $ view connPool >>= (\p -> liftBase $ withResource p f)