{-# LANGUAGE TemplateHaskell #-}
{-|
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 qualified as W
import Async.Worker.Broker.Types qualified as B
import Async.Worker.Types qualified as WT
import Control.Lens (view)
import Gargantext.Core.Config (gc_database_config, gc_worker, HasConfig(..), GargConfig, gc_logging)
import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..), wsAdditionalDelayAfterRead)
import Gargantext.Core.Worker.Broker (initBrokerWithDBCreate)
import Gargantext.Core.Worker.Jobs.Types (Job(..))
import Gargantext.Core.Worker.PGMQTypes (HasWorkerBroker, MessageId, SendJob)
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Prelude
import Gargantext.System.Logging


sendJob :: (HasWorkerBroker, HasConfig env)
        => Job
        -> Cmd env err MessageId
sendJob job = do
  gcConfig <- view $ hasConfig
  liftBase $ sendJobWithCfg gcConfig job

sendJobWithCfg :: GargConfig -> Job -> IO MessageId
sendJobWithCfg gcConfig job = do
  let ws@WorkerSettings { _wsDefinitions, _wsDefaultDelay } = gcConfig ^. gc_worker
  -- TODO Try to guess which worker should get this job
  -- let mWd = findDefinitionByName ws workerName
  let mWd = head _wsDefinitions
  case mWd of
    Nothing -> panicTrace "No worker definitions available"
    Just wd -> do
      b <- initBrokerWithDBCreate (gcConfig ^. gc_database_config) ws
      let queueName = _wdQueue wd
      let addDelayAfterRead = gcConfig ^. gc_worker . wsAdditionalDelayAfterRead
      let sj = (W.mkDefaultSendJob' b queueName job) { W.delay = _wsDefaultDelay
                                                     , W.addDelayAfterRead = B._TimeoutS addDelayAfterRead
                                                     -- don't allow to repeat infinitely (see #495)
                                                     , W.toStrat = WT.TSDelete }
      let job' = updateJobData ws job sj
      withLogger (gcConfig ^. gc_logging) $ \ioL ->
        $(logLoc) ioL DEBUG $ "[sendJob] sending job " <> show job <> " (delay " <> show (W.delay job') <> ")"
      W.sendJob' job'

-- | We want to fine-tune job metadata parameters, for each job type
updateJobData :: WorkerSettings -> Job -> SendJob -> SendJob
updateJobData ws (AddCorpusTempFileAsync {}) sj = withLongTimeout ws $ sj { W.resendOnKill = False }
updateJobData ws (AddCorpusWithQuery {}) sj = withLongTimeout ws sj
updateJobData ws (AddToAnnuaireWithForm {}) sj = withLongTimeout ws sj
updateJobData ws (AddWithFile {}) sj = withLongTimeout ws $ sj { W.resendOnKill = False }
updateJobData ws (DocumentsFromWriteNodes {}) sj = withLongTimeout ws sj
updateJobData ws (FrameCalcUpload {}) sj = withLongTimeout ws sj
updateJobData ws (JSONPost {}) sj = withLongTimeout ws $ sj { W.resendOnKill = False }
updateJobData ws (NgramsPostCharts {}) sj = withLongTimeout ws sj
updateJobData ws (RecomputeGraph {}) sj = withLongTimeout ws sj
updateJobData ws (UpdateNode {}) sj = withLongTimeout ws sj
updateJobData ws (UploadDocument {}) sj = withLongTimeout ws sj
updateJobData ws (ImportRemoteDocuments {}) sj = withLongTimeout ws sj
updateJobData ws (ImportRemoteTerms {}) sj = withLongTimeout ws sj
-- | ForgotPasswordAsync, PostNodeAsync
updateJobData ws _ sj = withDefaultTimeout ws $ sj { W.resendOnKill = False }

withDefaultTimeout :: WorkerSettings -> SendJob -> SendJob
withDefaultTimeout (WorkerSettings { _wsDefaultJobTimeout }) sj = sj { W.timeout = _wsDefaultJobTimeout }

withLongTimeout :: WorkerSettings -> SendJob -> SendJob
withLongTimeout (WorkerSettings { _wsLongJobTimeout }) sj = sj { W.timeout = _wsLongJobTimeout }
