Merge branch '304-dev-toml-config-rewrite-and-update-deps' into 238-dev-async-job-worker

I moved HasConfig to Core/Config instead of it being in Database.Prelude

gargantext.cabal

@@ -659,6 +659,7 @@ executable gargantext-cli
     , gargantext
     , gargantext-prelude
     , ini ^>= 0.4.1
+    , lens >= 5.2.2 && < 5.3
     , monad-logger ^>= 0.3.36
     , optparse-applicative
     , optparse-generic ^>= 1.4.7

src/Gargantext/API/Admin/EnvTypes.hs

@@ -45,11 +45,11 @@ import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
 import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
 import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher)
 import Gargantext.Core.AsyncUpdates.Dispatcher.Types (HasDispatcher(..))
-import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..))
+import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..))
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
 import Gargantext.Core.NodeStory
-import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..))
+import Gargantext.Database.Prelude (HasConnectionPool(..))
 import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging
 import Gargantext.Utils.Jobs.Internal (pollJob)

src/Gargantext/API/Admin/Settings.hs

@@ -31,11 +31,10 @@ import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
 import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
 import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
-import Gargantext.Core.Config (GargConfig(..), gc_jobs, gc_frontend_config)
+import Gargantext.Core.Config (GargConfig(..), gc_jobs, gc_frontend_config, hasConfig)
 import Gargantext.Core.Config.Types (PortNumber, SettingsFile(..), fc_appPort, jc_js_job_timeout, jc_js_id_timeout, jwtSettings)
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.NodeStory
-import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Prelude
 import Gargantext.System.Logging
 import Gargantext.Utils.Jobs qualified as Jobs
@@ -51,9 +50,6 @@ import System.IO (hClose)
 import System.IO.Temp (withTempFile)
 
 
-newtype JwkFile = JwkFile { _JwkFile :: FilePath }
-  deriving (Show, Eq, IsString)
-
 newtype IniFile  = IniFile { _IniFile :: FilePath }
   deriving (Show, Eq, IsString)
 
@@ -170,9 +166,6 @@ readRepoEnv repoDir = do
   pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock }
 --}
 
-devJwkFile :: JwkFile
-devJwkFile = JwkFile "dev.jwk"
-
 newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> SettingsFile -> IO Env
 newEnv logger port settingsFile@(SettingsFile sf) = do
   !manager_env  <- newTlsManager

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -21,27 +21,26 @@ module Gargantext.API.Auth.PolicyCheck (
   , alwaysDeny
   ) where
 
-import Control.Lens
-import Control.Monad
-import Data.BoolExpr
-import Gargantext.API.Admin.Auth.Types
-import Gargantext.API.Errors.Types
-import Gargantext.Core.Types
-import Gargantext.Core.Types.Individu
-import Gargantext.Database.Prelude (DBCmd, HasConfig (..))
-import Gargantext.Database.Query.Table.Node.Error
-import Gargantext.Database.Query.Tree
-import Gargantext.Database.Query.Tree.Root
-import Gargantext.Core.Config (GargConfig(..))
+import Control.Lens (view)
+import Data.BoolExpr (BoolExpr(..), Signed(..))
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
+import Gargantext.API.Errors.Types (BackendInternalError)
+import Gargantext.Core.Config (GargConfig(..), HasConfig(hasConfig))
 import Gargantext.Core.Config.Types (SecretsConfig(..))
-import Prelude
-import Servant
-import Servant.API.Routes
-import Servant.Auth.Server.Internal.AddSetCookie
-import Servant.Client.Core
-import Servant.Ekg
-import Servant.Server.Internal.Delayed
-import Servant.Server.Internal.DelayedIO
+import Gargantext.Core.Types (NodeId, UserId)
+import Gargantext.Core.Types.Individu (User(UserName))
+import Gargantext.Database.Prelude (DBCmd)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Tree (isDescendantOf, isOwnedBy, isSharedWith)
+import Gargantext.Database.Query.Tree.Root (getRootId)
+import Gargantext.Prelude
+import Servant (HasServer(..), ServerError, ServerT, err403, err500)
+import Servant.API.Routes (HasRoutes(getRoutes))
+import Servant.Auth.Server.Internal.AddSetCookie (AddSetCookieApi, AddSetCookies(..), Nat(S))
+import Servant.Client.Core (HasClient(..), Client)
+import Servant.Ekg (HasEndpoint(..))
+import Servant.Server.Internal.Delayed (addParameterCheck)
+import Servant.Server.Internal.DelayedIO (DelayedIO(..))
 import Servant.Swagger qualified as Swagger
 
 -------------------------------------------------------------------------------
@@ -122,13 +121,13 @@ accessPolicyManager = AccessPolicyManager (\ur ac -> interpretPolicy ur ac)
       BFalse
         -> pure $ Deny err403
       BConst (Positive b)
-        -> check ur b
+        -> check' ur b
       BConst (Negative b)
-        -> check ur b
+        -> check' ur b
 
 
-check :: HasNodeError err => AuthenticatedUser -> AccessCheck -> DBCmd err AccessResult
-check (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case
+check' :: HasNodeError err => AuthenticatedUser -> AccessCheck -> DBCmd err AccessResult
+check' (AuthenticatedUser loggedUserNodeId loggedUserUserId) = \case
   AC_always_deny
     -> pure $ Deny err500
   AC_always_allow

src/Gargantext/API/GraphQL/AsyncTask.hs

@@ -20,7 +20,8 @@ import Data.Morpheus.Types ( GQLType, Resolver, QUERY )
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude (GargM, HasJobEnv')
-import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
+import Gargantext.Core.Config (HasConfig)
+import Gargantext.Database.Prelude (HasConnectionPool)
 import Gargantext.Prelude
 import Servant.Job.Async (HasJobEnv(job_env), jenv_jobs, job_async)
 import Servant.Job.Core (env_item, env_map, env_state_mvar)

src/Gargantext/API/GraphQL/PolicyCheck.hs

@@ -8,7 +8,8 @@ import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
 import Gargantext.API.Auth.PolicyCheck ( BoolExpr, AccessCheck, AccessPolicyManager(..), AccessResult(..))
 import Gargantext.API.Errors.Types ( BackendInternalError(..) )
 import Gargantext.API.GraphQL.Types (GqlM)
-import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
+import Gargantext.Core.Config (HasConfig)
+import Gargantext.Database.Prelude (HasConnectionPool)
 
 withPolicy :: (HasConnectionPool env, HasConfig env)
            => AuthenticatedUser

src/Gargantext/API/Ngrams/Types.hs

@@ -38,13 +38,14 @@ import Data.TreeDiff
 import Data.Validity ( Validity(..) )
 import Database.PostgreSQL.Simple.FromField (FromField, fromField, fromJSONField)
 import Database.PostgreSQL.Simple.ToField (ToField, toJSONField, toField)
+import Gargantext.Core.Config (HasConfig)
 import Gargantext.Core.Text (size)
 import Gargantext.Core.Text.Ngrams qualified as Ngrams
 import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO)
 import Gargantext.Core.Types.Query (Limit, Offset, MaxSize, MinSize)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node (ContextId)
-import Gargantext.Database.Prelude (fromField', HasConnectionPool, HasConfig, CmdM')
+import Gargantext.Database.Prelude (fromField', HasConnectionPool, CmdM')
 import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
 import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Gargantext.Utils.Servant (TSV, ZIP)

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

@@ -37,7 +37,7 @@ import Gargantext.API.Node.Corpus.Types ( Datafield(Web), database2origin )
 import Gargantext.API.Node.Corpus.Update (addLanguageToCorpus)
 import Gargantext.API.Node.Types
 import Gargantext.Core (withDefaultLanguage, defaultLanguage)
-import Gargantext.Core.Config (gc_jobs)
+import Gargantext.Core.Config (gc_jobs, hasConfig)
 import Gargantext.Core.Config.Types (jc_max_docs_parsers)
 import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion, NgramsStatePatch')
 import Gargantext.Core.Text.Corpus.Parsers qualified as Parser (FileType(..), parseFormatC, _ParseFormatError)
@@ -53,7 +53,6 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(
 import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) )
 import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), ParentId)
 import Gargantext.Database.GargDB qualified as GargDB
-import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Database.Query.Table.Node (getNodeWith, getOrMkList)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))

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

@@ -23,7 +23,7 @@ import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
 import Data.Tuple.Select (sel1, sel2, sel3)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.Core (Lang(..))
-import Gargantext.Core.Config (GargConfig(..))
+import Gargantext.Core.Config (GargConfig(..), hasConfig)
 import Gargantext.Core.Config.Types (FramesConfig(..))
 import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
 import Gargantext.Core.NodeStory.Types ( HasNodeStory )
@@ -40,7 +40,6 @@ import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
 import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeType(NodeTexts))
-import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Database.Query.Table.Node (getOrMkList, insertDefaultNodeIfNotExists)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Tree.Error (HasTreeError)

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -21,6 +21,7 @@ import Data.Text qualified as T
 import Gargantext.API.Admin.Auth.Types ( auth_node_id, AuthenticatedUser )
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Node.Corpus.New (addToCorpusWithForm)
 import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
@@ -28,12 +29,12 @@ import Gargantext.API.Node.FrameCalcUpload.Types
 import Gargantext.API.Node.Types (NewWithForm(..))
 import Gargantext.API.Prelude ( GargM )
 import Gargantext.API.Routes.Named.FrameCalc qualified as Named
+import Gargantext.Core.Config (HasConfig)
 import Gargantext.Core.NodeStory.Types ( HasNodeArchiveStoryImmediateSaver )
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
 import Gargantext.Database.Admin.Types.Hyperdata.Frame ( HyperdataFrame(..) )
 import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(NodeCorpus) )
-import Gargantext.Database.Prelude (HasConfig)
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNodeWith)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
@@ -41,7 +42,6 @@ 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))

src/Gargantext/API/Node/ShareURL.hs

@@ -9,10 +9,10 @@ import Data.Text qualified as T
 import Data.Validity qualified as V
 import Gargantext.API.Prelude
 import Gargantext.API.Routes.Named.Share qualified as Named
-import Gargantext.Core.Config (GargConfig, gc_frontend_config)
+import Gargantext.Core.Config (GargConfig, gc_frontend_config, HasConfig(hasConfig))
 import Gargantext.Core.Config.Types (fc_appPort, fc_url)
 import Gargantext.Core.Types (NodeType, NodeId, unNodeId, _ValidationError)
-import Gargantext.Database.Prelude (HasConfig (hasConfig), CmdCommon)
+import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Prelude
 import Network.URI (parseURI)
 import Prelude (String)

src/Gargantext/API/Prelude.hs

@@ -27,11 +27,12 @@ import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Admin.Types
 import Gargantext.API.Errors.Class
 import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification)
+import Gargantext.Core.Config (HasConfig)
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (CmdM, CmdRandom, HasConnectionPool, HasConfig)
+import Gargantext.Database.Prelude (CmdM, CmdRandom, HasConnectionPool)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Tree
 import Gargantext.Prelude

src/Gargantext/API/Routes.hs

@@ -30,10 +30,9 @@ import Gargantext.API.Node.Corpus.New qualified as New
 import Gargantext.API.Prelude
 import Gargantext.API.Routes.Named.Annuaire qualified as Named
 import Gargantext.API.Routes.Named.Corpus qualified as Named
-import Gargantext.Core.Config (gc_jobs)
+import Gargantext.Core.Config (gc_jobs, HasConfig(..))
 import Gargantext.Core.Config.Types (jc_max_docs_scrapers)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant

src/Gargantext/API/Server/Named.hs

@@ -23,9 +23,8 @@ import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
 import Gargantext.API.Swagger (swaggerDoc)
 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
 import Gargantext.Core.AsyncUpdates.Dispatcher.WebSocket qualified as Dispatcher
-import Gargantext.Core.Config (gc_frontend_config)
+import Gargantext.Core.Config (gc_frontend_config, hasConfig)
 import Gargantext.Core.Config.Types (fc_url_backend_api)
-import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Prelude hiding (Handler, catch)
 import Gargantext.System.Logging (logLocM, LogLevel(..))
 import Paths_gargantext qualified as PG -- cabal magic build module

src/Gargantext/Core/Config.hs

@@ -33,6 +33,7 @@ module Gargantext.Core.Config (
   , mkProxyUrl
 
   , HasJWTSettings(..)
+  , HasConfig(..)
   ) where
 
 import Control.Lens (Getter)
@@ -118,5 +119,12 @@ mkProxyUrl GargConfig{..} =
     Just bh -> bh { baseUrlPort = _msProxyPort $ _fc_microservices _gc_frontend_config }
 
 
+class HasConfig env where
+  hasConfig :: Getter env GargConfig
+
+instance HasConfig GargConfig where
+  hasConfig = identity
+
+
 class HasJWTSettings env where
   jwtSettings :: Getter env JWTSettings

src/Gargantext/Core/Mail.hs

@@ -15,11 +15,10 @@ import Control.Lens (view)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.List qualified as List
 import Data.Text (splitOn)
-import Gargantext.Core.Config (gc_frontend_config)
+import Gargantext.Core.Config (gc_frontend_config, HasConfig(..))
 import Gargantext.Core.Config.Types (fc_url, fc_backend_name)
 import Gargantext.Core.Config.Mail (gargMail, GargMail(..), MailConfig)
 import Gargantext.Core.Types.Individu
-import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
 import Network.URI.Encode (encodeText)

src/Gargantext/Core/Worker/Env.hs

+{-|
+Module      : Gargantext.Core.Worker.Env
+Description : Asynchronous worker logic (environment)
+Copyright   : (c) CNRS, 2024
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans      #-}  -- orphan HasNodeError IOException
+
+
+module Gargantext.Core.Worker.Env where
+
+
+import Control.Lens (prism', to, view)
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Data.Pool (Pool)
+import Data.Text qualified as T
+import Database.PostgreSQL.Simple (Connection)
+import Gargantext.API.Admin.EnvTypes (ConcreteJobHandle, GargJob, Mode(Dev), modeToLoggingLevels)
+import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
+import Gargantext.API.Admin.Settings ( devSettings, newPool )
+import Gargantext.API.Admin.Types (HasSettings(..), Settings(..))
+import Gargantext.API.Prelude (GargM)
+import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
+import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
+import Gargantext.Core.Config (GargConfig(..), HasConfig(..))
+import Gargantext.Core.Config.Mail qualified as Mail
+import Gargantext.Core.Config.Utils (readConfig)
+import Gargantext.Core.Config.Types (SettingsFile(..))
+import Gargantext.Core.Mail.Types (HasMail(..))
+import Gargantext.Core.NLP (HasNLPServer(..), NLPServerMap, nlpServerMap)
+import Gargantext.Core.NodeStory (HasNodeStoryEnv(..), HasNodeStoryImmediateSaver(..), HasNodeArchiveStoryImmediateSaver(..), NodeStoryEnv, fromDBNodeStoryEnv, nse_saver_immediate, nse_archive_saver_immediate)
+import Gargantext.Core.Types (HasValidationError(..))
+import Gargantext.Database.Prelude (HasConnectionPool(..))
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
+import Gargantext.Database.Query.Tree.Error (HasTreeError(..))
+import Gargantext.Prelude hiding (to)
+import Gargantext.System.Logging (HasLogger(..), Logger, MonadLogger(..), withLoggerHoisted)
+import Gargantext.Utils.Jobs.Monad ( MonadJobStatus(..), JobHandle )
+import GHC.IO.Exception (IOException(..), IOErrorType(OtherError))
+import Prelude qualified
+import System.Log.FastLogger qualified as FL
+
+
+data WorkerEnv = WorkerEnv
+  { _w_env_settings  :: !Settings
+  , _w_env_config    :: !GargConfig
+  , _w_env_logger    :: !(Logger (GargM WorkerEnv IOException))
+  , _w_env_pool      :: !(Pool Connection)
+  , _w_env_nodeStory :: !NodeStoryEnv
+  , _w_env_mail      :: !Mail.MailConfig
+  , _w_env_nlp       :: !NLPServerMap
+  }
+
+
+withWorkerEnv :: SettingsFile -> (WorkerEnv -> IO a) -> IO a
+withWorkerEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
+  env <- newWorkerEnv logger
+  k env -- `finally` cleanEnv env
+
+  where
+    newWorkerEnv logger = do
+      cfg     <- readConfig         settingsFile
+      --nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
+      pool    <- newPool            $ _gc_database_config cfg
+      nodeStory_env <- fromDBNodeStoryEnv pool
+      let setts = devSettings
+      pure $ WorkerEnv
+        { _w_env_pool      = pool
+        , _w_env_logger    = logger
+        , _w_env_nodeStory = nodeStory_env
+        , _w_env_settings  = setts
+        , _w_env_config    = cfg
+        , _w_env_mail      = _gc_mail_config cfg
+        , _w_env_nlp       = nlpServerMap $ _gc_nlp_config cfg
+        }
+
+instance HasConfig WorkerEnv where
+  hasConfig = to _w_env_config
+
+instance HasSettings WorkerEnv where
+  settings = to _w_env_settings
+
+instance HasLogger (GargM WorkerEnv IOException) where
+  data instance Logger (GargM WorkerEnv IOException)  =
+    GargWorkerLogger {
+        w_logger_mode    :: Mode
+      , w_logger_set     :: FL.LoggerSet
+      }
+  type instance LogInitParams (GargM WorkerEnv IOException) = Mode
+  type instance LogPayload (GargM WorkerEnv IOException)    = FL.LogStr
+  initLogger                = \mode -> do
+    w_logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
+    pure $ GargWorkerLogger mode w_logger_set
+  destroyLogger = \GargWorkerLogger{..}  -> liftIO $ FL.rmLoggerSet w_logger_set
+  logMsg = \(GargWorkerLogger mode logger_set) lvl msg -> do
+    let pfx = "[" <> show lvl <> "] " :: Text
+    when (lvl `elem` (modeToLoggingLevels mode)) $
+      liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
+  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
+
+instance HasConnectionPool WorkerEnv where
+  connPool = to _w_env_pool
+
+instance HasMail WorkerEnv where
+  mailSettings = to _w_env_mail
+
+instance HasNLPServer WorkerEnv where
+  nlpServer = to _w_env_nlp
+
+instance HasNodeStoryEnv WorkerEnv where
+  hasNodeStory = to _w_env_nodeStory
+
+instance HasNodeStoryImmediateSaver WorkerEnv where
+  hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
+
+instance HasNodeArchiveStoryImmediateSaver WorkerEnv where
+  hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate
+
+instance MonadLogger (GargM WorkerEnv IOException) where
+  getLogger = asks _w_env_logger
+
+instance CET.HasCentralExchangeNotification WorkerEnv where
+  ce_notify m = do
+    c <- asks (view $ to _w_env_config)
+    liftBase $ CE.notify (_gc_notifications_config c) m
+
+---------
+instance HasValidationError IOException where
+  _ValidationError = prism' mkIOException (const Nothing)
+    where
+      mkIOException v = IOError { ioe_handle = Nothing
+                                , ioe_type = OtherError
+                                , ioe_location = "Worker job (validation)"
+                                , ioe_description = show v
+                                , ioe_errno = Nothing
+                                , ioe_filename = Nothing }
+
+instance HasTreeError IOException where
+  _TreeError = prism' mkIOException (const Nothing)
+    where
+      mkIOException v = IOError { ioe_handle = Nothing
+                                , ioe_type = OtherError
+                                , ioe_location = "Worker job (tree)"
+                                , ioe_description = show v
+                                , ioe_errno = Nothing
+                                , ioe_filename = Nothing }
+
+instance HasNodeError IOException where
+  _NodeError = prism' (Prelude.userError . show) (const Nothing)
+
+---------------
+
+newtype WorkerMonad a =
+  WorkerMonad { _WorkerMonad :: GargM WorkerEnv IOException a }
+  deriving ( Functor
+           , Applicative
+           , Monad
+           , MonadIO
+           , MonadReader WorkerEnv
+           , MonadBase IO
+           , MonadBaseControl IO
+           , MonadError IOException
+           , MonadFail )
+
+instance HasLogger WorkerMonad where
+  data instance Logger WorkerMonad =
+    WorkerMonadLogger {
+        wm_logger_mode    :: Mode
+      , wm_logger_set     :: FL.LoggerSet
+      }
+  type instance LogInitParams WorkerMonad = Mode
+  type instance LogPayload WorkerMonad    = FL.LogStr
+  initLogger                = \mode -> do
+    wm_logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
+    pure $ WorkerMonadLogger mode wm_logger_set
+  destroyLogger = \WorkerMonadLogger{..}  -> liftIO $ FL.rmLoggerSet wm_logger_set
+  logMsg = \(WorkerMonadLogger mode logger_set) lvl msg -> do
+    let pfx = "[" <> show lvl <> "] " :: Text
+    when (lvl `elem` (modeToLoggingLevels mode)) $
+      liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
+  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
+
+instance MonadLogger WorkerMonad where
+  getLogger = do
+    env <- ask
+    let (GargWorkerLogger { .. }) = _w_env_logger env
+    pure $ WorkerMonadLogger { wm_logger_mode = w_logger_mode
+                             , wm_logger_set = w_logger_set }
+
+runWorkerMonad :: WorkerEnv -> WorkerMonad a -> IO a
+runWorkerMonad env m = do
+  res <- runExceptT . flip runReaderT env $ _WorkerMonad m
+  case res of
+    Left e -> throwIO e
+    Right x -> pure x
+
+
+
+data WorkerJobHandle = WorkerNoJobHandle
+
+instance MonadJobStatus WorkerMonad where
+  -- type JobHandle      WorkerMonad = WorkerJobHandle
+  type JobHandle      WorkerMonad = ConcreteJobHandle IOException
+  type JobType        WorkerMonad = GargJob
+  type JobOutputType  WorkerMonad = JobLog
+  type JobEventType   WorkerMonad = JobLog
+
+  -- noJobHandle _         = WorkerNoJobHandle
+  -- noJobHandle _         = noJobHandle (Proxy :: Proxy (GargM WorkerEnv IOException))  -- ConcreteNullHandle
+  noJobHandle _ = noJobHandle (Proxy :: Proxy WorkerMonad)
+  getLatestJobStatus _  = WorkerMonad (pure noJobLog)
+  withTracer _ jh n     = n jh
+  markStarted _ _       = WorkerMonad $ pure ()
+  markProgress _ _      = WorkerMonad $ pure ()
+  markFailure _ _ _     = WorkerMonad $ pure ()
+  markComplete _        = WorkerMonad $ pure ()
+  markFailed _ _        = WorkerMonad $ pure ()
+  addMoreSteps _ _      = WorkerMonad $ pure ()

src/Gargantext/Core/Worker/Jobs.hs

+{-|
+Module      : Gargantext.Core.Worker.Jobs
+Description : Worker job definitions
+Copyright   : (c) CNRS, 2024
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+
+module Gargantext.Core.Worker.Jobs where
+
+
+import Async.Worker.Broker.Redis (RedisBroker, BrokerInitParams(RedisBrokerInitParams))
+import Async.Worker.Broker.Types (Broker, initBroker)
+import Async.Worker qualified as Worker
+import Async.Worker.Types qualified as Worker
+import Async.Worker.Types (HasWorkerBroker)
+import Control.Lens (view)
+import Database.Redis qualified as Redis
+import Gargantext.Core.Config (gc_worker, HasConfig(..))
+import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..), wdToRedisConnectInfo)
+import Gargantext.Core.Worker.Jobs.Types (Job(..))
+import Gargantext.Database.Prelude (Cmd')
+import Gargantext.Prelude
+
+
+initializeRedisBroker :: (HasWorkerBroker RedisBroker Job)
+                      => Redis.ConnectInfo
+                      -> IO (Broker RedisBroker (Worker.Job Job))
+initializeRedisBroker connInfo = do
+  let initParams = RedisBrokerInitParams connInfo
+
+  initBroker initParams
+
+
+sendJob :: (HasWorkerBroker RedisBroker Job, HasConfig env)
+        => Job
+        -> Cmd' env err ()
+sendJob job = do
+  ws <- view $ hasConfig . gc_worker
+  -- TODO Try to guess which worker should get this job
+  -- let mWd = findDefinitionByName ws workerName
+  let mWd = head $ _wsDefinitions ws
+  case mWd of
+    Nothing -> panicTrace $ "worker definition not found"
+    Just wd -> liftBase $ do
+      case wdToRedisConnectInfo wd of
+        Nothing -> panicTrace $ "worker definition: could not create redis conn info"
+        Just connInfo -> do
+          b <- initializeRedisBroker connInfo
+          let queueName = _wdQueue wd
+          void $ Worker.sendJob' $ Worker.mkDefaultSendJob' b queueName job

src/Gargantext/Database/Action/Flow.hs

@@ -66,7 +66,7 @@ import EPO.API.Client.Types qualified as EPO
 import Gargantext.API.Ngrams.Tools (getTermsWith)
 import Gargantext.Core (Lang(..), NLPServerConfig, withDefaultLanguage)
 import Gargantext.Core.AsyncUpdates.CentralExchange.Types (HasCentralExchangeNotification(ce_notify), CEMessage(..))
-import Gargantext.Core.Config (GargConfig(..))
+import Gargantext.Core.Config (GargConfig(..), hasConfig)
 import Gargantext.Core.Config.Types (APIsConfig(..))
 import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
 import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
@@ -93,7 +93,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', hasConfig, DBCmd')
+import Gargantext.Database.Prelude (DbCmd', 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)

src/Gargantext/Database/Action/Node.hs

@@ -20,13 +20,13 @@ module Gargantext.Database.Action.Node
 import Control.Lens (view)
 import Data.Text qualified as T
 import Gargantext.Core
-import Gargantext.Core.Config (GargConfig(..), gc_frames, gc_frontend_config, mkProxyUrl)
+import Gargantext.Core.Config (GargConfig(..), gc_frames, gc_frontend_config, mkProxyUrl, HasConfig(..))
 import Gargantext.Core.Config.Types (FramesConfig(..), f_write_url, fc_microservices, MicroServicesSettings(..), SecretsConfig(..))
 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 (HasConfig(..), DBCmd')
+import Gargantext.Database.Prelude (DBCmd')
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)

src/Gargantext/Database/GargDB.hs

@@ -18,9 +18,8 @@ module Gargantext.Database.GargDB
 import Control.Lens (view)
 import Data.Text qualified as Text
 import Data.Tuple.Extra (both)
-import Gargantext.Database.Prelude (HasConfig(..))
+import Gargantext.Core.Config ( gc_datafilepath, HasConfig(..) )
 import Gargantext.Prelude hiding (hash)
-import Gargantext.Core.Config ( gc_datafilepath )
 import Gargantext.Prelude.Crypto.Hash ( IsHashable(hash) )
 import Prelude qualified
 import System.Directory (createDirectoryIfMissing)

src/Gargantext/Database/Prelude.hs

@@ -29,7 +29,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(Conversion
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Database.PostgreSQL.Simple.Types (Query(..))
 import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
-import Gargantext.Core.Config (GargConfig)
+import Gargantext.Core.Config (HasConfig(..))
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Prelude
@@ -45,12 +45,6 @@ class HasConnectionPool env where
 instance HasConnectionPool (Pool Connection) where
   connPool = identity
 
-class HasConfig env where
-  hasConfig :: Getter env GargConfig
-
-instance HasConfig GargConfig where
-  hasConfig = identity
-
 -------------------------------------------------------
 type JSONB = DefaultFromField SqlJsonb
 -------------------------------------------------------

src/Gargantext/MicroServices/ReverseProxy.hs

@@ -35,10 +35,9 @@ import Gargantext.API.Node.ShareURL qualified as Share
 import Gargantext.API.Routes.Named.Private
 import Gargantext.API.Routes.Named.Share (ShareLink(..))
 import Gargantext.API.ThrowAll (throwAllRoutes)
-import Gargantext.Core.Config (gc_frames, mkProxyUrl)
+import Gargantext.Core.Config (gc_frames, mkProxyUrl, hasConfig)
 import Gargantext.Core.Config.Types (f_write_url)
 import Gargantext.Database.Admin.Types.Node (NodeType(..), NodeId (..))
-import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Prelude hiding (Handler)
 import Network.HTTP.ReverseProxy
 import Network.HTTP.Types (hCacheControl, RequestHeaders, hReferer, ResponseHeaders, Header)

test/Test/API/Notifications.hs

@@ -11,7 +11,6 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -Wno-orphans  #-}
 
-{-# LANGUAGE QuasiQuotes #-}
     
 module Test.API.Notifications (
     tests
@@ -28,11 +27,9 @@ import Gargantext.Core.Config.Types (NotificationsConfig(..))
 import Network.WebSockets.Client qualified as WS
 import Network.WebSockets.Connection qualified as WS
 import Prelude
-import System.Timeout qualified as Timeout
 import Test.API.Setup (withTestDBAndPort)  -- , setupEnvironment, createAliceAndBob)
 import Test.Hspec
 import Test.Instances ()
-import Text.RawString.QQ (r)
 
 
 tests :: NotificationsConfig -> Spec

test/Test/API/Setup.hs

@@ -15,10 +15,9 @@ import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
 import Gargantext.API.Admin.Settings
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
-import Gargantext.Core.Config (_gc_secrets, gc_frontend_config, gc_jobs)
+import Gargantext.Core.Config (_gc_secrets, gc_frontend_config, gc_jobs, hasConfig)
 import Gargantext.Core.Config.Types (SettingsFile(..), jc_js_job_timeout, jc_js_id_timeout, fc_appPort, jwtSettings)
 import Gargantext.Core.Config.Utils (readConfig)
-import Gargantext.Core.NLP
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow
@@ -26,7 +25,7 @@ import Gargantext.Database.Action.User.New
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Trigger.Init
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Prelude
+import Gargantext.Database.Prelude ()
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
 import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)

test/Test/Database/Types.hs

@@ -31,10 +31,11 @@ import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Admin.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
+import Gargantext.Core.Config (HasConfig(..))
 import Gargantext.Core.Mail.Types (HasMail(..))
 import Gargantext.Core.NLP (HasNLPServer(..))
 import Gargantext.Core.NodeStory
-import Gargantext.Database.Prelude (HasConfig(..), HasConnectionPool(..))
+import Gargantext.Database.Prelude (HasConnectionPool(..))
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Core.Config
 import Gargantext.Core.Config.Mail (MailConfig(..), LoginType(NoAuth))

test/Test/Utils.hs

@@ -28,8 +28,7 @@ import Network.HTTP.Types.Header (hAccept, hAuthorization, hContentType)
 import Network.Wai.Handler.Warp (Port)
 import Network.Wai.Test (SResponse(..))
 import Prelude qualified
-import Servant.Client (ClientEnv, baseUrlPort, defaultMakeClientRequest, makeClientRequest, mkClientEnv, parseBaseUrl, runClientM)
-import Servant.Client.Core.Request (addHeader)
+import Servant.Client (ClientEnv, baseUrlPort, mkClientEnv, parseBaseUrl, runClientM)
 import System.Timeout qualified as Timeout
 import Test.API.Routes (auth_api, mkUrl)
 import Test.Hspec.Expectations