Make microservices proxy settings configurable

gargantext-cors-settings.toml → gargantext-settings.toml

+
+[cors]
+
 allowed-origins = [
     "https://demo.gargantext.org"
   , "https://formation.gargantext.org"
@@ -15,3 +18,7 @@ allowed-origins = [
   ]
 
 use-origins-for-hosts = true
+
+[microservices]
+
+proxy-port = 8009

gargantext.cabal

@@ -49,7 +49,7 @@ data-files:
     test-data/phylo/phylo2dot2json.golden.json
     test-data/stemming/lancaster.txt
     test-data/test_config.ini
-    gargantext-cors-settings.toml
+    gargantext-settings.toml
     .clippy.dhall
 
 -- common options
@@ -107,6 +107,8 @@ library
       Gargantext.API.Admin.Orchestrator.Types
       Gargantext.API.Admin.Settings
       Gargantext.API.Admin.Settings.CORS
+      Gargantext.API.Admin.Settings.MicroServices
+      Gargantext.API.Admin.Settings.TOML
       Gargantext.API.Admin.Types
       Gargantext.API.Auth.PolicyCheck
       Gargantext.API.Count.Types

src/Gargantext/API.hs

@@ -46,7 +46,8 @@ import Gargantext.API.Admin.Auth.Types (AuthContext)
 import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
 import Gargantext.API.Admin.Settings (newEnv)
 import Gargantext.API.Admin.Settings.CORS
-import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings)
+import Gargantext.API.Admin.Settings.MicroServices
+import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings, microservicesSettings)
 import Gargantext.API.Middleware (logStdoutDevSanitised)
 import Gargantext.API.Routes.Named (API)
 import Gargantext.API.Routes.Named.EKG
@@ -70,14 +71,15 @@ import System.FilePath
 startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
 startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
   env <- newEnv logger port file
+  let proxyPort = env ^. settings.microservicesSettings.msProxyPort
   runDbCheck env
-  portRouteInfo port
+  portRouteInfo port proxyPort
   app <- makeApp env
   mid <- makeGargMiddleware (env ^. settings.corsSettings) mode
   periodicActions <- schedulePeriodicActions env
 
   let runServer = run port (mid app) `finally` stopGargantext periodicActions
-  let runProxy  = run (port + 1) (microServicesProxyApp env)
+  let runProxy  = run proxyPort (microServicesProxyApp env)
 
   Async.race_ runServer runProxy
 
@@ -90,15 +92,15 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
               "You must run 'gargantext-init " <> pack file <>
               "' before running gargantext-server (only the first time)."
 
-portRouteInfo :: PortNumber -> IO ()
-portRouteInfo port = do
+portRouteInfo :: PortNumber -> PortNumber -> IO ()
+portRouteInfo mainPort proxyPort = do
   putStrLn   "=========================================================================================================="
   putStrLn   " GarganText Main Routes"
   putStrLn   "=========================================================================================================="
-  putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece port <> "/index.html"
-  putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
-  putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece port <> "/gql"
-  putStrLn $ " - Microservices proxy .....................: " <> "http://localhost:" <> toUrlPiece (port +1)
+  putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece mainPort <> "/index.html"
+  putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece mainPort <> "/swagger-ui"
+  putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece mainPort <> "/gql"
+  putStrLn $ " - Microservices proxy .....................: " <> "http://localhost:" <> toUrlPiece proxyPort
   putStrLn   "=========================================================================================================="
 
 -- | Stops the gargantext server and cancels all the periodic actions

src/Gargantext/API/Admin/EnvTypes.hs

@@ -12,6 +12,7 @@ module Gargantext.API.Admin.EnvTypes (
   , mkJobHandle
   , env_logger
   , env_manager
+  , env_settings
   , env_self_url
   , menv_firewall
   , dev_env_logger

src/Gargantext/API/Admin/Settings.hs

@@ -25,10 +25,9 @@ import Control.Monad.Logger (LogLevel(..))
 import Control.Monad.Reader
 import Data.ByteString.Lazy qualified as L
 import Data.Pool (Pool)
-import qualified Data.Pool as Pool
 import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
 import Gargantext.API.Admin.EnvTypes
-import Gargantext.API.Admin.Settings.CORS
+import Gargantext.API.Admin.Settings.TOML (GargTomlSettings(..), loadGargTomlSettings)
 import Gargantext.API.Admin.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
@@ -52,15 +51,17 @@ import Servant.Job.Async (newJobEnv, defaultSettings)
 import System.Directory
 import System.IO (hClose)
 import System.IO.Temp (withTempFile)
+import qualified Data.Pool as Pool
 
 devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
   jwkExists <- doesFileExist jwkFile
   when (not jwkExists) $ writeKey jwkFile
   jwk       <- readKey jwkFile
-  gargCorsSettings <- loadGargCorsSettings
+  GargTomlSettings{..} <- loadGargTomlSettings
   pure $ Settings
-    { _corsSettings = gargCorsSettings
+    { _corsSettings = _gargCorsSettings
+    , _microservicesSettings = _gargMicroServicesSettings
     , _appPort = 3000
     , _logLevelLimit = LevelDebug
 --    , _dbServer = "localhost"

src/Gargantext/API/Admin/Settings/CORS.hs

@@ -6,13 +6,11 @@ module Gargantext.API.Admin.Settings.CORS where
 
 import Prelude
 
+import Control.Arrow
 import Data.Text qualified as T
 import Toml
-import Gargantext.System.Logging
-import Paths_gargantext
-import Data.String
-import Control.Arrow
-import Control.Lens.TH
+import Control.Lens hiding (iso, (.=))
+import Data.String (IsString)
 
 newtype CORSOrigin = CORSOrigin { _CORSOrigin :: T.Text }
   deriving (Show, Eq, IsString)
@@ -35,23 +33,9 @@ corsOriginCodec = _Orig >>> _Text
    _Orig = iso _CORSOrigin CORSOrigin
 
 corsSettingsCodec :: TomlCodec CORSSettings
-corsSettingsCodec = CORSSettings <$> (Toml.arrayOf corsOriginCodec "allowed-origins" .= _corsAllowedOrigins)
-                                 <*> pure mempty -- FIXME(adn) Currently we don't need to support this field.
-                                 <*> Toml.bool "use-origins-for-hosts" .= _corsUseOriginsForHosts
-
--- | Loads the 'CORSSettings' from the 'toml' file.
-loadGargCorsSettings :: IO CORSSettings
-loadGargCorsSettings = do
-  corsFile <- getDataFileName "gargantext-cors-settings.toml"
-  tomlRes <- Toml.decodeFileEither corsSettingsCodec corsFile
-  case tomlRes of
-      Left errs      -> do
-        withLogger () $ \ioLogger -> do
-          logMsg ioLogger WARNING $ T.unpack $ "Error, gargantext-cors-settings.toml parsing failed: " <> Toml.prettyTomlDecodeErrors errs
-          pure $ CORSSettings ["http://localhost:8008"] ["http://localhost:3000"] False
-      Right settings0 -> case _corsUseOriginsForHosts settings0 of
-        True  -> pure $ settings0 { _corsAllowedHosts = "http://localhost:3000" : (_corsAllowedOrigins settings0) }
-        False -> pure $ settings0 { _corsAllowedHosts = "http://localhost:3000" : (_corsAllowedHosts settings0) }
-
+corsSettingsCodec = CORSSettings
+     <$> Toml.arrayOf corsOriginCodec "allowed-origins" .= _corsAllowedOrigins
+     <*> pure mempty -- FIXME(adn) Currently we don't need to support this field.
+     <*> Toml.bool "use-origins-for-hosts" .= _corsUseOriginsForHosts
 
 makeLenses ''CORSSettings

src/Gargantext/API/Admin/Settings/MicroServices.hs

+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module Gargantext.API.Admin.Settings.MicroServices where
+
+import Prelude
+
+import Toml
+import Control.Lens.TH
+
+data MicroServicesSettings =
+  MicroServicesSettings {
+    -- | The port where the microservices proxy will be listening on.
+    _msProxyPort :: Int
+  } deriving (Show, Eq)
+
+microServicesSettingsCodec :: TomlCodec MicroServicesSettings
+microServicesSettingsCodec = MicroServicesSettings
+  <$> Toml.int "proxy-port" .= _msProxyPort
+
+makeLenses ''MicroServicesSettings

src/Gargantext/API/Admin/Settings/TOML.hs

+{-# LANGUAGE TemplateHaskell #-}
+module Gargantext.API.Admin.Settings.TOML where
+
+import Control.Lens hiding ((.=))
+import Data.Text qualified as T
+import Gargantext.API.Admin.Settings.CORS
+import Gargantext.API.Admin.Settings.MicroServices
+import Gargantext.Prelude (panicTrace)
+import Gargantext.System.Logging
+import Paths_gargantext
+import Prelude
+import Toml
+
+-- | Compatibility bridge until we fix #304 (move to Toml)
+data GargTomlSettings = GargTomlSettings
+  { _gargCorsSettings          :: !CORSSettings
+  , _gargMicroServicesSettings :: !MicroServicesSettings
+  }
+
+makeLenses ''GargTomlSettings
+
+settingsCodec :: TomlCodec GargTomlSettings
+settingsCodec = GargTomlSettings
+  <$> (Toml.table corsSettingsCodec "cors" .= _gargCorsSettings)
+  <*> (Toml.table  microServicesSettingsCodec "microservices" .= _gargMicroServicesSettings)
+
+-- | Loads the 'CORSSettings' from the 'toml' file.
+loadGargTomlSettings :: IO GargTomlSettings
+loadGargTomlSettings = do
+  tomlFile <- getDataFileName "gargantext-settings.toml"
+  tomlRes <- Toml.decodeFileEither settingsCodec tomlFile
+  case tomlRes of
+      Left errs      -> do
+        withLogger () $ \ioLogger -> do
+          logMsg ioLogger ERROR $ T.unpack $ "Error, gargantext-settings.toml parsing failed: " <> Toml.prettyTomlDecodeErrors errs
+          panicTrace "Please fix the errors in your gargantext-settings.toml file."
+      Right settings0 -> case settings0 ^. gargCorsSettings . corsUseOriginsForHosts of
+        True  -> pure $ settings0 & over (gargCorsSettings . corsAllowedHosts) (\_ -> "http://localhost:3000" : (settings0 ^. gargCorsSettings . corsAllowedOrigins))
+        False -> pure $ settings0 & over (gargCorsSettings . corsAllowedHosts) ("http://localhost:3000" :)

src/Gargantext/API/Admin/Types.hs

@@ -9,6 +9,7 @@ import Gargantext.API.Admin.Settings.CORS
 import Gargantext.Prelude
 import Servant.Auth.Server (JWTSettings, CookieSettings(..))
 import Servant.Client (BaseUrl)
+import Gargantext.API.Admin.Settings.MicroServices
 
 
 type PortNumber = Int
@@ -19,15 +20,16 @@ data SendEmailType = SendEmailViaAws
     deriving (Show, Read, Enum, Bounded, Generic)
 
 data Settings = Settings
-    { _corsSettings    :: !CORSSettings   -- CORS settings
-    , _appPort         :: !PortNumber
-    , _logLevelLimit   :: !LogLevel -- log level from the monad-logger package
+    { _corsSettings          :: !CORSSettings   -- CORS settings
+    , _microservicesSettings :: !MicroServicesSettings
+    , _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

src/Gargantext/API/Node/Corpus/New.hs

@@ -150,7 +150,9 @@ type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
 addToCorpusWithQuery :: ( FlowCmdM env err m
                         , MonadJobStatus m
                         , HasNodeStoryImmediateSaver env
-                        , HasNodeArchiveStoryImmediateSaver env )
+                        , HasNodeArchiveStoryImmediateSaver env
+                        , HasSettings env
+                        )
                        => User
                        -> CorpusId
                        -> WithQuery
@@ -222,7 +224,9 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
 addToCorpusWithForm :: ( FlowCmdM env err m
                        , MonadJobStatus m
                        , HasNodeStoryImmediateSaver env
-                       , HasNodeArchiveStoryImmediateSaver env )
+                       , HasNodeArchiveStoryImmediateSaver env
+                       , HasSettings env
+                       )
                     => User
                     -> CorpusId
                     -> NewWithForm

src/Gargantext/API/Node/Corpus/Searx.hs

@@ -48,6 +48,7 @@ import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..))
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Prelude qualified
+import Gargantext.API.Admin.Types (HasSettings)
 
 langToSearx :: Lang -> Text
 langToSearx x   = Text.toLower acronym <> "-" <> acronym
@@ -120,7 +121,9 @@ insertSearxResponse :: ( MonadBase IO m
                        , HasNLPServer env
                        , HasNodeError err
                        , HasTreeError err
-                       , HasValidationError err )
+                       , HasValidationError err
+                       , HasSettings env
+                       )
                     => User
                     -> CorpusId
                     -> ListId
@@ -163,7 +166,9 @@ triggerSearxSearch :: ( MonadBase IO m
                       , HasNodeError err
                       , HasTreeError err
                       , HasValidationError err
-                      , MonadJobStatus m )
+                      , MonadJobStatus m
+                      , HasSettings env
+                      )
                    => User
                    -> CorpusId
                    -> Query.RawQuery

src/Gargantext/API/Node/DocumentUpload.hs

@@ -20,6 +20,7 @@ import Control.Lens (view)
 import Data.Text qualified as T
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Node.DocumentUpload.Types
 import Gargantext.API.Prelude ( GargM )
@@ -44,7 +45,7 @@ api nId = Named.DocumentUploadAPI $ AsyncJobs $
   serveJobsAPI UploadDocumentJob $ \jHandle q -> do
       documentUploadAsync nId q jHandle
 
-documentUploadAsync :: (FlowCmdM env err m, MonadJobStatus m)
+documentUploadAsync :: (FlowCmdM env err m, MonadJobStatus m, HasSettings env)
                => NodeId
                -> DocumentUpload
                -> JobHandle m
@@ -55,7 +56,7 @@ documentUploadAsync nId doc jobHandle = do
   -- printDebug "documentUploadAsync" docIds
   markComplete jobHandle
 
-documentUpload :: (FlowCmdM env err m)
+documentUpload :: (FlowCmdM env err m, HasSettings env)
                => NodeId
                -> DocumentUpload
                -> m [DocId]

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -41,6 +41,7 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..), markFailureNoErr
 import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Servant.Server.Generic (AsServerT)
+import Gargantext.API.Admin.Types (HasSettings)
 
 
 api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError))
@@ -53,7 +54,9 @@ api authenticatedUser nId = Named.FrameCalcAPI $ AsyncJobs $
 frameCalcUploadAsync :: ( HasConfig env
                         , FlowCmdM env err m
                         , MonadJobStatus m
-                        , HasNodeArchiveStoryImmediateSaver env )
+                        , HasNodeArchiveStoryImmediateSaver env
+                        , HasSettings env
+                        )
                      => AuthenticatedUser
                      -- ^ The logged-in user
                      -> NodeId

src/Gargantext/API/Node/New.hs

@@ -31,19 +31,20 @@ import Gargantext.API.Routes.Named.Node qualified as Named
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Node
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmd')
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant.Server.Generic (AsServerT)
+import Gargantext.API.Admin.Types (HasSettings)
 
 ------------------------------------------------------------------------
-postNode :: HasNodeError err
+postNode :: (HasNodeError err, HasSettings env)
          => AuthenticatedUser
          -- ^ The logged-in user
          -> NodeId
          -> PostNode
-         -> Cmd err [NodeId]
+         -> DBCmd' env err [NodeId]
 postNode authenticatedUser pId (PostNode nodeName nt) = do
   let userId = authenticatedUser ^. auth_user_id
   mkNodeWithParent nt (Just pId) userId nodeName
@@ -58,7 +59,7 @@ postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
   serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle
 
 ------------------------------------------------------------------------
-postNodeAsync :: (FlowCmdM env err m, MonadJobStatus m)
+postNodeAsync :: (FlowCmdM env err m, MonadJobStatus m, HasSettings env)
     => AuthenticatedUser
     -- ^ The logged in user
     -> NodeId

src/Gargantext/API/Node/Share.hs

@@ -32,12 +32,13 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Tree (findNodesWithType)
 import Gargantext.Prelude
 import Servant.Server.Generic (AsServerT)
+import Gargantext.API.Admin.Types (HasSettings)
 
 ------------------------------------------------------------------------
 -- TODO permission
 -- TODO refactor userId which is used twice
 -- TODO change return type for better warning/info/success/error handling on the front
-api :: (HasNodeError err, HasNLPServer env, CmdRandom env err m)
+api :: (HasNodeError err, HasNLPServer env, CmdRandom env err m, HasSettings env)
     => User
     -> NodeId
     -> ShareNodeParams

src/Gargantext/Core/Viz/Graph/API.hs

@@ -21,6 +21,7 @@ module Gargantext.Core.Viz.Graph.API
 import Control.Lens (set, _Just, (^?), at)
 import Data.HashMap.Strict qualified as HashMap
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Prelude (GargM)
@@ -36,7 +37,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOn
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Config ( userMaster )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (DBCmd)
+import Gargantext.Database.Prelude (DBCmd, DBCmd')
 import Gargantext.Database.Query.Table.Node ( getOrMkList, getNodeWith, defaultList, getClosestParentIdByType )
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
@@ -266,11 +267,11 @@ recomputeVersions :: HasNodeStory env err m
 recomputeVersions nId = recomputeGraph nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
 
 ------------------------------------------------------------
-graphClone :: HasNodeError err
+graphClone :: (HasNodeError err, HasSettings env)
            => UserId
            -> NodeId
            -> HyperdataGraphAPI
-           -> DBCmd err NodeId
+           -> DBCmd' env err NodeId
 graphClone userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
                                          , _hyperdataAPICamera = camera }) = do
   let nodeType = NodeGraph

src/Gargantext/Database/Action/Flow.hs

@@ -90,7 +90,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus(_hc_lang) )
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(toHyperdataDocument) )
 import Gargantext.Database.Admin.Types.Node hiding (DEBUG) -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
-import Gargantext.Database.Prelude (DbCmd', DBCmd, hasConfig)
+import Gargantext.Database.Prelude (DbCmd', hasConfig, DBCmd')
 import Gargantext.Database.Query.Table.ContextNodeNgrams2 ( ContextNodeNgrams2Poly(..), insertContextNodeNgrams2 )
 import Gargantext.Database.Query.Table.Node ( MkCorpus, insertDefaultNodeIfNotExists, getOrMkList, getNodeWith )
 import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
@@ -110,6 +110,7 @@ import PUBMED.Types qualified as PUBMED
 ------------------------------------------------------------------------
 -- Imports for upgrade function
 import Gargantext.Database.Query.Tree.Error ( HasTreeError )
+import Gargantext.API.Admin.Types (HasSettings)
 
 ------------------------------------------------------------------------
 
@@ -126,14 +127,14 @@ printDataText (DataNew (maybeInt, conduitData)) = do
   putText $ show (maybeInt, res)
 
 -- TODO use the split parameter in config file
-getDataText :: (HasNodeError err)
+getDataText :: (HasNodeError err, HasSettings env)
             => DataOrigin
             -> TermType Lang
             -> API.RawQuery
             -> Maybe PUBMED.APIKey
             -> Maybe EPO.AuthKey
             -> Maybe API.Limit
-            -> DBCmd err (Either API.GetCorpusError DataText)
+            -> DBCmd' env err (Either API.GetCorpusError DataText)
 getDataText (ExternalOrigin api) la q mPubmedAPIKey mAuthKey li = do
   cfg <- view hasConfig
   eRes <- liftBase $ API.get api (_tt_lang la) q mPubmedAPIKey mAuthKey (_gc_epo_api_url cfg) li
@@ -143,12 +144,12 @@ getDataText (InternalOrigin _) la q _ _ _li = do
   ids <-  map fst <$> searchDocInDatabase cId (stem (_tt_lang la) GargPorterAlgorithm $ API.getRawQuery q)
   pure $ Right $ DataOld ids
 
-getDataText_Debug :: (HasNodeError err)
+getDataText_Debug :: (HasNodeError err, HasSettings env)
                   => DataOrigin
                   -> TermType Lang
                   -> API.RawQuery
                   -> Maybe API.Limit
-                  -> DBCmd err ()
+                  -> DBCmd' env err ()
 getDataText_Debug a l q li = do
   result <- getDataText a l q Nothing Nothing li
   case result of
@@ -165,6 +166,7 @@ flowDataText :: forall env err m.
                 , HasTreeError err
                 , HasValidationError err
                 , MonadJobStatus m
+                , HasSettings env
                 )
                 => User
                 -> DataText
@@ -193,7 +195,9 @@ flowAnnuaire :: ( DbCmd' env err m
                 , HasNLPServer env
                 , HasTreeError err
                 , HasValidationError err
-                , MonadJobStatus m )
+                , MonadJobStatus m
+                , HasSettings env
+                )
              => MkCorpusUser
              -> TermType Lang
              -> FilePath
@@ -211,7 +215,9 @@ flowCorpusFile :: ( DbCmd' env err m
                   , HasNLPServer env
                   , HasTreeError err
                   , HasValidationError err
-                  , MonadJobStatus m )
+                  , MonadJobStatus m
+                  , HasSettings env
+                  )
            => MkCorpusUser
            -> Limit -- Limit the number of docs (for dev purpose)
            -> TermType Lang
@@ -240,7 +246,9 @@ flowCorpus :: ( DbCmd' env err m
               , HasTreeError err
               , HasValidationError err
               , FlowCorpus a
-              , MonadJobStatus m )
+              , MonadJobStatus m
+              , HasSettings env
+              )
            => MkCorpusUser
            -> TermType Lang
            -> Maybe FlowSocialListWith
@@ -260,6 +268,7 @@ flow :: forall env err m a c.
         , FlowCorpus a
         , MkCorpus c
         , MonadJobStatus m
+        , HasSettings env
         )
         => Maybe c
         -> MkCorpusUser
@@ -296,6 +305,7 @@ addDocumentsToHyperCorpus :: ( DbCmd' env err m
                              , HasNodeError err
                              , FlowCorpus document
                              , MkCorpus corpus
+                             , HasSettings env
                              )
                              => NLPServerConfig
                              -> Maybe corpus
@@ -309,7 +319,7 @@ addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
   pure ids
 
 ------------------------------------------------------------------------
-createNodes :: ( DbCmd' env err m, HasNodeError err
+createNodes :: ( DbCmd' env err m, HasNodeError err, HasSettings env
                , MkCorpus c
                )
             => MkCorpusUser
@@ -338,6 +348,7 @@ flowCorpusUser :: ( HasNodeError err
                   , HasTreeError err
                   , HasNodeStory env err m
                   , MkCorpus c
+                  , HasSettings env
                   )
                => Lang
                -> User
@@ -367,6 +378,7 @@ buildSocialList :: ( HasNodeError err
                    , HasTreeError err
                    , HasNodeStory env err m
                    , MkCorpus c
+                   , HasSettings env
                    )
                 => Lang
                 -> User
@@ -402,6 +414,7 @@ insertMasterDocs :: ( DbCmd' env err m
                     , HasNodeError err
                     , FlowCorpus a
                     , MkCorpus   c
+                    , HasSettings env
                     )
                  => NLPServerConfig
                  -> Maybe c

src/Gargantext/Database/Action/Node.hs

@@ -22,12 +22,14 @@ module Gargantext.Database.Action.Node
 
 import Control.Lens (view)
 import Data.Text qualified as T
+import Gargantext.API.Admin.Settings.MicroServices
+import Gargantext.API.Admin.Types (settings, _microservicesSettings, HasSettings)
 import Gargantext.Core
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Hyperdata.Default
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (DBCmd, HasConfig(..))
+import Gargantext.Database.Prelude (HasConfig(..), DBCmd')
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
@@ -37,12 +39,12 @@ import Gargantext.Prelude.Crypto.Hash (hash)
 
 ------------------------------------------------------------------------
 -- | TODO mk all others nodes
-mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
+mkNodeWithParent :: (HasNodeError err, HasDBid NodeType, HasSettings env)
                  => NodeType
                  -> Maybe ParentId
                  -> UserId
                  -> Name
-                 -> DBCmd err [NodeId]
+                 -> DBCmd' env err [NodeId]
 mkNodeWithParent NodeUser (Just pId) uid  _ = nodeError $ NodeCreationFailed $ UserParentAlreadyExists uid pId
 
 ------------------------------------------------------------------------
@@ -71,12 +73,12 @@ mkNodeWithParent nt (Just pId) uId name  = (:[]) <$> insertNode nt (Just name) N
 
 
 -- | Sugar to create a node, get its NodeId and update its Hyperdata after
-mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
+mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType, HasSettings env)
                                     => NodeType
                                     -> Maybe ParentId
                                     -> UserId
                                     -> Name
-                                    -> DBCmd err [NodeId]
+                                    -> DBCmd' env err [NodeId]
 mkNodeWithParent_ConfigureHyperdata Notes (Just i) uId name =
   mkNodeWithParent_ConfigureHyperdata' Notes (Just i) uId name
 
@@ -93,16 +95,17 @@ mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name = (:[])
 
 mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 
-internalNotesProxy :: GargConfig -> T.Text
-internalNotesProxy cfg = "http://localhost:8009/notes-proxy"
+internalNotesProxy :: MicroServicesSettings -> T.Text
+internalNotesProxy MicroServicesSettings{..} =
+  "http://localhost:" <> T.pack (show _msProxyPort) <> "/notes-proxy"
 
 -- | Function not exposed
-mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
-                                    => NodeType
-                                    -> Maybe ParentId
-                                    -> UserId
-                                    -> Name
-                                    -> DBCmd err [NodeId]
+mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType, HasSettings env)
+                                     => NodeType
+                                     -> Maybe ParentId
+                                     -> UserId
+                                     -> Name
+                                     -> DBCmd' env err [NodeId]
 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
   nodeId <- case nt of
      Notes -> insertNode Notes (Just name)   Nothing i uId
@@ -111,8 +114,9 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
      _              -> nodeError NeedsConfiguration
 
   cfg <- view hasConfig
+  stt <- view settings
   u <- case nt of
-        Notes -> pure $ internalNotesProxy cfg
+        Notes -> pure $ internalNotesProxy (_microservicesSettings stt)
         Calc  -> pure $ _gc_frame_calc_url  cfg
         NodeFrameVisio -> pure $ _gc_frame_visio_url  cfg
         _              -> nodeError NeedsConfiguration

src/Gargantext/Database/Action/User/New.hs

@@ -29,12 +29,13 @@ import Control.Lens (view)
 import Control.Monad.Random
 import Data.Text (splitOn)
 import Data.Text qualified as Text
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.Core.Mail
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow (getOrMkRoot)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, DBCmd, CmdM)
+import Gargantext.Database.Prelude (Cmd, DBCmd, CmdM, DBCmd')
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
 import Gargantext.Database.Query.Table.User
 import Gargantext.Prelude
@@ -45,7 +46,7 @@ import qualified Data.List.NonEmpty as NE
 ------------------------------------------------------------------------
 -- | Creates a new 'User' from the input 'EmailAddress', which needs to
 -- be valid (i.e. a valid username needs to be inferred via 'guessUsername').
-newUser :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env)
+newUser :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env, HasSettings env)
         => EmailAddress
         -> m UserId
 newUser emailAddress = do
@@ -60,9 +61,9 @@ newUser emailAddress = do
 -- This is an internal function and as such it /doesn't/ send out any email
 -- notification, and thus lives in the 'DbCmd' effect stack. You may want to
 -- use 'newUser' instead for standard Gargantext code.
-new_user :: HasNodeError err
+new_user :: (HasNodeError err, HasSettings env)
          => NewUser GargPassword
-         -> DBCmd err UserId
+         -> DBCmd' env err UserId
 new_user rq = do
   (uid NE.:| _) <- new_users (rq NE.:| [])
   pure uid
@@ -72,17 +73,17 @@ new_user rq = do
 -- This is an internal function and as such it /doesn't/ send out any email
 -- notification, and thus lives in the 'DbCmd' effect stack. You may want to
 -- use 'newUsers' instead for standard Gargantext code.
-new_users :: HasNodeError err
+new_users :: (HasNodeError err, HasSettings env)
           => NonEmpty (NewUser GargPassword)
           -- ^ A list of users to create.
-          -> DBCmd err (NonEmpty UserId)
+          -> DBCmd' env err (NonEmpty UserId)
 new_users us = do
   us'   <- liftBase        $ mapM toUserHash us
   void  $ insertUsers      $ NE.map toUserWrite us'
   mapM (fmap fst . getOrMkRoot) $ NE.map  (\u -> UserName   (_nu_username u)) us
 
 ------------------------------------------------------------------------
-newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env)
+newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env, HasSettings env)
          => NonEmpty EmailAddress
          -> m (NonEmpty UserId)
 newUsers us = do
@@ -108,8 +109,8 @@ guessUserName n = case splitOn "@" n of
     _       -> Nothing
 
 ------------------------------------------------------------------------
-newUsers' :: HasNodeError err
-         => MailConfig -> NonEmpty (NewUser GargPassword) -> Cmd err (NonEmpty UserId)
+newUsers' :: (HasNodeError err, HasSettings env)
+         => MailConfig -> NonEmpty (NewUser GargPassword) -> DBCmd' env err (NonEmpty UserId)
 newUsers' cfg us = do
   us' <- liftBase         $ mapM toUserHash  us
   void $ insertUsers      $ NE.map  toUserWrite us'

src/Gargantext/Database/Prelude.hs

@@ -95,11 +95,12 @@ type CmdRandom env err m =
   , HasMail           env
   )
 
-type Cmd'' env err a = forall m.     CmdM''    env err m => m a
-type Cmd'  env err a = forall m.     CmdM'     env err m => m a
-type Cmd       err a = forall m env. CmdM      env err m => m a
-type CmdR      err a = forall m env. CmdRandom env err m => m a
-type DBCmd     err a = forall m env. DbCmd'    env err m => m a
+type Cmd''  env err a = forall m.     CmdM''    env err m => m a
+type Cmd'   env err a = forall m.     CmdM'     env err m => m a
+type Cmd        err a = forall m env. CmdM      env err m => m a
+type CmdR       err a = forall m env. CmdRandom env err m => m a
+type DBCmd' env err a = forall m.     DbCmd'    env err m => m a
+type DBCmd      err a = forall m env. DbCmd'    env err m => m a
 
 -- | Only the /minimum/ amount of class constraints required
 -- to use the Gargantext Database. It's important, to ease testability,

src/Gargantext/Database/Query/Tree/Root.hs

@@ -22,7 +22,7 @@ import Gargantext.Database.Action.User (getUserId, getUsername)
 import Gargantext.Database.Admin.Config ( corpusMasterName, userMaster )
 import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (runOpaQuery, DBCmd)
+import Gargantext.Database.Prelude (runOpaQuery, DBCmd, DBCmd')
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
@@ -30,6 +30,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead, queryNodeTable)
 import Gargantext.Prelude
 import Opaleye (restrict, (.==), Select)
 import Opaleye.SqlTypes (sqlStrictText, sqlInt4)
+import Gargantext.API.Admin.Types (HasSettings)
 
 
 getRootId :: (HasNodeError err) => User -> DBCmd err NodeId
@@ -42,9 +43,9 @@ getRootId u = do
 getRoot :: User -> DBCmd err [Node HyperdataUser]
 getRoot = runOpaQuery . selectRoot
 
-getOrMkRoot :: (HasNodeError err)
+getOrMkRoot :: (HasNodeError err, HasSettings env)
             => User
-            -> DBCmd err (UserId, RootId)
+            -> DBCmd' env err (UserId, RootId)
 getOrMkRoot user = do
   userId <- getUserId user
 
@@ -77,10 +78,10 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusIds u _cids) = u
 userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u
 
 
-getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a)
+getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a, HasSettings env)
                       => MkCorpusUser
                       -> Maybe a
-                      -> DBCmd err (UserId, RootId, CorpusId)
+                      -> DBCmd' env err (UserId, RootId, CorpusId)
 getOrMkRootWithCorpus MkCorpusUserMaster c = do
   (userId, rootId) <- getOrMkRoot (UserName userMaster)
   corpusId'' <- do
@@ -119,9 +120,9 @@ mkCorpus cName c rootId userId = do
   pure (userId, rootId, corpusId)
 
 
-mkRoot :: HasNodeError err
+mkRoot :: (HasNodeError err, HasSettings env)
        => User
-       -> DBCmd err [RootId]
+       -> DBCmd' env err [RootId]
 mkRoot user = do
 
   -- TODO

src/Gargantext/MicroServices/ReverseProxy.hs

@@ -18,6 +18,8 @@ import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
 import GHC.Generics
 import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Settings.MicroServices
+import Gargantext.API.Admin.Types
 import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (gc_frame_write_url)
@@ -77,6 +79,13 @@ forwardServer :: Env -> ServerT Raw m
 forwardServer env =
   Tagged $ waiProxyToSettings forwardRequest proxySettings (env ^. env_manager)
   where
+
+    microSrvSettings :: MicroServicesSettings
+    microSrvSettings = env ^. env_settings . microservicesSettings
+
+    pxyPort :: Int
+    pxyPort = microSrvSettings ^. msProxyPort
+
     writeFrameURL :: T.Text
     writeFrameURL = env ^. hasConfig . gc_frame_write_url
 
@@ -122,7 +131,7 @@ forwardServer env =
 
     newReferer :: RequestHeaders -> RequestHeaders
     newReferer hdrs =
-      (hReferer, "http://localhost:8009") :
+      (hReferer, fromString $ "http://localhost:" <> Prelude.show pxyPort) :
       filter ((/=) hHost . fst) hdrs
 
     forwardedHost :: (String, Int)