module Faktory.Settings
  ( Settings(..)
  , defaultSettings
  , envSettings
  , WorkerSettings(..)
  , defaultWorkerSettings
  , envWorkerSettings
  , Queue(..)
  , namespaceQueue
  , queueArg
  , defaultQueue
  , WorkerId
  , randomWorkerId

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

import Faktory.Prelude

import Data.Aeson
import Faktory.Connection
import Faktory.JobOptions (JobOptions)
import Faktory.Settings.Queue
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 :: ConnectionInfo
-> (String -> IO ()) -> (String -> IO ()) -> JobOptions -> Settings
Settings
  { settingsConnection :: ConnectionInfo
settingsConnection = ConnectionInfo
defaultConnectionInfo
  , settingsLogDebug :: String -> IO ()
settingsLogDebug = \String
_msg -> () -> IO ()
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 (f :: * -> *) a. Applicative f => a -> f a
pure Settings
defaultSettings { settingsConnection :: ConnectionInfo
settingsConnection = ConnectionInfo
connection }

data WorkerSettings = WorkerSettings
  { WorkerSettings -> Queue
settingsQueue :: Queue
  , WorkerSettings -> Maybe WorkerId
settingsId :: Maybe WorkerId
  , WorkerSettings -> Int
settingsIdleDelay :: Int
  }

defaultWorkerSettings :: WorkerSettings
defaultWorkerSettings :: WorkerSettings
defaultWorkerSettings = WorkerSettings :: Queue -> Maybe WorkerId -> Int -> WorkerSettings
WorkerSettings
  { settingsQueue :: Queue
settingsQueue = Queue
defaultQueue
  , settingsId :: Maybe WorkerId
settingsId = Maybe WorkerId
forall a. Maybe a
Nothing
  , settingsIdleDelay :: Int
settingsIdleDelay = Int
1
  }

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 (f :: * -> *) a. Applicative f => a -> f a
pure WorkerSettings
defaultWorkerSettings
    { settingsQueue :: Queue
settingsQueue = Queue -> (String -> Queue) -> Maybe String -> Queue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Queue
defaultQueue (Text -> Queue
Queue (Text -> Queue) -> (String -> Text) -> String -> Queue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) Maybe String
mQueue
    , settingsId :: Maybe WorkerId
settingsId = String -> WorkerId
WorkerId (String -> WorkerId) -> Maybe String -> Maybe WorkerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
mWorkerId
    }

newtype WorkerId = WorkerId String
  deriving newtype (Value -> Parser [WorkerId]
Value -> Parser WorkerId
(Value -> Parser WorkerId)
-> (Value -> Parser [WorkerId]) -> FromJSON WorkerId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WorkerId]
$cparseJSONList :: Value -> Parser [WorkerId]
parseJSON :: Value -> Parser WorkerId
$cparseJSON :: Value -> Parser WorkerId
FromJSON, [WorkerId] -> Encoding
[WorkerId] -> Value
WorkerId -> Encoding
WorkerId -> Value
(WorkerId -> Value)
-> (WorkerId -> Encoding)
-> ([WorkerId] -> Value)
-> ([WorkerId] -> Encoding)
-> ToJSON WorkerId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WorkerId] -> Encoding
$ctoEncodingList :: [WorkerId] -> Encoding
toJSONList :: [WorkerId] -> Value
$ctoJSONList :: [WorkerId] -> Value
toEncoding :: WorkerId -> Encoding
$ctoEncoding :: WorkerId -> Encoding
toJSON :: WorkerId -> Value
$ctoJSON :: WorkerId -> Value
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 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