module Faktory.Settings
  ( Settings (..)
  , defaultSettings
  , envSettings

    -- * Worker
  , WorkerSettings (..)
  , defaultWorkerSettings
  , envWorkerSettings
  , Queue (..)
  , namespaceQueue
  , queueArg
  , defaultQueue
  , WorkerId
  , randomWorkerId

    -- * Pool
  , PoolSettings (..)
  , envPoolSettings

    -- * Re-exports
  , ConnectionInfo (..)
  , Namespace (..)
  ) where

import Faktory.Prelude

import Data.Aeson
import Faktory.Connection
import Faktory.JobOptions (JobOptions)
import Faktory.Settings.Queue
import Numeric.Natural
import System.Environment (lookupEnv)
import System.IO (hPutStrLn, stderr)
import System.Random

data Settings = Settings
  { Settings -> ConnectionInfo
settingsConnection :: ConnectionInfo
  , Settings -> String -> IO ()
settingsLogDebug :: String -> IO ()
  , Settings -> String -> IO ()
settingsLogError :: String -> IO ()
  , Settings -> JobOptions
settingsDefaultJobOptions :: JobOptions
  }

defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings =
  Settings
    { settingsConnection :: ConnectionInfo
settingsConnection = ConnectionInfo
defaultConnectionInfo
    , settingsLogDebug :: String -> IO ()
settingsLogDebug = \String
_msg -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , settingsLogError :: String -> IO ()
settingsLogError = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"[ERROR]: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
    , settingsDefaultJobOptions :: JobOptions
settingsDefaultJobOptions = JobOptions
forall a. Monoid a => a
mempty
    }

-- | Defaults, but read @'Connection'@ from the environment
--
-- See @'envConnection'@
envSettings :: IO Settings
envSettings :: IO Settings
envSettings = do
  ConnectionInfo
connection <- IO ConnectionInfo
envConnectionInfo
  Settings -> IO Settings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Settings
defaultSettings {settingsConnection = connection}

data WorkerSettings = WorkerSettings
  { WorkerSettings -> Queue
settingsQueue :: Queue
  , WorkerSettings -> Maybe WorkerId
settingsId :: Maybe WorkerId
  , WorkerSettings -> Int
settingsIdleDelay :: Int
  , WorkerSettings -> SomeException -> IO ()
settingsOnFailed :: SomeException -> IO ()
  }

defaultWorkerSettings :: WorkerSettings
defaultWorkerSettings :: WorkerSettings
defaultWorkerSettings =
  WorkerSettings
    { settingsQueue :: Queue
settingsQueue = Queue
defaultQueue
    , settingsId :: Maybe WorkerId
settingsId = Maybe WorkerId
forall a. Maybe a
Nothing
    , settingsIdleDelay :: Int
settingsIdleDelay = Int
1
    , settingsOnFailed :: SomeException -> IO ()
settingsOnFailed = \SomeException
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    }

envWorkerSettings :: IO WorkerSettings
envWorkerSettings :: IO WorkerSettings
envWorkerSettings = do
  Maybe String
mQueue <- String -> IO (Maybe String)
lookupEnv String
"FAKTORY_QUEUE"
  Maybe String
mWorkerId <- String -> IO (Maybe String)
lookupEnv String
"FAKTORY_WORKER_ID"
  WorkerSettings -> IO WorkerSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    WorkerSettings
defaultWorkerSettings
      { settingsQueue = maybe defaultQueue (Queue . pack) mQueue
      , settingsId = WorkerId <$> mWorkerId
      }

newtype WorkerId = WorkerId String
  deriving newtype (Maybe WorkerId
Value -> Parser [WorkerId]
Value -> Parser WorkerId
(Value -> Parser WorkerId)
-> (Value -> Parser [WorkerId])
-> Maybe WorkerId
-> FromJSON WorkerId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser WorkerId
parseJSON :: Value -> Parser WorkerId
$cparseJSONList :: Value -> Parser [WorkerId]
parseJSONList :: Value -> Parser [WorkerId]
$comittedField :: Maybe WorkerId
omittedField :: Maybe WorkerId
FromJSON, [WorkerId] -> Value
[WorkerId] -> Encoding
WorkerId -> Bool
WorkerId -> Value
WorkerId -> Encoding
(WorkerId -> Value)
-> (WorkerId -> Encoding)
-> ([WorkerId] -> Value)
-> ([WorkerId] -> Encoding)
-> (WorkerId -> Bool)
-> ToJSON WorkerId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: WorkerId -> Value
toJSON :: WorkerId -> Value
$ctoEncoding :: WorkerId -> Encoding
toEncoding :: WorkerId -> Encoding
$ctoJSONList :: [WorkerId] -> Value
toJSONList :: [WorkerId] -> Value
$ctoEncodingList :: [WorkerId] -> Encoding
toEncodingList :: [WorkerId] -> Encoding
$comitField :: WorkerId -> Bool
omitField :: WorkerId -> Bool
ToJSON)

randomWorkerId :: IO WorkerId
randomWorkerId :: IO WorkerId
randomWorkerId = String -> WorkerId
WorkerId (String -> WorkerId) -> (StdGen -> String) -> StdGen -> WorkerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
8 (String -> String) -> (StdGen -> String) -> StdGen -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Char) -> StdGen -> String
forall g. RandomGen g => (Char, Char) -> g -> String
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Char
'a', Char
'z') (StdGen -> WorkerId) -> IO StdGen -> IO WorkerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen

-- |
--
-- @since 1.1.3.0
data PoolSettings = PoolSettings
  { PoolSettings -> Natural
settingsSize :: Natural
  -- ^ Maximum pool size
  --
  -- Default is @10@. Smallest acceptable value is @1@. Note that, due to the
  -- striping behavior of @resource-pool@, a configured size @N@ may result in
  -- @N - 1@ resources.
  , PoolSettings -> Natural
settingsTimeout :: Natural
  -- ^ How long before destroying a resource, in seconds
  --
  -- Default is @600@.
  }

-- |
--
-- @since 1.1.3.0
defaultPoolSettings :: PoolSettings
defaultPoolSettings :: PoolSettings
defaultPoolSettings =
  PoolSettings
    { settingsSize :: Natural
settingsSize = Natural
10
    , settingsTimeout :: Natural
settingsTimeout = Natural
600
    }

-- | Read 'PoolSettings' from the environment
--
-- - @FAKTORY_POOL_SIZE@
-- - @FAKTORY_POOL_TIMEOUT@
--
-- @since 1.1.3.0
envPoolSettings :: IO PoolSettings
envPoolSettings :: IO PoolSettings
envPoolSettings =
  Natural -> Natural -> PoolSettings
PoolSettings
    (Natural -> Natural -> PoolSettings)
-> IO Natural -> IO (Natural -> PoolSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural -> (String -> Natural) -> Maybe String -> Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Natural
settingsSize String -> Natural
forall a. Read a => String -> a
read (Maybe String -> Natural) -> IO (Maybe String) -> IO Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"FAKTORY_POOL_SIZE")
    IO (Natural -> PoolSettings) -> IO Natural -> IO PoolSettings
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Natural -> (String -> Natural) -> Maybe String -> Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Natural
settingsTimeout String -> Natural
forall a. Read a => String -> a
read (Maybe String -> Natural) -> IO (Maybe String) -> IO Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"FAKTORY_POOL_TIMEOUT")
 where
  PoolSettings {Natural
settingsSize :: PoolSettings -> Natural
settingsTimeout :: PoolSettings -> Natural
settingsSize :: Natural
settingsTimeout :: Natural
..} = PoolSettings
defaultPoolSettings