Commit 33fe28c3 authored by Nicolas Pouillard's avatar Nicolas Pouillard

Cleanup refactoring of config/settings/env

parent b3e16c15
...@@ -36,7 +36,6 @@ import Control.Exception (finally) ...@@ -36,7 +36,6 @@ import Control.Exception (finally)
import Control.Lens import Control.Lens
import Control.Monad.Reader (runReaderT) import Control.Monad.Reader (runReaderT)
import Data.List (lookup) import Data.List (lookup)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Data.Validity import Data.Validity
import GHC.Base (Applicative) import GHC.Base (Applicative)
...@@ -50,10 +49,9 @@ import Servant ...@@ -50,10 +49,9 @@ import Servant
import System.IO (FilePath) import System.IO (FilePath)
import Data.Text.IO (putStrLn) import Data.Text.IO (putStrLn)
import Gargantext.Prelude.Config (gc_url_backend_api)
import Gargantext.API.Admin.Auth (AuthContext) import Gargantext.API.Admin.Auth (AuthContext)
import Gargantext.API.Admin.Settings (newEnv) import Gargantext.API.Admin.Settings (newEnv)
import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, env_gargConfig, jwtSettings, settings) import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
import Gargantext.API.Ngrams (saveRepo) import Gargantext.API.Ngrams (saveRepo)
import Gargantext.API.Ngrams.Types (HasRepoSaver(..)) import Gargantext.API.Ngrams.Types (HasRepoSaver(..))
import Gargantext.API.Prelude import Gargantext.API.Prelude
...@@ -70,10 +68,7 @@ startGargantext :: Mode -> PortNumber -> FilePath -> IO () ...@@ -70,10 +68,7 @@ startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
startGargantext mode port file = do startGargantext mode port file = do
env <- newEnv port file env <- newEnv port file
portRouteInfo port portRouteInfo port
app <- makeApp env
let baseUrl = env ^. env_gargConfig . gc_url_backend_api
app <- makeApp env baseUrl
mid <- makeDevMiddleware mode mid <- makeDevMiddleware mode
run port (mid app) `finally` stopGargantext env run port (mid app) `finally` stopGargantext env
...@@ -198,8 +193,8 @@ serverGargAdminAPI = roots ...@@ -198,8 +193,8 @@ serverGargAdminAPI = roots
--gargMock :: Server GargAPI --gargMock :: Server GargAPI
--gargMock = mock apiGarg Proxy --gargMock = mock apiGarg Proxy
--------------------------------------------------------------------- ---------------------------------------------------------------------
makeApp :: EnvC env => env -> Text -> IO Application makeApp :: EnvC env => env -> IO Application
makeApp env baseUrl = serveWithContext api cfg <$> server env baseUrl makeApp env = serveWithContext api cfg <$> server env
where where
cfg :: Servant.Context AuthContext cfg :: Servant.Context AuthContext
cfg = env ^. settings . jwtSettings cfg = env ^. settings . jwtSettings
......
...@@ -47,7 +47,7 @@ import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_vers ...@@ -47,7 +47,7 @@ import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_vers
import Gargantext.API.Ngrams (saveRepo) import Gargantext.API.Ngrams (saveRepo)
import Gargantext.Database.Prelude (databaseParameters, Cmd', Cmd'', runCmd, HasConfig(..)) import Gargantext.Database.Prelude (databaseParameters, Cmd', Cmd'', runCmd, HasConfig(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..), gc_repofilepath, readConfig, defaultConfig) import Gargantext.Prelude.Config (GargConfig(..), gc_repofilepath, readConfig)
devSettings :: FilePath -> IO Settings devSettings :: FilePath -> IO Settings
devSettings jwkFile = do devSettings jwkFile = do
...@@ -64,7 +64,6 @@ devSettings jwkFile = do ...@@ -64,7 +64,6 @@ devSettings jwkFile = do
, _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800" , _scrapydUrl = fromMaybe (panic "Invalid scrapy URL") $ parseBaseUrl "http://localhost:6800"
, _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune , _cookieSettings = defaultCookieSettings { cookieXsrfSetting = Just xsrfCookieSetting } -- TODO-SECURITY tune
, _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune , _jwtSettings = defaultJWTSettings jwk -- TODO-SECURITY tune
, _config = defaultConfig
} }
where where
xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True } xsrfCookieSetting = defaultXsrfCookieSettings { xsrfExcludeGet = True }
...@@ -178,14 +177,14 @@ newEnv port file = do ...@@ -178,14 +177,14 @@ newEnv port file = do
logger <- newStderrLoggerSet defaultBufSize logger <- newStderrLoggerSet defaultBufSize
pure $ Env pure $ Env
{ _env_settings = settings { _env_settings = settings
, _env_logger = logger , _env_logger = logger
, _env_pool = pool , _env_pool = pool
, _env_repo = repo , _env_repo = repo
, _env_manager = manager , _env_manager = manager
, _env_scrapers = scrapers_env , _env_scrapers = scrapers_env
, _env_self_url = self_url , _env_self_url = self_url
, _env_gargConfig = config , _env_config = config
} }
newPool :: ConnectInfo -> IO (Pool Connection) newPool :: ConnectInfo -> IO (Pool Connection)
...@@ -194,7 +193,7 @@ newPool param = createPool (connect param) close 1 (60*60) 8 ...@@ -194,7 +193,7 @@ newPool param = createPool (connect param) close 1 (60*60) 8
cleanEnv :: (HasConfig env, HasRepo env) => env -> IO () cleanEnv :: (HasConfig env, HasRepo env) => env -> IO ()
cleanEnv env = do cleanEnv env = do
r <- takeMVar (env ^. repoEnv . renv_var) r <- takeMVar (env ^. repoEnv . renv_var)
repoSaverAction (env ^. hasConfig . gc_repofilepath) r repoSaverAction (env ^. config . gc_repofilepath) r
unlockFile (env ^. repoEnv . renv_lock) unlockFile (env ^. repoEnv . renv_lock)
type IniPath = FilePath type IniPath = FilePath
......
...@@ -43,7 +43,6 @@ data Settings = Settings ...@@ -43,7 +43,6 @@ data Settings = Settings
, _cookieSettings :: CookieSettings , _cookieSettings :: CookieSettings
, _sendLoginEmails :: SendEmailType , _sendLoginEmails :: SendEmailType
, _scrapydUrl :: BaseUrl , _scrapydUrl :: BaseUrl
, _config :: GargConfig
} }
makeLenses ''Settings makeLenses ''Settings
...@@ -62,14 +61,14 @@ data Env = Env ...@@ -62,14 +61,14 @@ data Env = Env
, _env_manager :: !Manager , _env_manager :: !Manager
, _env_self_url :: !BaseUrl , _env_self_url :: !BaseUrl
, _env_scrapers :: !ScrapersEnv , _env_scrapers :: !ScrapersEnv
, _env_gargConfig :: !GargConfig , _env_config :: !GargConfig
} }
deriving (Generic) deriving (Generic)
makeLenses ''Env makeLenses ''Env
instance HasConfig Env where instance HasConfig Env where
hasConfig = env_gargConfig config = env_config
instance HasConnectionPool Env where instance HasConnectionPool Env where
connPool = env_pool connPool = env_pool
...@@ -110,7 +109,7 @@ data DevEnv = DevEnv ...@@ -110,7 +109,7 @@ data DevEnv = DevEnv
makeLenses ''DevEnv makeLenses ''DevEnv
instance HasConfig DevEnv where instance HasConfig DevEnv where
hasConfig = dev_env_config config = dev_env_config
instance HasConnectionPool DevEnv where instance HasConnectionPool DevEnv where
connPool = dev_env_pool connPool = dev_env_pool
......
...@@ -40,7 +40,7 @@ import Gargantext.Database.Prelude (HasConfig(..)) ...@@ -40,7 +40,7 @@ import Gargantext.Database.Prelude (HasConfig(..))
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..)) import Gargantext.Prelude.Config (gc_max_docs_scrapers)
import Servant import Servant
import Servant.Auth as SA import Servant.Auth as SA
import Servant.Auth.Swagger () import Servant.Auth.Swagger ()
...@@ -249,9 +249,8 @@ addCorpusWithQuery :: User -> GargServer New.AddWithQuery ...@@ -249,9 +249,8 @@ addCorpusWithQuery :: User -> GargServer New.AddWithQuery
addCorpusWithQuery user cid = addCorpusWithQuery user cid =
serveJobsAPI $ serveJobsAPI $
JobFunction (\q log -> do JobFunction (\q log -> do
conf <- view hasConfig limit <- view $ config . gc_max_docs_scrapers
let limit = Just $ _gc_max_docs_scrapers conf New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log)
New.addToCorpusWithQuery user cid q limit (liftBase . log)
{- let log' x = do {- let log' x = do
printDebug "addToCorpusWithQuery" x printDebug "addToCorpusWithQuery" x
liftBase $ log x liftBase $ log x
......
...@@ -13,6 +13,7 @@ Portability : POSIX ...@@ -13,6 +13,7 @@ Portability : POSIX
--------------------------------------------------------------------- ---------------------------------------------------------------------
module Gargantext.API.Server where module Gargantext.API.Server where
--------------------------------------------------------------------- ---------------------------------------------------------------------
import Control.Lens ((^.))
import Control.Monad.Except (withExceptT) import Control.Monad.Except (withExceptT)
import Control.Monad.Reader (runReaderT) import Control.Monad.Reader (runReaderT)
import Data.Text (Text) import Data.Text (Text)
...@@ -31,6 +32,8 @@ import Gargantext.API.Routes ...@@ -31,6 +32,8 @@ import Gargantext.API.Routes
import Gargantext.API.Swagger (swaggerDoc) import Gargantext.API.Swagger (swaggerDoc)
import Gargantext.API.ThrowAll (serverPrivateGargAPI) import Gargantext.API.ThrowAll (serverPrivateGargAPI)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_url_backend_api)
import Gargantext.Database.Prelude (config)
serverGargAPI :: Text -> GargServerM env err GargAPI serverGargAPI :: Text -> GargServerM env err GargAPI
...@@ -46,15 +49,15 @@ serverGargAPI baseUrl -- orchestrator ...@@ -46,15 +49,15 @@ serverGargAPI baseUrl -- orchestrator
gargVersion = pure (cs $ showVersion PG.version) gargVersion = pure (cs $ showVersion PG.version)
-- | Server declarations -- | Server declarations
server :: forall env. EnvC env => env -> Text -> IO (Server API) server :: forall env. EnvC env => env -> IO (Server API)
server env baseUrl = do server env = do
-- orchestrator <- scrapyOrchestrator env -- orchestrator <- scrapyOrchestrator env
pure $ swaggerSchemaUIServer swaggerDoc pure $ swaggerSchemaUIServer swaggerDoc
:<|> hoistServerWithContext :<|> hoistServerWithContext
(Proxy :: Proxy GargAPI) (Proxy :: Proxy GargAPI)
(Proxy :: Proxy AuthContext) (Proxy :: Proxy AuthContext)
transform transform
(serverGargAPI baseUrl) (serverGargAPI (env ^. config . gc_url_backend_api))
:<|> frontEndServer :<|> frontEndServer
where where
transform :: forall a. GargM env GargError a -> Handler a transform :: forall a. GargM env GargError a -> Handler a
......
...@@ -17,8 +17,6 @@ CSV parser for Gargantext corpus files. ...@@ -17,8 +17,6 @@ CSV parser for Gargantext corpus files.
module Gargantext.Core.Text.List.Learn module Gargantext.Core.Text.List.Learn
where where
import Control.Monad.Reader (MonadReader)
-- TODO remvoe this deps
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
import qualified Data.List as List import qualified Data.List as List
import Data.Map (Map) import Data.Map (Map)
...@@ -26,7 +24,6 @@ import qualified Data.Map as Map ...@@ -26,7 +24,6 @@ import qualified Data.Map as Map
import qualified Data.SVM as SVM import qualified Data.SVM as SVM
import qualified Data.Vector as Vec import qualified Data.Vector as Vec
import Gargantext.API.Admin.Types
import Gargantext.Core.Text.Metrics.Count (occurrencesWith) import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
import Gargantext.Core.Types.Main (ListType(..), listTypeId, fromListTypeId) import Gargantext.Core.Types.Main (ListType(..), listTypeId, fromListTypeId)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -85,12 +82,12 @@ type Tests = Map ListType [Vec.Vector Double] ...@@ -85,12 +82,12 @@ type Tests = Map ListType [Vec.Vector Double]
type Score = Double type Score = Double
type Param = Double type Param = Double
grid :: (MonadReader env m, MonadBase IO m, HasSettings env) grid :: (MonadBase IO m)
=> Param -> Param -> Train -> [Tests] -> m (Maybe Model) => Param -> Param -> Train -> [Tests] -> m (Maybe Model)
grid _ _ _ [] = panic "Gargantext.Core.Text.List.Learn.grid : empty test data" grid _ _ _ [] = panic "Gargantext.Core.Text.List.Learn.grid : empty test data"
grid s e tr te = do grid s e tr te = do
let let
grid' :: (MonadReader env m, MonadBase IO m, HasSettings env) grid' :: (MonadBase IO m)
=> Double -> Double => Double -> Double
-> Train -> Train
-> [Tests] -> [Tests]
......
...@@ -21,7 +21,6 @@ import Control.Lens (view, (^.)) ...@@ -21,7 +21,6 @@ import Control.Lens (view, (^.))
import Data.Text import Data.Text
import Servant import Servant
import Gargantext.API.Admin.Types
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.User (getUserId) import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Action.Share (delFolderTeam) import Gargantext.Database.Action.Share (delFolderTeam)
...@@ -38,7 +37,7 @@ import qualified Gargantext.Prelude.Utils as GPU ...@@ -38,7 +37,7 @@ import qualified Gargantext.Prelude.Utils as GPU
------------------------------------------------------------------------ ------------------------------------------------------------------------
deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err, HasSettings env) deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err)
=> User => User
-> NodeId -> NodeId
-> Cmd' env err Int -> Cmd' env err Int
......
...@@ -91,13 +91,13 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do ...@@ -91,13 +91,13 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
case maybeNodeId of case maybeNodeId of
[] -> nodeError (DoesNotExist i) [] -> nodeError (DoesNotExist i)
[n] -> do [n] -> do
config <- view hasConfig cfg <- view config
u <- case nt of u <- case nt of
NodeFrameWrite -> pure $ _gc_frame_write_url config NodeFrameWrite -> pure $ _gc_frame_write_url cfg
NodeFrameCalc -> pure $ _gc_frame_calc_url config NodeFrameCalc -> pure $ _gc_frame_calc_url cfg
_ -> nodeError NeedsConfiguration _ -> nodeError NeedsConfiguration
let let
s = _gc_secretkey config s = _gc_secretkey cfg
hd = HyperdataFrame u (hash $ s <> (cs $ show n)) hd = HyperdataFrame u (hash $ s <> (cs $ show n))
_ <- updateHyperdata n hd _ <- updateHyperdata n hd
pure [n] pure [n]
......
...@@ -34,9 +34,9 @@ type EmailAddress = Text ...@@ -34,9 +34,9 @@ type EmailAddress = Text
newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err) newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err)
=> [EmailAddress] -> m Int64 => [EmailAddress] -> m Int64
newUsers us = do newUsers us = do
us' <- mapM newUserQuick us us' <- mapM newUserQuick us
conf <- view hasConfig url <- view $ config . gc_url
newUsers' (_gc_url conf) us' newUsers' url us'
------------------------------------------------------------------------ ------------------------------------------------------------------------
newUserQuick :: (MonadRandom m) newUserQuick :: (MonadRandom m)
=> Text -> m (NewUser GargPassword) => Text -> m (NewUser GargPassword)
......
...@@ -51,10 +51,10 @@ instance HasConnectionPool (Pool Connection) where ...@@ -51,10 +51,10 @@ instance HasConnectionPool (Pool Connection) where
connPool = identity connPool = identity
class HasConfig env where class HasConfig env where
hasConfig :: Getter env GargConfig config :: Getter env GargConfig
instance HasConfig GargConfig where instance HasConfig GargConfig where
hasConfig = identity config = identity
------------------------------------------------------- -------------------------------------------------------
type JSONB = QueryRunnerColumnDefault PGJsonb type JSONB = QueryRunnerColumnDefault PGJsonb
......
...@@ -67,6 +67,7 @@ readConfig fp = do ...@@ -67,6 +67,7 @@ readConfig fp = do
(val "FRAME_ISTEX_URL") (val "FRAME_ISTEX_URL")
(read $ cs $ val "MAX_DOCS_SCRAPERS") (read $ cs $ val "MAX_DOCS_SCRAPERS")
{- UNUSED
defaultConfig :: GargConfig defaultConfig :: GargConfig
defaultConfig = GargConfig "https://localhost" defaultConfig = GargConfig "https://localhost"
"https://localhost:8008/api/v1.0" "https://localhost:8008/api/v1.0"
...@@ -79,3 +80,4 @@ defaultConfig = GargConfig "https://localhost" ...@@ -79,3 +80,4 @@ defaultConfig = GargConfig "https://localhost"
"https://frame_searx.url" "https://frame_searx.url"
"https://frame_istex.url" "https://frame_istex.url"
1000 1000
-}
\ No newline at end of file
...@@ -14,7 +14,7 @@ module Gargantext.Prelude.Utils ...@@ -14,7 +14,7 @@ module Gargantext.Prelude.Utils
import Control.Exception import Control.Exception
import Control.Lens (view) import Control.Lens (view)
import Control.Monad.Reader (ask, MonadReader) import Control.Monad.Reader (MonadReader)
import Control.Monad.Random.Class (MonadRandom) import Control.Monad.Random.Class (MonadRandom)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
...@@ -25,9 +25,9 @@ import System.IO.Error ...@@ -25,9 +25,9 @@ import System.IO.Error
import System.Random (newStdGen) import System.Random (newStdGen)
import qualified System.Random.Shuffle as SRS import qualified System.Random.Shuffle as SRS
import Gargantext.API.Admin.Types
import Gargantext.Prelude.Config import Gargantext.Prelude.Config
import Gargantext.Prelude.Crypto.Hash import Gargantext.Prelude.Crypto.Hash
import Gargantext.Database.Prelude (HasConfig(..))
import Gargantext.Database.Admin.Types.Node (NodeId, NodeType) import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -71,10 +71,10 @@ folderFilePath = do ...@@ -71,10 +71,10 @@ folderFilePath = do
pure (foldPath, fileName) pure (foldPath, fileName)
writeFile :: (MonadReader env m, MonadBase IO m, HasSettings env, SaveFile a) writeFile :: (MonadReader env m, MonadBase IO m, HasConfig env, SaveFile a)
=> a -> m FilePath => a -> m FilePath
writeFile a = do writeFile a = do
dataPath <- view (settings . config . gc_datafilepath) <$> ask dataPath <- view $ config . gc_datafilepath
(foldPath, fileName) <- folderFilePath (foldPath, fileName) <- folderFilePath
...@@ -88,16 +88,16 @@ writeFile a = do ...@@ -88,16 +88,16 @@ writeFile a = do
pure filePath pure filePath
readFile :: (MonadReader env m, MonadBase IO m, HasSettings env, ReadFile a) readFile :: (MonadReader env m, MonadBase IO m, HasConfig env, ReadFile a)
=> FilePath -> m a => FilePath -> m a
readFile fp = do readFile fp = do
dataPath <- view (settings . config . gc_datafilepath) <$> ask dataPath <- view $ config . gc_datafilepath
liftBase $ readFile' $ dataPath <> "/" <> fp liftBase $ readFile' $ dataPath <> "/" <> fp
removeFile :: (MonadReader env m, MonadBase IO m, HasSettings env) removeFile :: (MonadReader env m, MonadBase IO m, HasConfig env)
=> FilePath -> m () => FilePath -> m ()
removeFile fp = do removeFile fp = do
dataPath <- view (settings . config . gc_datafilepath) <$> ask dataPath <- view $ config . gc_datafilepath
liftBase $ SD.removeFile (dataPath <> "/" <> fp) `catch` handleExists liftBase $ SD.removeFile (dataPath <> "/" <> fp) `catch` handleExists
where where
handleExists e handleExists e
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment