{-# LANGUAGE CPP #-}

module Faktory.Job
  ( Job
  , JobId
  , JobOptions
  , perform
  , retry
  , once
  , reserveFor
  , queue
  , jobtype
  , at
  , in_
  , custom
  , buildJob
  , newJob
  , jobJid
  , jobArg
  , jobOptions
  , jobRetriesRemaining
  , jobReserveForMicroseconds
  ) where

import Faktory.Prelude

import Data.Aeson
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Semigroup (Last (..))
import Data.Time (UTCTime)
import Faktory.Client (Client (..))
import Faktory.Connection (ConnectionInfo (..))
import Faktory.JobFailure
import Faktory.JobOptions
import Faktory.Producer (Producer (..), pushJob)
import Faktory.Settings (Namespace, Settings (..))
import GHC.Stack
import System.Random

data Job arg = Job
  { forall arg. Job arg -> JobId
jobJid :: JobId
  , forall arg. Job arg -> Maybe UTCTime
jobAt :: Maybe UTCTime
  -- ^ Will be set based on 'JobOptions' when enqueued
  , forall arg. Job arg -> NonEmpty arg
jobArgs :: NonEmpty arg
  -- ^ Faktory needs to serialize args as a list, but we like a single-argument
  -- interface so that's what we expose. See @'jobArg'@.
  , forall arg. Job arg -> JobOptions
jobOptions :: JobOptions
  , forall arg. Job arg -> Maybe JobFailure
jobFailure :: Maybe JobFailure
  }
  deriving stock (Int -> Job arg -> ShowS
[Job arg] -> ShowS
Job arg -> JobId
(Int -> Job arg -> ShowS)
-> (Job arg -> JobId) -> ([Job arg] -> ShowS) -> Show (Job arg)
forall arg. Show arg => Int -> Job arg -> ShowS
forall arg. Show arg => [Job arg] -> ShowS
forall arg. Show arg => Job arg -> JobId
forall a.
(Int -> a -> ShowS) -> (a -> JobId) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall arg. Show arg => Int -> Job arg -> ShowS
showsPrec :: Int -> Job arg -> ShowS
$cshow :: forall arg. Show arg => Job arg -> JobId
show :: Job arg -> JobId
$cshowList :: forall arg. Show arg => [Job arg] -> ShowS
showList :: [Job arg] -> ShowS
Show, (forall a b. (a -> b) -> Job a -> Job b)
-> (forall a b. a -> Job b -> Job a) -> Functor Job
forall a b. a -> Job b -> Job a
forall a b. (a -> b) -> Job a -> Job b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Job a -> Job b
fmap :: forall a b. (a -> b) -> Job a -> Job b
$c<$ :: forall a b. a -> Job b -> Job a
<$ :: forall a b. a -> Job b -> Job a
Functor, (forall m. Monoid m => Job m -> m)
-> (forall m a. Monoid m => (a -> m) -> Job a -> m)
-> (forall m a. Monoid m => (a -> m) -> Job a -> m)
-> (forall a b. (a -> b -> b) -> b -> Job a -> b)
-> (forall a b. (a -> b -> b) -> b -> Job a -> b)
-> (forall b a. (b -> a -> b) -> b -> Job a -> b)
-> (forall b a. (b -> a -> b) -> b -> Job a -> b)
-> (forall a. (a -> a -> a) -> Job a -> a)
-> (forall a. (a -> a -> a) -> Job a -> a)
-> (forall a. Job a -> [a])
-> (forall a. Job a -> Bool)
-> (forall a. Job a -> Int)
-> (forall a. Eq a => a -> Job a -> Bool)
-> (forall a. Ord a => Job a -> a)
-> (forall a. Ord a => Job a -> a)
-> (forall a. Num a => Job a -> a)
-> (forall a. Num a => Job a -> a)
-> Foldable Job
forall a. Eq a => a -> Job a -> Bool
forall a. Num a => Job a -> a
forall a. Ord a => Job a -> a
forall m. Monoid m => Job m -> m
forall a. Job a -> Bool
forall a. Job a -> Int
forall a. Job a -> [a]
forall a. (a -> a -> a) -> Job a -> a
forall m a. Monoid m => (a -> m) -> Job a -> m
forall b a. (b -> a -> b) -> b -> Job a -> b
forall a b. (a -> b -> b) -> b -> Job a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Job m -> m
fold :: forall m. Monoid m => Job m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Job a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Job a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Job a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Job a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Job a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Job a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Job a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Job a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Job a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Job a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Job a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Job a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Job a -> a
foldr1 :: forall a. (a -> a -> a) -> Job a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Job a -> a
foldl1 :: forall a. (a -> a -> a) -> Job a -> a
$ctoList :: forall a. Job a -> [a]
toList :: forall a. Job a -> [a]
$cnull :: forall a. Job a -> Bool
null :: forall a. Job a -> Bool
$clength :: forall a. Job a -> Int
length :: forall a. Job a -> Int
$celem :: forall a. Eq a => a -> Job a -> Bool
elem :: forall a. Eq a => a -> Job a -> Bool
$cmaximum :: forall a. Ord a => Job a -> a
maximum :: forall a. Ord a => Job a -> a
$cminimum :: forall a. Ord a => Job a -> a
minimum :: forall a. Ord a => Job a -> a
$csum :: forall a. Num a => Job a -> a
sum :: forall a. Num a => Job a -> a
$cproduct :: forall a. Num a => Job a -> a
product :: forall a. Num a => Job a -> a
Foldable, Functor Job
Foldable Job
(Functor Job, Foldable Job) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Job a -> f (Job b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Job (f a) -> f (Job a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Job a -> m (Job b))
-> (forall (m :: * -> *) a. Monad m => Job (m a) -> m (Job a))
-> Traversable Job
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Job (m a) -> m (Job a)
forall (f :: * -> *) a. Applicative f => Job (f a) -> f (Job a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Job a -> m (Job b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Job a -> f (Job b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Job a -> f (Job b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Job a -> f (Job b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Job (f a) -> f (Job a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Job (f a) -> f (Job a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Job a -> m (Job b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Job a -> m (Job b)
$csequence :: forall (m :: * -> *) a. Monad m => Job (m a) -> m (Job a)
sequence :: forall (m :: * -> *) a. Monad m => Job (m a) -> m (Job a)
Traversable)

-- | Perform a Job with the given options
--
-- @
-- 'perform' 'mempty' SomeJob
-- 'perform' ('queue' "SomeQueue") SomeJob
-- 'perform' 'once' SomeJob
-- 'perform' ('at' someTime <> 'once') SomeJob
-- 'perform' ('in_' 10 <> 'once') SomeJob
-- 'perform' ('in_' 10 <> 'retry' 3) SomeJob
-- @
perform
  :: (HasCallStack, ToJSON arg) => JobOptions -> Producer -> arg -> IO JobId
perform :: forall arg.
(HasCallStack, ToJSON arg) =>
JobOptions -> Producer -> arg -> IO JobId
perform JobOptions
options Producer
producer arg
arg = do
  Job arg
job <- JobOptions -> Producer -> arg -> IO (Job arg)
forall arg. JobOptions -> Producer -> arg -> IO (Job arg)
buildJob JobOptions
options Producer
producer arg
arg
  Job arg -> JobId
forall arg. Job arg -> JobId
jobJid Job arg
job JobId -> IO () -> IO JobId
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Producer -> Job arg -> IO ()
forall a. (HasCallStack, ToJSON a) => Producer -> a -> IO ()
pushJob Producer
producer Job arg
job

applyOptions :: Namespace -> JobOptions -> Job arg -> IO (Job arg)
applyOptions :: forall arg. Namespace -> JobOptions -> Job arg -> IO (Job arg)
applyOptions Namespace
namespace JobOptions
options Job arg
job = do
  Maybe UTCTime
scheduledAt <- JobOptions -> IO (Maybe UTCTime)
getAtFromSchedule JobOptions
options
  let namespacedOptions :: JobOptions
namespacedOptions = Namespace -> JobOptions -> JobOptions
namespaceQueue Namespace
namespace (JobOptions -> JobOptions) -> JobOptions -> JobOptions
forall a b. (a -> b) -> a -> b
$ Job arg -> JobOptions
forall arg. Job arg -> JobOptions
jobOptions Job arg
job JobOptions -> JobOptions -> JobOptions
forall a. Semigroup a => a -> a -> a
<> JobOptions
options
  Job arg -> IO (Job arg)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Job arg -> IO (Job arg)) -> Job arg -> IO (Job arg)
forall a b. (a -> b) -> a -> b
$ Job arg
job {jobAt = scheduledAt, jobOptions = namespacedOptions}

-- | Construct a 'Job' and apply options and Producer settings
buildJob :: JobOptions -> Producer -> arg -> IO (Job arg)
buildJob :: forall arg. JobOptions -> Producer -> arg -> IO (Job arg)
buildJob JobOptions
options Producer
producer arg
arg =
  Namespace -> JobOptions -> Job arg -> IO (Job arg)
forall arg. Namespace -> JobOptions -> Job arg -> IO (Job arg)
applyOptions Namespace
namespace (JobOptions -> JobOptions
applyDefaults JobOptions
options)
    (Job arg -> IO (Job arg)) -> IO (Job arg) -> IO (Job arg)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< arg -> IO (Job arg)
forall arg. arg -> IO (Job arg)
newJob arg
arg
 where
  namespace :: Namespace
namespace =
    ConnectionInfo -> Namespace
connectionInfoNamespace (ConnectionInfo -> Namespace) -> ConnectionInfo -> Namespace
forall a b. (a -> b) -> a -> b
$
      Settings -> ConnectionInfo
settingsConnection (Settings -> ConnectionInfo) -> Settings -> ConnectionInfo
forall a b. (a -> b) -> a -> b
$
        Client -> Settings
clientSettings (Client -> Settings) -> Client -> Settings
forall a b. (a -> b) -> a -> b
$
          Producer -> Client
producerClient Producer
producer
  applyDefaults :: JobOptions -> JobOptions
applyDefaults =
    JobOptions -> JobOptions -> JobOptions
forall a. Monoid a => a -> a -> a
mappend (JobOptions -> JobOptions -> JobOptions)
-> JobOptions -> JobOptions -> JobOptions
forall a b. (a -> b) -> a -> b
$
      Settings -> JobOptions
settingsDefaultJobOptions (Settings -> JobOptions) -> Settings -> JobOptions
forall a b. (a -> b) -> a -> b
$
        Client -> Settings
clientSettings (Client -> Settings) -> Client -> Settings
forall a b. (a -> b) -> a -> b
$
          Producer -> Client
producerClient
            Producer
producer

-- | Construct a 'Job' with default 'JobOptions'
newJob :: arg -> IO (Job arg)
newJob :: forall arg. arg -> IO (Job arg)
newJob arg
arg = do
  -- Ruby uses 12 random hex
  JobId
jobId <- Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
12 ShowS -> (StdGen -> JobId) -> StdGen -> JobId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Char) -> StdGen -> JobId
forall g. RandomGen g => (Char, Char) -> g -> JobId
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Char
'a', Char
'z') (StdGen -> JobId) -> IO StdGen -> IO JobId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen

  Job arg -> IO (Job arg)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Job
      { jobJid :: JobId
jobJid = JobId
jobId
      , jobAt :: Maybe UTCTime
jobAt = Maybe UTCTime
forall a. Maybe a
Nothing
      , jobArgs :: NonEmpty arg
jobArgs = arg -> NonEmpty arg
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure arg
arg
      , jobOptions :: JobOptions
jobOptions = JobId -> JobOptions
jobtype JobId
"Default"
      , jobFailure :: Maybe JobFailure
jobFailure = Maybe JobFailure
forall a. Maybe a
Nothing
      }

jobArg :: Job arg -> arg
jobArg :: forall arg. Job arg -> arg
jobArg Job {JobId
Maybe UTCTime
Maybe JobFailure
NonEmpty arg
JobOptions
jobJid :: forall arg. Job arg -> JobId
jobOptions :: forall arg. Job arg -> JobOptions
jobAt :: forall arg. Job arg -> Maybe UTCTime
jobArgs :: forall arg. Job arg -> NonEmpty arg
jobFailure :: forall arg. Job arg -> Maybe JobFailure
jobJid :: JobId
jobAt :: Maybe UTCTime
jobArgs :: NonEmpty arg
jobOptions :: JobOptions
jobFailure :: Maybe JobFailure
..} = NonEmpty arg -> arg
forall a. NonEmpty a -> a
NE.head NonEmpty arg
jobArgs

jobRetriesRemaining :: Job arg -> Int
jobRetriesRemaining :: forall a. Job a -> Int
jobRetriesRemaining Job arg
job = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
enqueuedRetry Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
attemptCount
 where
  enqueuedRetry :: Int
enqueuedRetry = Int -> (Last Int -> Int) -> Maybe (Last Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
faktoryDefaultRetry Last Int -> Int
forall a. Last a -> a
getLast (Maybe (Last Int) -> Int) -> Maybe (Last Int) -> Int
forall a b. (a -> b) -> a -> b
$ JobOptions -> Maybe (Last Int)
joRetry (JobOptions -> Maybe (Last Int)) -> JobOptions -> Maybe (Last Int)
forall a b. (a -> b) -> a -> b
$ Job arg -> JobOptions
forall arg. Job arg -> JobOptions
jobOptions Job arg
job
  attemptCount :: Int
attemptCount = Int -> (JobFailure -> Int) -> Maybe JobFailure -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> (JobFailure -> Int) -> JobFailure -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JobFailure -> Int
jfRetryCount) (Maybe JobFailure -> Int) -> Maybe JobFailure -> Int
forall a b. (a -> b) -> a -> b
$ Job arg -> Maybe JobFailure
forall arg. Job arg -> Maybe JobFailure
jobFailure Job arg
job

jobReserveForMicroseconds :: Job arg -> Int
jobReserveForMicroseconds :: forall a. Job a -> Int
jobReserveForMicroseconds =
  Int -> (Last Natural -> Int) -> Maybe (Last Natural) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
faktoryDefaultReserveFor (Int -> Int
secondToMicrosecond (Int -> Int) -> (Last Natural -> Int) -> Last Natural -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int)
-> (Last Natural -> Natural) -> Last Natural -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last Natural -> Natural
forall a. Last a -> a
getLast)
    (Maybe (Last Natural) -> Int)
-> (Job arg -> Maybe (Last Natural)) -> Job arg -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JobOptions -> Maybe (Last Natural)
joReserveFor
    (JobOptions -> Maybe (Last Natural))
-> (Job arg -> JobOptions) -> Job arg -> Maybe (Last Natural)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job arg -> JobOptions
forall arg. Job arg -> JobOptions
jobOptions

instance ToJSON args => ToJSON (Job args) where
  toJSON :: Job args -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (Job args -> [Pair]) -> Job args -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job args -> [Pair]
forall e a arg. (KeyValue e a, ToJSON arg) => Job arg -> [a]
toPairs
  toEncoding :: Job args -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (Job args -> Series) -> Job args -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (Job args -> [Series]) -> Job args -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job args -> [Series]
forall e a arg. (KeyValue e a, ToJSON arg) => Job arg -> [a]
toPairs

#if MIN_VERSION_aeson(2,2,0)
toPairs :: (KeyValue e a, ToJSON arg) => Job arg -> [a]
#else
toPairs :: (KeyValue a, ToJSON arg) => Job arg -> [a]
#endif
toPairs :: forall e a arg. (KeyValue e a, ToJSON arg) => Job arg -> [a]
toPairs Job {JobId
Maybe UTCTime
Maybe JobFailure
NonEmpty arg
JobOptions
jobJid :: forall arg. Job arg -> JobId
jobOptions :: forall arg. Job arg -> JobOptions
jobAt :: forall arg. Job arg -> Maybe UTCTime
jobArgs :: forall arg. Job arg -> NonEmpty arg
jobFailure :: forall arg. Job arg -> Maybe JobFailure
jobJid :: JobId
jobAt :: Maybe UTCTime
jobArgs :: NonEmpty arg
jobOptions :: JobOptions
jobFailure :: Maybe JobFailure
..} =
  [ Key
"jid" Key -> JobId -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobId
jobJid
  , Key
"at" Key -> Maybe UTCTime -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe UTCTime
jobAt
  , Key
"args" Key -> NonEmpty arg -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty arg
jobArgs
  , Key
"jobtype" Key -> Maybe (Last JobId) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobOptions -> Maybe (Last JobId)
joJobtype JobOptions
jobOptions
  , Key
"retry" Key -> Maybe (Last Int) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobOptions -> Maybe (Last Int)
joRetry JobOptions
jobOptions
  , Key
"queue" Key -> Maybe (Last Queue) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobOptions -> Maybe (Last Queue)
joQueue JobOptions
jobOptions
  , Key
"custom" Key -> Maybe Custom -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobOptions -> Maybe Custom
joCustom JobOptions
jobOptions
  , Key
"reserve_for" Key -> Maybe (Last Natural) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobOptions -> Maybe (Last Natural)
joReserveFor JobOptions
jobOptions
  ]

-- brittany-disable-next-binding

instance FromJSON args => FromJSON (Job args) where
  parseJSON :: Value -> Parser (Job args)
parseJSON = JobId
-> (Object -> Parser (Job args)) -> Value -> Parser (Job args)
forall a. JobId -> (Object -> Parser a) -> Value -> Parser a
withObject JobId
"Job" ((Object -> Parser (Job args)) -> Value -> Parser (Job args))
-> (Object -> Parser (Job args)) -> Value -> Parser (Job args)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    JobId
-> Maybe UTCTime
-> NonEmpty args
-> JobOptions
-> Maybe JobFailure
-> Job args
forall arg.
JobId
-> Maybe UTCTime
-> NonEmpty arg
-> JobOptions
-> Maybe JobFailure
-> Job arg
Job
      (JobId
 -> Maybe UTCTime
 -> NonEmpty args
 -> JobOptions
 -> Maybe JobFailure
 -> Job args)
-> Parser JobId
-> Parser
     (Maybe UTCTime
      -> NonEmpty args -> JobOptions -> Maybe JobFailure -> Job args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser JobId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jid"
      Parser
  (Maybe UTCTime
   -> NonEmpty args -> JobOptions -> Maybe JobFailure -> Job args)
-> Parser (Maybe UTCTime)
-> Parser
     (NonEmpty args -> JobOptions -> Maybe JobFailure -> Job args)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"at"
      Parser
  (NonEmpty args -> JobOptions -> Maybe JobFailure -> Job args)
-> Parser (NonEmpty args)
-> Parser (JobOptions -> Maybe JobFailure -> Job args)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (NonEmpty args)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"args"
      Parser (JobOptions -> Maybe JobFailure -> Job args)
-> Parser JobOptions -> Parser (Maybe JobFailure -> Job args)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser JobOptions
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Parser (Maybe JobFailure -> Job args)
-> Parser (Maybe JobFailure) -> Parser (Job args)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe JobFailure)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"failure"

type JobId = String

-- | https://github.com/contribsys/faktory/wiki/Job-Errors#the-process
--
-- > By default Faktory will retry a job 25 times
faktoryDefaultRetry :: Int
faktoryDefaultRetry :: Int
faktoryDefaultRetry = Int
25

faktoryDefaultReserveFor :: Int
faktoryDefaultReserveFor :: Int
faktoryDefaultReserveFor = Int -> Int
secondToMicrosecond Int
1800

secondToMicrosecond :: Int -> Int
secondToMicrosecond :: Int -> Int
secondToMicrosecond Int
n = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
10 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
6 :: Int))