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