diff --git a/bin/gargantext-admin/Main.hs b/bin/gargantext-admin/Main.hs index 9010777d5335d2b7a6af3584ed1c529261bc6f8b..fee81eefdea27df80b9ecf1c6a98cfd20a2564d5 100644 --- a/bin/gargantext-admin/Main.hs +++ b/bin/gargantext-admin/Main.hs @@ -15,13 +15,13 @@ Portability : POSIX module Main where -import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev) +import Gargantext.API.Dev (withDevEnv, runCmdDev) import Gargantext.API.Prelude (GargError) import Gargantext.Database.Action.User.New (newUsers) import Gargantext.Database.Prelude (Cmd'') import Gargantext.Prelude import System.Environment (getArgs) -import Gargantext.API.Admin.Types (DevEnv) +import Gargantext.API.Admin.EnvTypes (DevEnv) main :: IO () main = do diff --git a/bin/gargantext-import/Main.hs b/bin/gargantext-import/Main.hs index 41ea91d60c612af2a9abc282a9d0eeee4721f543..8d800bb7c101762e4ea5e39a7d2c87d0f729cd70 100644 --- a/bin/gargantext-import/Main.hs +++ b/bin/gargantext-import/Main.hs @@ -22,8 +22,8 @@ import Prelude (read) import System.Environment (getArgs) import qualified Data.Text as Text -import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev) -import Gargantext.API.Admin.Types (DevEnv(..)) +import Gargantext.API.Dev (withDevEnv, runCmdDev) +import Gargantext.API.Admin.EnvTypes (DevEnv(..)) import Gargantext.API.Node () -- instances import Gargantext.API.Prelude (GargError) import Gargantext.Core (Lang(..)) diff --git a/bin/gargantext-init/Main.hs b/bin/gargantext-init/Main.hs index e92944bb1c7615165bad1b61dbfa2faa9a5296d2..79e6e7d45dad034912a360b3e0b890bda16f3339 100644 --- a/bin/gargantext-init/Main.hs +++ b/bin/gargantext-init/Main.hs @@ -17,7 +17,7 @@ module Main where import Data.Text (Text) import Data.Either (Either(..)) -import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev) +import Gargantext.API.Dev (withDevEnv, runCmdDev) import Gargantext.API.Prelude (GargError) import Gargantext.API.Node () -- instances only import Gargantext.Core.Types.Individu (User(..)) diff --git a/bin/gargantext-upgrade/Main.hs b/bin/gargantext-upgrade/Main.hs index 34e75eb0a7a2d9f20a17a8591c7264920897fe53..edffa25b5bbddcd9d6772d1f608ff775c70ed2a5 100644 --- a/bin/gargantext-upgrade/Main.hs +++ b/bin/gargantext-upgrade/Main.hs @@ -15,7 +15,7 @@ Import a corpus binary. module Main where -import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev) +import Gargantext.API.Dev (withDevEnv, runCmdDev) import Gargantext.API.Prelude (GargError) import Gargantext.API.Node () -- instances only import Gargantext.Database.Admin.Types.Node diff --git a/package.yaml b/package.yaml index f946d1215305c6fc57c066330dbd6e269b52ee2d..c16535246b14c523ab1afbade3fb09cc341d742c 100644 --- a/package.yaml +++ b/package.yaml @@ -45,6 +45,7 @@ library: - Gargantext.API.Ngrams - Gargantext.API.Ngrams.Types - Gargantext.API.Admin.Settings + - Gargantext.API.Admin.EnvTypes - Gargantext.API.Admin.Types - Gargantext.API.Prelude - Gargantext.Core diff --git a/src/Gargantext/API/Admin/EnvTypes.hs b/src/Gargantext/API/Admin/EnvTypes.hs new file mode 100644 index 0000000000000000000000000000000000000000..b83456f92a4720cba048e4c0d17ef20e42ce59fa --- /dev/null +++ b/src/Gargantext/API/Admin/EnvTypes.hs @@ -0,0 +1,96 @@ +-- | + +{-# LANGUAGE TemplateHaskell #-} + +module Gargantext.API.Admin.EnvTypes where + +import Control.Lens +import Data.Pool (Pool) +import Database.PostgreSQL.Simple (Connection) +import GHC.Generics (Generic) +import Network.HTTP.Client (Manager) +import Servant.Client (BaseUrl) +import Servant.Job.Async (HasJobEnv(..), Job) +import System.Log.FastLogger +import qualified Servant.Job.Core + +import Gargantext.API.Admin.Types +import Gargantext.API.Admin.Orchestrator.Types +import Gargantext.API.Ngrams.Types (HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..)) +import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..)) +import Gargantext.Prelude +import Gargantext.Prelude.Config (GargConfig(..)) + + +data Env = Env + { _env_settings :: !Settings + , _env_logger :: !LoggerSet + , _env_pool :: !(Pool Connection) + , _env_repo :: !RepoEnv + , _env_manager :: !Manager + , _env_self_url :: !BaseUrl + , _env_scrapers :: !ScrapersEnv + , _env_config :: !GargConfig + } + deriving (Generic) + +makeLenses ''Env + +instance HasConfig Env where + config = env_config + +instance HasConnectionPool Env where + connPool = env_pool + +instance HasRepoVar Env where + repoVar = repoEnv . repoVar + +instance HasRepoSaver Env where + repoSaver = repoEnv . repoSaver + +instance HasRepo Env where + repoEnv = env_repo + +instance HasSettings Env where + settings = env_settings + +instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where + _env = env_scrapers . Servant.Job.Core._env + +instance HasJobEnv Env JobLog JobLog where + job_env = env_scrapers + +data MockEnv = MockEnv + { _menv_firewall :: !FireWall + } + deriving (Generic) + +makeLenses ''MockEnv + + +data DevEnv = DevEnv + { _dev_env_pool :: !(Pool Connection) + , _dev_env_repo :: !RepoEnv + , _dev_env_settings :: !Settings + , _dev_env_config :: !GargConfig + } + +makeLenses ''DevEnv + +instance HasConfig DevEnv where + config = dev_env_config + +instance HasConnectionPool DevEnv where + connPool = dev_env_pool + +instance HasRepoVar DevEnv where + repoVar = repoEnv . repoVar + +instance HasRepoSaver DevEnv where + repoSaver = repoEnv . repoSaver + +instance HasRepo DevEnv where + repoEnv = dev_env_repo + +instance HasSettings DevEnv where + settings = dev_env_settings \ No newline at end of file diff --git a/src/Gargantext/API/Admin/Orchestrator.hs b/src/Gargantext/API/Admin/Orchestrator.hs index 8b2fd1ec56dbeb47027f0bf56aa970e224b4e42d..d3c7c9c870bac703d82b41c51e4dcf453ca9c253 100644 --- a/src/Gargantext/API/Admin/Orchestrator.hs +++ b/src/Gargantext/API/Admin/Orchestrator.hs @@ -16,17 +16,13 @@ module Gargantext.API.Admin.Orchestrator where import Control.Lens hiding (elements) import Data.Aeson -import Data.Text import Servant import Servant.Job.Async import Servant.Job.Client -import Servant.Job.Server -import Servant.Job.Utils (extendBaseUrl) import qualified Data.ByteString.Lazy.Char8 as LBS import Gargantext.API.Admin.Orchestrator.Scrapy.Schedule import Gargantext.API.Admin.Orchestrator.Types -import Gargantext.API.Admin.Types import Gargantext.Prelude callJobScrapy :: (ToJSON e, FromJSON e, FromJSON o, MonadClientJob m) @@ -77,10 +73,20 @@ pipeline scrapyurl client_env input log_status = do -- use: -- * serveJobsAPI instead of simpleServeJobsAPI -- * JobFunction instead of simpleJobFunction +-- TODO: +-- * HasSelfUrl or move self_url to settings +-- * HasScrapers or move scrapers to settings +-- * EnvC env +{- NOT USED YET +import Data.Text +import Servant.Job.Server +import Servant.Job.Utils (extendBaseUrl) +import Gargantext.API.Admin.Types scrapyOrchestrator :: Env -> IO (Server (WithCallbacks ScraperAPI)) scrapyOrchestrator env = do apiWithCallbacksServer (Proxy :: Proxy ScraperAPI) defaultSettings (extendBaseUrl ("scraper" :: Text) $ env ^. env_self_url) (env ^. env_manager) (LogEvent logConsole) $ simpleServeJobsAPI (env ^. env_scrapers) . - simpleJobFunction . pipeline (URL $ env ^. env_settings . scrapydUrl) + simpleJobFunction . pipeline (URL $ env ^. settings . scrapydUrl) +-} \ No newline at end of file diff --git a/src/Gargantext/API/Admin/Settings.hs b/src/Gargantext/API/Admin/Settings.hs index ba6882817cbb798533e54e8d875dc356a5e57580..2d401de7cfb09dfc0838dc7aee54dc3091540c52 100644 --- a/src/Gargantext/API/Admin/Settings.hs +++ b/src/Gargantext/API/Admin/Settings.hs @@ -21,31 +21,27 @@ module Gargantext.API.Admin.Settings import Codec.Serialise (Serialise(), serialise, deserialise) import Control.Concurrent import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction) -import Control.Exception (finally) import Control.Lens import Control.Monad.Logger import Control.Monad.Reader import Data.Maybe (fromMaybe) import Data.Pool (Pool, createPool) -import Data.Text import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo) import Network.HTTP.Client.TLS (newTlsManager) -import Servant import Servant.Auth.Server (defaultJWTSettings, CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings, readKey, writeKey) import Servant.Client (parseBaseUrl) import Servant.Job.Async (newJobEnv, defaultSettings) import System.Directory -import System.Environment (lookupEnv) import System.FileLock (tryLockFile, unlockFile, SharedExclusive(Exclusive)) import System.IO (FilePath, hClose) import System.IO.Temp (withTempFile) import System.Log.FastLogger import qualified Data.ByteString.Lazy as L +import Gargantext.API.Admin.EnvTypes import Gargantext.API.Admin.Types import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_version, initRepo, renv_var, renv_lock) -import Gargantext.API.Ngrams (saveRepo) -import Gargantext.Database.Prelude (databaseParameters, Cmd', Cmd'', runCmd, HasConfig(..)) +import Gargantext.Database.Prelude (databaseParameters, HasConfig(..)) import Gargantext.Prelude import Gargantext.Prelude.Config (GargConfig(..), gc_repofilepath, readConfig) @@ -68,7 +64,8 @@ devSettings jwkFile = do where xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True } - +{- NOT USED YET +import System.Environment (lookupEnv) reqSetting :: FromHttpApiData a => Text -> IO a reqSetting name = do @@ -82,15 +79,16 @@ optSetting name d = do Nothing -> pure d Just e -> pure $ either (panic $ "Unable to parse " <> name) identity $ parseUrlPiece $ pack e ---settingsFromEnvironment :: IO Settings ---settingsFromEnvironment = --- Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN") --- <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST") --- <*> optSetting "PORT" 3000 --- <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn") --- <*> reqSetting "DB_SERVER" --- <*> (parseJwk <$> reqSetting "JWT_SECRET") --- <*> optSetting "SEND_EMAIL" SendEmailViaAws +settingsFromEnvironment :: IO Settings +settingsFromEnvironment = + Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN") + <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST") + <*> optSetting "PORT" 3000 + <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn") + <*> reqSetting "DB_SERVER" + <*> (parseJwk <$> reqSetting "JWT_SECRET") + <*> optSetting "SEND_EMAIL" SendEmailViaAws +-} ----------------------------------------------------------------------- -- | RepoDir FilePath configuration @@ -196,49 +194,4 @@ cleanEnv env = do repoSaverAction (env ^. config . gc_repofilepath) r unlockFile (env ^. repoEnv . renv_lock) -type IniPath = FilePath -withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a -withDevEnv iniPath k = do - env <- newDevEnv - k env `finally` cleanEnv env - - where - newDevEnv = do - config <- readConfig iniPath - dbParam <- databaseParameters iniPath - pool <- newPool dbParam - repo <- readRepoEnv (_gc_repofilepath config) - setts <- devSettings devJwkFile - pure $ DevEnv - { _dev_env_pool = pool - , _dev_env_repo = repo - , _dev_env_settings = setts - , _dev_env_config = config - } - --- | Run Cmd Sugar for the Repl (GHCI) - -runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a -runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f - -runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a -runCmdReplServantErr = runCmdRepl - --- Use only for dev --- 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 -> Cmd'' DevEnv err a -> IO a -runCmdDev env f = - (either (fail . show) pure =<< runCmd env f) - `finally` - runReaderT saveRepo env - --- Use only for dev -runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a -runCmdDevNoErr = runCmdDev - --- Use only for dev -runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a -runCmdDevServantErr = runCmdDev +type IniPath = FilePath \ No newline at end of file diff --git a/src/Gargantext/API/Admin/Types.hs b/src/Gargantext/API/Admin/Types.hs index 394876fc07a799dcfa236a50fa3192e5a2335296..4badb8f5e2a3e2799aa4fdda3e39756caeea876a 100644 --- a/src/Gargantext/API/Admin/Types.hs +++ b/src/Gargantext/API/Admin/Types.hs @@ -7,22 +7,12 @@ module Gargantext.API.Admin.Types where import Control.Lens import Control.Monad.Logger import Data.ByteString (ByteString) -import Data.Pool (Pool) -import Database.PostgreSQL.Simple (Connection) import GHC.Enum import GHC.Generics (Generic) -import Network.HTTP.Client (Manager) import Servant.Auth.Server (JWTSettings, CookieSettings(..)) import Servant.Client (BaseUrl) -import Servant.Job.Async (HasJobEnv(..), Job) -import System.Log.FastLogger -import qualified Servant.Job.Core -import Gargantext.API.Admin.Orchestrator.Types -import Gargantext.API.Ngrams.Types (HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..)) -import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..)) import Gargantext.Prelude -import Gargantext.Prelude.Config (GargConfig(..)) type PortNumber = Int @@ -31,18 +21,17 @@ data SendEmailType = SendEmailViaAws | WriteEmailToFile deriving (Show, Read, Enum, Bounded, Generic) - data Settings = Settings - { _allowedOrigin :: ByteString -- allowed origin for CORS - , _allowedHost :: ByteString -- allowed host for CORS - , _appPort :: PortNumber - , _logLevelLimit :: LogLevel -- log level from the monad-logger package + { _allowedOrigin :: !ByteString -- allowed origin for CORS + , _allowedHost :: !ByteString -- allowed host for CORS + , _appPort :: !PortNumber + , _logLevelLimit :: !LogLevel -- log level from the monad-logger package -- , _dbServer :: Text -- ^ this is not used yet - , _jwtSettings :: JWTSettings - , _cookieSettings :: CookieSettings - , _sendLoginEmails :: SendEmailType - , _scrapydUrl :: BaseUrl + , _jwtSettings :: !JWTSettings + , _cookieSettings :: !CookieSettings + , _sendLoginEmails :: !SendEmailType + , _scrapydUrl :: !BaseUrl } makeLenses ''Settings @@ -50,78 +39,7 @@ makeLenses ''Settings class HasSettings env where settings :: Getter env Settings +instance HasSettings Settings where + settings = identity -data FireWall = FireWall { unFireWall :: Bool } - -data Env = Env - { _env_settings :: !Settings - , _env_logger :: !LoggerSet - , _env_pool :: !(Pool Connection) - , _env_repo :: !RepoEnv - , _env_manager :: !Manager - , _env_self_url :: !BaseUrl - , _env_scrapers :: !ScrapersEnv - , _env_config :: !GargConfig - } - deriving (Generic) - -makeLenses ''Env - -instance HasConfig Env where - config = env_config - -instance HasConnectionPool Env where - connPool = env_pool - -instance HasRepoVar Env where - repoVar = repoEnv . repoVar - -instance HasRepoSaver Env where - repoSaver = repoEnv . repoSaver - -instance HasRepo Env where - repoEnv = env_repo - -instance HasSettings Env where - settings = env_settings - -instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where - _env = env_scrapers . Servant.Job.Core._env - -instance HasJobEnv Env JobLog JobLog where - job_env = env_scrapers - -data MockEnv = MockEnv - { _menv_firewall :: !FireWall - } - deriving (Generic) - -makeLenses ''MockEnv - - -data DevEnv = DevEnv - { _dev_env_pool :: !(Pool Connection) - , _dev_env_repo :: !RepoEnv - , _dev_env_settings :: !Settings - , _dev_env_config :: !GargConfig - } - -makeLenses ''DevEnv - -instance HasConfig DevEnv where - config = dev_env_config - -instance HasConnectionPool DevEnv where - connPool = dev_env_pool - -instance HasRepoVar DevEnv where - repoVar = repoEnv . repoVar - -instance HasRepoSaver DevEnv where - repoSaver = repoEnv . repoSaver - -instance HasRepo DevEnv where - repoEnv = dev_env_repo - -instance HasSettings DevEnv where - settings = dev_env_settings +data FireWall = FireWall { unFireWall :: Bool } \ No newline at end of file diff --git a/src/Gargantext/API/Dev.hs b/src/Gargantext/API/Dev.hs index c05b1f0eb51b84daa44cdec1fce50621fc1e2878..2465ad54053266077a7cdd6e5e9243d80310668b 100644 --- a/src/Gargantext/API/Dev.hs +++ b/src/Gargantext/API/Dev.hs @@ -1,13 +1,65 @@ -- | +-- Use only for dev/repl module Gargantext.API.Dev where -import Gargantext.API.Admin.Settings +import Control.Exception (finally) +import Control.Monad (fail) +import Control.Monad.Reader (runReaderT) +import Servant + import Gargantext.API.Prelude -import Gargantext.API.Admin.Types +import Gargantext.API.Admin.Settings +import Gargantext.API.Admin.EnvTypes +import Gargantext.API.Ngrams (saveRepo) import Gargantext.Database.Prelude import Gargantext.Prelude +import Gargantext.Prelude.Config (GargConfig(..), readConfig) ------------------------------------------------------------------- + +withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a +withDevEnv iniPath k = do + env <- newDevEnv + k env `finally` cleanEnv env + + where + newDevEnv = do + cfg <- readConfig iniPath + dbParam <- databaseParameters iniPath + pool <- newPool dbParam + repo <- readRepoEnv (_gc_repofilepath cfg) + setts <- devSettings devJwkFile + pure $ DevEnv + { _dev_env_pool = pool + , _dev_env_repo = repo + , _dev_env_settings = setts + , _dev_env_config = cfg + } + +-- | Run Cmd Sugar for the Repl (GHCI) + +runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a +runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f + +runCmdReplServantErr :: Cmd'' 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 -> Cmd'' DevEnv err a -> IO a +runCmdDev env f = + (either (fail . show) pure =<< runCmd env f) + `finally` + runReaderT saveRepo env + +runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a +runCmdDevNoErr = runCmdDev + +runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a +runCmdDevServantErr = runCmdDev + runCmdReplEasy :: Cmd'' DevEnv GargError a -> IO a -runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f +runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f \ No newline at end of file