{-# LANGUAGE TemplateHaskell #-}

{-|
Module      : Gargantext.Core.Config.Worker
Description : Worker TOML file config
Copyright   : (c) CNRS, 2024
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Although Async.Worker.Broker supports various Broker types, in
Gargantext we will only use PGMQ. This makes for easier config,
simpler design. Also, the DevOps stuff is simpler (providing multiple
brokers at the same time could lead to complexities in analyzing
what's going on).

If need arises, we could switch to a different broker by rewriting its
initialization. At the same time, sending and executing jobs should be
broker-agnostic.

-}


module Gargantext.Core.Config.Worker where

import Async.Worker.Broker.Types qualified as B
import Database.PGMQ.Types qualified as PGMQ
import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Core.Config.Types (unTOMLConnectInfo, TOMLConnectInfo(..))
import Gargantext.Prelude
import Toml.Schema


type WorkerName = Text


data WorkerSettings =
  WorkerSettings {
      _wsDatabase     :: !PGS.ConnectInfo
      -- After this number of seconds, the job will be available again.
      
      -- You can set timeout for each job individually and this is the
      -- preferred method over using defaultVt.
    , _wsDefaultVisibilityTimeout :: PGMQ.VisibilityTimeout
    -- Default delay for jobs. This is useful in tests, so that we can
    -- get a chance to set up proper watchers for job, given its id
    , _wsDefaultDelay :: B.TimeoutS
    , _wsDefinitions  :: ![WorkerDefinition]
  } deriving (Show, Eq)
instance FromValue WorkerSettings where
  fromValue = parseTableFromValue $ do
    dbConfig <- reqKey "database"
    _wsDefinitions <- reqKey "definitions"
    _wsDefaultVisibilityTimeout <- reqKey "default_visibility_timeout"
    defaultDelay <- reqKey "default_delay"
    return $ WorkerSettings { _wsDatabase = unTOMLConnectInfo dbConfig
                            , _wsDefinitions
                            , _wsDefaultVisibilityTimeout
                            , _wsDefaultDelay = B.TimeoutS defaultDelay }
instance ToValue WorkerSettings where
  toValue = defaultTableToValue
instance ToTable WorkerSettings where
  toTable (WorkerSettings { .. }) =
    table [ "database" .= TOMLConnectInfo _wsDatabase
          , "default_visibility_timeout" .= _wsDefaultVisibilityTimeout
          , "default_delay" .= B._TimeoutS _wsDefaultDelay
          , "definitions" .= _wsDefinitions ]

data WorkerDefinition =
  WorkerDefinition {
    _wdName   :: !WorkerName
  , _wdQueue  :: !B.Queue
  } deriving (Show, Eq)
instance FromValue WorkerDefinition where
  fromValue = parseTableFromValue $ do
    _wdName <- reqKey "name"
    queue <- reqKey "queue"
    return $ WorkerDefinition { _wdQueue = B.Queue queue, .. }
instance ToValue WorkerDefinition where
  toValue = defaultTableToValue
instance ToTable WorkerDefinition where
  toTable (WorkerDefinition { .. }) =
    table [ "name" .= _wdName
          , "queue" .= B._Queue _wdQueue ]

findDefinitionByName :: WorkerSettings -> WorkerName -> Maybe WorkerDefinition
findDefinitionByName (WorkerSettings { _wsDefinitions }) workerName =
  head $ filter (\wd -> _wdName wd == workerName) _wsDefinitions

-- wdToRedisBrokerInitParams :: WorkerDefinition -> Maybe BRedis.RedisBrokerInitParams
-- wdToRedisBrokerInitParams wd = BRedis.RedisBrokerInitParams <$> (wdToRedisConnectInfo wd)


makeLenses 'WorkerSettings