[worker] fixes to code compilation after latest merge

bin/gargantext-cli/CLI/Import.hs

@@ -33,6 +33,7 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusName))
 import Gargantext.Prelude
+import Gargantext.Utils.Jobs.Monad ( MonadJobStatus(..) )
 import Options.Applicative
 import Prelude (String)
 import qualified Data.Text as T

bin/gargantext-cli/CLI/Ini.hs

@@ -26,6 +26,7 @@ import Gargantext.Core.Config.Ini.Ini qualified as Ini
 import Gargantext.Core.Config.Ini.Mail qualified as IniMail
 import Gargantext.Core.Config.Ini.NLP qualified as IniNLP
 import Gargantext.Core.Config.Types qualified as CTypes
+import Gargantext.Core.Config.Worker (WorkerSettings(..))
 import Gargantext.Prelude
 import Options.Applicative
 import Servant.Client.Core (parseBaseUrl)
@@ -73,7 +74,7 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
                                                    , _jc_js_id_timeout = _gc_js_id_timeout }
                     , _gc_apis = CTypes.APIsConfig { _ac_pubmed_api_key = _gc_pubmed_api_key
                                                    , _ac_epo_api_url = _gc_epo_api_url }
-
+                    , _gc_worker = WorkerSettings { _wsDefinitions = [] }  -- not supported for ini file
                     }
 
 mkFrontendConfig :: Ini.GargConfig -> CTypes.FrontendConfig

bin/gargantext-cli/CLI/Types.hs

@@ -79,8 +79,7 @@ data CLIRoutes
   deriving (Show, Eq)
 
 data WorkerArgs = WorkerArgs
-  { worker_ini      :: !IniFile
-  , worker_settings :: !SettingsFile
+  { worker_toml :: !SettingsFile
   , worker_name     :: !Text
   } deriving (Show, Eq)
 

gargantext.cabal

@@ -650,7 +650,6 @@ executable gargantext-cli
       CLI.Server.Routes
       CLI.Types
       CLI.Upgrade
-      CLI.Utils
       CLI.Worker
       Paths_gargantext
   hs-source-dirs:

src/Gargantext/Core/Worker.hs

@@ -33,7 +33,7 @@ import Gargantext.Core.Worker.Jobs
 import Gargantext.Core.Worker.Jobs.Types (Job(..))
 import Gargantext.Database.Query.Table.User (getUsersWithEmail)
 import Gargantext.Prelude
-import Gargantext.Utils.Jobs.Monad ( JobHandle, MonadJobStatus(noJobHandle) )
+import Gargantext.Utils.Jobs.Monad ( MonadJobStatus(noJobHandle) )
 
   
 
@@ -77,7 +77,7 @@ performAction env _state bm = do
     Ping -> putStrLn ("ping" :: Text)
     AddCorpusFormAsync { .. } -> runWorkerMonad env $ do
       liftBase $ putStrLn ("add corpus form" :: Text)
-      addToCorpusWithForm _acf_user _acf_cid _acf_args (noJobHandle Proxy)
+      addToCorpusWithForm _acf_user _acf_cid _acf_args (noJobHandle (Proxy :: Proxy WorkerMonad))
     ForgotPasswordAsync { _fpa_args = ForgotPasswordAsyncParams { email } } -> runWorkerMonad env $ do
       liftBase $ putStrLn ("forgot password: " <> email)
       us <- getUsersWithEmail (T.toLower email)

src/Gargantext/Core/Worker/Env.hs

@@ -17,7 +17,7 @@ Portability : POSIX
 module Gargantext.Core.Worker.Env where
 
 
-import Control.Lens (prism', to)
+import Control.Lens (prism', to, view)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Pool (Pool)
 import Data.Text qualified as T
@@ -27,6 +27,8 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
 import Gargantext.API.Admin.Settings ( devJwkFile, 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(..))
 import Gargantext.Core.Config.Mail qualified as Mail
 import Gargantext.Core.Config.Utils (readConfig)
@@ -124,6 +126,10 @@ instance HasNodeArchiveStoryImmediateSaver WorkerEnv where
 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
@@ -163,6 +169,31 @@ newtype WorkerMonad a =
            , 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

test/Test/Instances.hs

@@ -16,13 +16,14 @@ Portability : POSIX
 module Test.Instances where
 
 import EPO.API.Client.Types qualified as EPO
-import Gargantext.API.Admin.Auth.Types (ForgotPasswordAsyncParams(..))
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..), ForgotPasswordAsyncParams(..))
 import Gargantext.API.Admin.EnvTypes as EnvTypes
 import Gargantext.API.Node.Corpus.New (ApiInfo(..))
 import Gargantext.API.Node.Corpus.New qualified as New
-import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..))
+import Gargantext.API.Node.Types (NewWithForm(..), RenameNode(..), WithQuery(..))
 import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
 import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DET
+import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Core.Worker.Jobs.Types (Job(..))
 import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
 import Gargantext.Prelude
@@ -34,6 +35,11 @@ import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
 import Text.Parsec.Pos
 
 
+instance Arbitrary AuthenticatedUser where
+  arbitrary = AuthenticatedUser <$> arbitrary  -- _auth_node_id
+                                <*> arbitrary  -- _auth_user_id
+
+
 instance Arbitrary EnvTypes.GargJob where
   arbitrary = do
     oneof [ pure AddAnnuaireFormJob
@@ -105,10 +111,6 @@ instance Arbitrary ParseError where
     return $ newErrorMessage msg sp
 
 
-instance Arbitrary New.ApiInfo where
-  arbitrary = New.ApiInfo <$> arbitrary
-
-
 
 smallLetter :: [Char]
 smallLetter = ['a'..'z']
@@ -123,6 +125,16 @@ alphanum :: [Char]
 alphanum = smallLetter <> largeLetter <> digit
 
 
+instance Arbitrary Individu.User where
+  arbitrary = do
+    userId <- arbitrary
+    userName <- arbitrary
+    nodeId <- arbitrary
+    oneof [ pure $ Individu.UserDBId userId
+          , pure $ Individu.UserName userName
+          , pure $ Individu.RootId nodeId ]
+
+
 instance Arbitrary EPO.AuthKey where
   arbitrary = do
     user <- arbitrary
@@ -174,6 +186,14 @@ instance Arbitrary Hyperdata.HyperdataPublic where
 instance Arbitrary a => Arbitrary (SJ.JobOutput a) where
   arbitrary = SJ.JobOutput <$> arbitrary
 
+instance Arbitrary NewWithForm where
+  arbitrary = NewWithForm <$> arbitrary  -- _wf_filetype
+                          <*> arbitrary  -- _wf_fileformat
+                          <*> arbitrary  -- _wf_data
+                          <*> arbitrary  -- _wf_lang
+                          <*> arbitrary  -- _wf_name
+                          <*> arbitrary  -- _wf_selection
+
 instance Arbitrary RenameNode where
   arbitrary = elements [RenameNode "test"]