{-# LANGUAGE OverloadedStrings #-}

-- | Job records, the enqueue setters, and the lifecycle hook types.
module Arbiter.Core.Job.Types
  ( -- * Core job type
    Job
  , HasKind (..)
  , constructorKind
  , constructorKinds
  , PayloadKeys (..)
  , JobRead
  , jobReadPairs
  , jobReadSeries
  , Stored
  , storedBytes
  , toStored
  , decodeStored
  , JobWrite
  , JobId
  , ClaimSeq
  , primaryKey
  , payload
  , queueName
  , groupKey
  , insertedAt
  , updatedAt
  , attempts
  , lastError
  , priority
  , lastAttemptedAt
  , notVisibleUntil
  , dedupKey
  , maxAttempts
  , parentId
  , parentState
  , traceContext
  , suspended
  , claimedBy
  , claimSeq
  , archiveFor
  , payloadKeys
  , defaultJob
  , defaultGroupedJob
  , setPayload
  , setGroupKey
  , setPriority
  , setNotVisibleUntil
  , setDedupKey
  , setMaxAttempts
  , setTraceContext
  , setArchiveFor
  , mapPayload
  , defaultMaxAttempts
  , minMaxAttempts
  , dayRetention
  , isRollup

    -- * Derived status
  , JobStatus (..)
  , jobStatusToText
  , jobStatusFromText

    -- * Type constraints
  , JobPayload
  , RegistryAdmissionPolicies

    -- * Deduplication
  , DedupKey (..)

    -- * Trace context
  , TraceContext (..)
  , toTraceContext

    -- * Observability
  , ObservabilityHooks (..)
  , defaultObservabilityHooks
  , hoistObservabilityHooks
  , andThen
  , ClaimTime
  , CurrentTime
  , StartTime
  , EndTime
  , ErrorMsg
  , BackoffDelay

    -- * Internal

    -- | Internal to the arbiter packages. Not covered by the PVP.
  , JobRecord
  , PayloadColumns (..)
  , dedupParts
  ) where

import Control.Exception qualified as E
import Data.Aeson
  ( FromJSON (..)
  , KeyValue (..)
  , ToJSON (..)
  , eitherDecodeStrict
  , encode
  , object
  , pairs
  , withObject
  , (.:)
  , (.:?)
  , (.=)
  )
import Data.Aeson.Encoding (Series)
import Data.Aeson.Types (Pair)
import Data.Bifunctor qualified as Bi
import Data.ByteString.Lazy qualified as BL
import Data.Int (Int32, Int64)
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (NominalDiffTime, UTCTime)
import GHC.Generics (Generic)
import UnliftIO (MonadUnliftIO, withRunInIO)

import Arbiter.Core.Concurrency.Spec (ConcurrencyKey, HasConcurrency, RegistryConcurrencyPolicies)
import Arbiter.Core.Job.Dedup (DedupKey (..), dedupParts)
import Arbiter.Core.Job.Kind (HasKind (..), constructorKind, constructorKinds)
import Arbiter.Core.Job.Status (JobStatus (..), jobStatusFromText, jobStatusToText)
import Arbiter.Core.Job.TraceContext (TraceContext (..), toTraceContext)
import Arbiter.Core.Job.Types.Internal
  ( Job
  , JobRecord (..)
  , Stored (..)
  , archiveFor
  , attempts
  , claimSeq
  , claimedBy
  , dedupKey
  , groupKey
  , insertedAt
  , lastAttemptedAt
  , lastError
  , maxAttempts
  , notVisibleUntil
  , parentId
  , parentState
  , payload
  , payloadKeys
  , primaryKey
  , priority
  , queueName
  , storedBytes
  , suspended
  , traceContext
  , updatedAt
  )
import Arbiter.Core.RateLimit.Spec (HasRateLimit, RateLimitKey, RegistryRateLimitPolicies)

-- | The labels and keys a stored job carries from its payload, one field each.
data PayloadKeys = PayloadKeys
  { PayloadKeys -> Maybe Text
jobKind :: Maybe Text
  -- ^ From the payload's t'Arbiter.Core.Job.Kind.HasKind' instance.
  , PayloadKeys -> Maybe RateLimitKey
jobRateLimitKey :: Maybe RateLimitKey
  -- ^ From the payload's t'Arbiter.RateLimit.HasRateLimit' instance.
  , PayloadKeys -> Maybe ConcurrencyKey
jobConcurrencyKey :: Maybe ConcurrencyKey
  -- ^ From the payload's t'Arbiter.Concurrency.HasConcurrency' instance.
  }
  deriving stock (PayloadKeys -> PayloadKeys -> Bool
(PayloadKeys -> PayloadKeys -> Bool)
-> (PayloadKeys -> PayloadKeys -> Bool) -> Eq PayloadKeys
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadKeys -> PayloadKeys -> Bool
== :: PayloadKeys -> PayloadKeys -> Bool
$c/= :: PayloadKeys -> PayloadKeys -> Bool
/= :: PayloadKeys -> PayloadKeys -> Bool
Eq, (forall x. PayloadKeys -> Rep PayloadKeys x)
-> (forall x. Rep PayloadKeys x -> PayloadKeys)
-> Generic PayloadKeys
forall x. Rep PayloadKeys x -> PayloadKeys
forall x. PayloadKeys -> Rep PayloadKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PayloadKeys -> Rep PayloadKeys x
from :: forall x. PayloadKeys -> Rep PayloadKeys x
$cto :: forall x. Rep PayloadKeys x -> PayloadKeys
to :: forall x. Rep PayloadKeys x -> PayloadKeys
Generic, Int -> PayloadKeys -> ShowS
[PayloadKeys] -> ShowS
PayloadKeys -> String
(Int -> PayloadKeys -> ShowS)
-> (PayloadKeys -> String)
-> ([PayloadKeys] -> ShowS)
-> Show PayloadKeys
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayloadKeys -> ShowS
showsPrec :: Int -> PayloadKeys -> ShowS
$cshow :: PayloadKeys -> String
show :: PayloadKeys -> String
$cshowList :: [PayloadKeys] -> ShowS
showList :: [PayloadKeys] -> ShowS
Show)

-- | The writable columns resolved from a payload at enqueue. The @kind@, @key@
-- and @prefix@ columns round-trip via 'PayloadKeys'. @cost@ is write-only.
data PayloadColumns = PayloadColumns
  { PayloadColumns -> Maybe Text
pcKind :: Maybe Text
  -- ^ The job's kind label.
  , PayloadColumns -> Maybe Text
pcRateLimitKey :: Maybe Text
  -- ^ The rate-limit bucket key.
  , PayloadColumns -> Maybe Text
pcRateLimitPrefix :: Maybe Text
  -- ^ The rate-limit policy prefix.
  , PayloadColumns -> Double
pcRateLimitCost :: Double
  -- ^ Tokens the job spends.
  , PayloadColumns -> Maybe Text
pcConcurrencyKey :: Maybe Text
  -- ^ The concurrency key.
  , PayloadColumns -> Maybe Text
pcConcurrencyPrefix :: Maybe Text
  -- ^ The concurrency policy prefix.
  }
  deriving stock (PayloadColumns -> PayloadColumns -> Bool
(PayloadColumns -> PayloadColumns -> Bool)
-> (PayloadColumns -> PayloadColumns -> Bool) -> Eq PayloadColumns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadColumns -> PayloadColumns -> Bool
== :: PayloadColumns -> PayloadColumns -> Bool
$c/= :: PayloadColumns -> PayloadColumns -> Bool
/= :: PayloadColumns -> PayloadColumns -> Bool
Eq, (forall x. PayloadColumns -> Rep PayloadColumns x)
-> (forall x. Rep PayloadColumns x -> PayloadColumns)
-> Generic PayloadColumns
forall x. Rep PayloadColumns x -> PayloadColumns
forall x. PayloadColumns -> Rep PayloadColumns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PayloadColumns -> Rep PayloadColumns x
from :: forall x. PayloadColumns -> Rep PayloadColumns x
$cto :: forall x. Rep PayloadColumns x -> PayloadColumns
to :: forall x. Rep PayloadColumns x -> PayloadColumns
Generic, Int -> PayloadColumns -> ShowS
[PayloadColumns] -> ShowS
PayloadColumns -> String
(Int -> PayloadColumns -> ShowS)
-> (PayloadColumns -> String)
-> ([PayloadColumns] -> ShowS)
-> Show PayloadColumns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayloadColumns -> ShowS
showsPrec :: Int -> PayloadColumns -> ShowS
$cshow :: PayloadColumns -> String
show :: PayloadColumns -> String
$cshowList :: [PayloadColumns] -> ShowS
showList :: [PayloadColumns] -> ShowS
Show)

-- | Default attempt limit stamped onto jobs whose 'maxAttempts' is unset.
defaultMaxAttempts :: Int32
defaultMaxAttempts :: Int32
defaultMaxAttempts = Int32
10

-- | Lowest attempt limit a job is stamped with. Every job gets at least one attempt.
minMaxAttempts :: Int32
minMaxAttempts :: Int32
minMaxAttempts = Int32
1

-- | 24h in seconds, a convenience value for 'setArchiveFor'.
dayRetention :: Int32
dayRetention :: Int32
dayRetention = Int32
86400

-- | A rollup finalizer is any job whose 'parentState' snapshot is present
-- (an empty object from its insert or spawn, the merged child results before a DLQ move).
isRollup :: Job p Int64 q t adm -> Bool
isRollup :: forall p q t adm. Job p Int64 q t adm -> Bool
isRollup = Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool)
-> (Job p Int64 q t adm -> Maybe Value)
-> Job p Int64 q t adm
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Job p Int64 q t adm -> Maybe Value
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Maybe Value
parentState

-- | A job read from the database.
type JobRead payload = Job payload Int64 Text UTCTime PayloadKeys

-- | A job ready to enqueue. Arbiter owns claim, retry, parent, rollup, and
-- suspension state. Use the exported setters to configure enqueue fields.
type JobWrite payload = Job payload () () () ()

-- | A payload's stored form.
toStored :: (ToJSON payload) => payload -> Stored payload
toStored :: forall payload. ToJSON payload => payload -> Stored payload
toStored = ByteString -> Stored payload
forall payload. ByteString -> Stored payload
Stored (ByteString -> Stored payload)
-> (payload -> ByteString) -> payload -> Stored payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (payload -> LazyByteString) -> payload -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. payload -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
encode

-- | Decode a stored payload, or the reason the type rejects it.
decodeStored :: (FromJSON payload) => Stored payload -> Either Text payload
decodeStored :: forall payload.
FromJSON payload =>
Stored payload -> Either Text payload
decodeStored = (String -> Text) -> Either String payload -> Either Text payload
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bi.first ((Text
"Failed to decode job payload: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Either String payload -> Either Text payload)
-> (Stored payload -> Either String payload)
-> Stored payload
-> Either Text payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String payload
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (ByteString -> Either String payload)
-> (Stored payload -> ByteString)
-> Stored payload
-> Either String payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored payload -> ByteString
forall payload. Stored payload -> ByteString
storedBytes

-- | Decode the complete persisted representation of a job.
instance (FromJSON payload) => FromJSON (JobRead payload) where
  parseJSON :: Value -> Parser (JobRead payload)
parseJSON = String
-> (Object -> Parser (JobRead payload))
-> Value
-> Parser (JobRead payload)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Job" ((Object -> Parser (JobRead payload))
 -> Value -> Parser (JobRead payload))
-> (Object -> Parser (JobRead payload))
-> Value
-> Parser (JobRead payload)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Int64
-> payload
-> Text
-> Maybe Text
-> UTCTime
-> Maybe UTCTime
-> Int32
-> Maybe Text
-> Int32
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe DedupKey
-> Maybe Int32
-> Maybe Int64
-> Maybe Value
-> Maybe TraceContext
-> Bool
-> Maybe UUID
-> Int64
-> Maybe Int32
-> PayloadKeys
-> JobRead payload
forall payload key q insertedAt adm.
key
-> payload
-> q
-> Maybe Text
-> insertedAt
-> Maybe UTCTime
-> Int32
-> Maybe Text
-> Int32
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe DedupKey
-> Maybe Int32
-> Maybe Int64
-> Maybe Value
-> Maybe TraceContext
-> Bool
-> Maybe UUID
-> Int64
-> Maybe Int32
-> adm
-> JobRecord payload key q insertedAt adm
Job
      (Int64
 -> payload
 -> Text
 -> Maybe Text
 -> UTCTime
 -> Maybe UTCTime
 -> Int32
 -> Maybe Text
 -> Int32
 -> Maybe UTCTime
 -> Maybe UTCTime
 -> Maybe DedupKey
 -> Maybe Int32
 -> Maybe Int64
 -> Maybe Value
 -> Maybe TraceContext
 -> Bool
 -> Maybe UUID
 -> Int64
 -> Maybe Int32
 -> PayloadKeys
 -> JobRead payload)
-> Parser Int64
-> Parser
     (payload
      -> Text
      -> Maybe Text
      -> UTCTime
      -> Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"primaryKey"
      Parser
  (payload
   -> Text
   -> Maybe Text
   -> UTCTime
   -> Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser payload
-> Parser
     (Text
      -> Maybe Text
      -> UTCTime
      -> Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser payload
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"payload"
      Parser
  (Text
   -> Maybe Text
   -> UTCTime
   -> Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser Text
-> Parser
     (Maybe Text
      -> UTCTime
      -> Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"queueName"
      Parser
  (Maybe Text
   -> UTCTime
   -> Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe Text)
-> Parser
     (UTCTime
      -> Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"groupKey"
      Parser
  (UTCTime
   -> Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser UTCTime
-> Parser
     (Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"insertedAt"
      Parser
  (Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe UTCTime)
-> Parser
     (Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updatedAt"
      Parser
  (Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser Int32
-> Parser
     (Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"attempts"
      Parser
  (Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe Text)
-> Parser
     (Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lastError"
      Parser
  (Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser Int32
-> Parser
     (Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"priority"
      Parser
  (Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe UTCTime)
-> Parser
     (Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lastAttemptedAt"
      Parser
  (Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe UTCTime)
-> Parser
     (Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"notVisibleUntil"
      Parser
  (Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe DedupKey)
-> Parser
     (Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe DedupKey)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dedupKey"
      Parser
  (Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe Int32)
-> Parser
     (Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Int32)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxAttempts"
      Parser
  (Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe Int64)
-> Parser
     (Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parentId"
      Parser
  (Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe Value)
-> Parser
     (Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parentState"
      Parser
  (Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser (Maybe TraceContext)
-> Parser
     (Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Text -> Maybe Text -> Maybe TraceContext
toTraceContext (Maybe Text -> Maybe Text -> Maybe TraceContext)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Maybe TraceContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"traceparent" Parser (Maybe Text -> Maybe TraceContext)
-> Parser (Maybe Text) -> Parser (Maybe TraceContext)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tracestate")
      Parser
  (Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRead payload)
-> Parser Bool
-> Parser
     (Maybe UUID
      -> Int64 -> Maybe Int32 -> PayloadKeys -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"suspended"
      Parser
  (Maybe UUID
   -> Int64 -> Maybe Int32 -> PayloadKeys -> JobRead payload)
-> Parser (Maybe UUID)
-> Parser (Int64 -> Maybe Int32 -> PayloadKeys -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe UUID)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"claimedBy"
      Parser (Int64 -> Maybe Int32 -> PayloadKeys -> JobRead payload)
-> Parser Int64
-> Parser (Maybe Int32 -> PayloadKeys -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"claimSeq"
      Parser (Maybe Int32 -> PayloadKeys -> JobRead payload)
-> Parser (Maybe Int32) -> Parser (PayloadKeys -> JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Int32)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"archiveFor"
      Parser (PayloadKeys -> JobRead payload)
-> Parser PayloadKeys -> Parser (JobRead payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Text
-> Maybe RateLimitKey -> Maybe ConcurrencyKey -> PayloadKeys
PayloadKeys (Maybe Text
 -> Maybe RateLimitKey -> Maybe ConcurrencyKey -> PayloadKeys)
-> Parser (Maybe Text)
-> Parser
     (Maybe RateLimitKey -> Maybe ConcurrencyKey -> PayloadKeys)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"kind" Parser (Maybe RateLimitKey -> Maybe ConcurrencyKey -> PayloadKeys)
-> Parser (Maybe RateLimitKey)
-> Parser (Maybe ConcurrencyKey -> PayloadKeys)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe RateLimitKey)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rateLimit" Parser (Maybe ConcurrencyKey -> PayloadKeys)
-> Parser (Maybe ConcurrencyKey) -> Parser PayloadKeys
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe ConcurrencyKey)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"concurrency")

instance (ToJSON payload) => ToJSON (JobRead payload) where
  toJSON :: JobRead payload -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (JobRead payload -> [Pair]) -> JobRead payload -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JobRead payload -> [Pair]
forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
JobRead payload -> [kv]
jobReadFields
  toEncoding :: JobRead payload -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (JobRead payload -> Series) -> JobRead payload -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (JobRead payload -> [Series]) -> JobRead payload -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JobRead payload -> [Series]
forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
JobRead payload -> [kv]
jobReadFields

-- | A job's JSON fields as key-value pairs.
jobReadPairs :: (ToJSON payload) => JobRead payload -> [Pair]
jobReadPairs :: forall payload. ToJSON payload => JobRead payload -> [Pair]
jobReadPairs = JobRead payload -> [Pair]
forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
JobRead payload -> [kv]
jobReadFields

-- | A job's JSON fields as an encoding series.
jobReadSeries :: (ToJSON payload) => JobRead payload -> Series
jobReadSeries :: forall payload. ToJSON payload => JobRead payload -> Series
jobReadSeries = [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (JobRead payload -> [Series]) -> JobRead payload -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JobRead payload -> [Series]
forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
JobRead payload -> [kv]
jobReadFields

jobReadFields :: (KeyValue e kv, ToJSON payload) => JobRead payload -> [kv]
jobReadFields :: forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
JobRead payload -> [kv]
jobReadFields JobRead payload
job =
  [ Key
"primaryKey" Key -> Int64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Int64
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> key
primaryKey JobRead payload
job
  , Key
"payload" Key -> payload -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> payload
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> payload
payload JobRead payload
job
  , Key
"queueName" Key -> Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Text
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> q
queueName JobRead payload
job
  , Key
"groupKey" Key -> Maybe Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe Text
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> Maybe Text
groupKey JobRead payload
job
  , Key
"insertedAt" Key -> UTCTime -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> UTCTime
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> insertedAt
insertedAt JobRead payload
job
  , Key
"updatedAt" Key -> Maybe UTCTime -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe UTCTime
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Maybe UTCTime
updatedAt JobRead payload
job
  , Key
"attempts" Key -> Int32 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Int32
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Int32
attempts JobRead payload
job
  , Key
"lastError" Key -> Maybe Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe Text
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Maybe Text
lastError JobRead payload
job
  , Key
"priority" Key -> Int32 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Int32
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> Int32
priority JobRead payload
job
  , Key
"lastAttemptedAt" Key -> Maybe UTCTime -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe UTCTime
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Maybe UTCTime
lastAttemptedAt JobRead payload
job
  , Key
"notVisibleUntil" Key -> Maybe UTCTime -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe UTCTime
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> Maybe UTCTime
notVisibleUntil JobRead payload
job
  , Key
"dedupKey" Key -> Maybe DedupKey -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe DedupKey
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> Maybe DedupKey
dedupKey JobRead payload
job
  , Key
"maxAttempts" Key -> Maybe Int32 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe Int32
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> Maybe Int32
maxAttempts JobRead payload
job
  , Key
"parentId" Key -> Maybe Int64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe Int64
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Maybe Int64
parentId JobRead payload
job
  , Key
"parentState" Key -> Maybe Value -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe Value
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Maybe Value
parentState JobRead payload
job
  , Key
"isRollup" Key -> Bool -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Bool
forall p q t adm. Job p Int64 q t adm -> Bool
isRollup JobRead payload
job
  , Key
"traceparent" Key -> Maybe Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TraceContext -> Text
traceparent (TraceContext -> Text) -> Maybe TraceContext -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JobRead payload -> Maybe TraceContext
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> Maybe TraceContext
traceContext JobRead payload
job)
  , Key
"tracestate" Key -> Maybe Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TraceContext -> Maybe Text
tracestate (TraceContext -> Maybe Text) -> Maybe TraceContext -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JobRead payload -> Maybe TraceContext
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> Maybe TraceContext
traceContext JobRead payload
job)
  , Key
"suspended" Key -> Bool -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Bool
forall p q t adm. Job p Int64 q t adm -> Bool
suspended JobRead payload
job
  , Key
"claimedBy" Key -> Maybe UUID -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe UUID
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Maybe UUID
claimedBy JobRead payload
job
  , Key
"claimSeq" Key -> Int64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Int64
forall payload q insertedAt adm.
Job payload Int64 q insertedAt adm -> Int64
claimSeq JobRead payload
job
  , Key
"archiveFor" Key -> Maybe Int32 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JobRead payload -> Maybe Int32
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> Maybe Int32
archiveFor JobRead payload
job
  , Key
"kind" Key -> Maybe Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PayloadKeys -> Maybe Text
jobKind (JobRead payload -> PayloadKeys
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> adm
payloadKeys JobRead payload
job)
  , Key
"rateLimit" Key -> Maybe RateLimitKey -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PayloadKeys -> Maybe RateLimitKey
jobRateLimitKey (JobRead payload -> PayloadKeys
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> adm
payloadKeys JobRead payload
job)
  , Key
"concurrency" Key -> Maybe ConcurrencyKey -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PayloadKeys -> Maybe ConcurrencyKey
jobConcurrencyKey (JobRead payload -> PayloadKeys
forall payload key q insertedAt adm.
Job payload key q insertedAt adm -> adm
payloadKeys JobRead payload
job)
  ]

-- | Ungrouped 'JobWrite' with default values. For serial processing within a
-- group, use 'defaultGroupedJob'.
defaultJob :: payload -> JobWrite payload
defaultJob :: forall payload. payload -> JobWrite payload
defaultJob payload
value =
  Job
    { primaryKey :: ()
primaryKey = ()
    , payload :: payload
payload = payload
value
    , queueName :: ()
queueName = ()
    , groupKey :: Maybe Text
groupKey = Maybe Text
forall a. Maybe a
Nothing
    , insertedAt :: ()
insertedAt = ()
    , updatedAt :: Maybe UTCTime
updatedAt = Maybe UTCTime
forall a. Maybe a
Nothing
    , attempts :: Int32
attempts = Int32
0
    , lastError :: Maybe Text
lastError = Maybe Text
forall a. Maybe a
Nothing
    , priority :: Int32
priority = Int32
0
    , lastAttemptedAt :: Maybe UTCTime
lastAttemptedAt = Maybe UTCTime
forall a. Maybe a
Nothing
    , notVisibleUntil :: Maybe UTCTime
notVisibleUntil = Maybe UTCTime
forall a. Maybe a
Nothing
    , dedupKey :: Maybe DedupKey
dedupKey = Maybe DedupKey
forall a. Maybe a
Nothing
    , maxAttempts :: Maybe Int32
maxAttempts = Maybe Int32
forall a. Maybe a
Nothing
    , parentId :: Maybe Int64
parentId = Maybe Int64
forall a. Maybe a
Nothing
    , parentState :: Maybe Value
parentState = Maybe Value
forall a. Maybe a
Nothing
    , traceContext :: Maybe TraceContext
traceContext = Maybe TraceContext
forall a. Maybe a
Nothing
    , suspended :: Bool
suspended = Bool
False
    , claimedBy :: Maybe UUID
claimedBy = Maybe UUID
forall a. Maybe a
Nothing
    , claimSeq :: Int64
claimSeq = Int64
0
    , archiveFor :: Maybe Int32
archiveFor = Maybe Int32
forall a. Maybe a
Nothing
    , payloadKeys :: ()
payloadKeys = ()
    }

-- | 'defaultJob' with a group key. Jobs sharing a group key are processed serially.
defaultGroupedJob :: Text -> payload -> JobWrite payload
defaultGroupedJob :: forall payload. Text -> payload -> JobWrite payload
defaultGroupedJob Text
key = Maybe Text -> JobWrite payload -> JobWrite payload
forall payload. Maybe Text -> JobWrite payload -> JobWrite payload
setGroupKey (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key) (JobWrite payload -> JobWrite payload)
-> (payload -> JobWrite payload) -> payload -> JobWrite payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. payload -> JobWrite payload
forall payload. payload -> JobWrite payload
defaultJob

-- | Replace the payload.
setPayload :: payload' -> JobWrite payload -> JobWrite payload'
setPayload :: forall payload' payload.
payload' -> JobWrite payload -> JobWrite payload'
setPayload payload'
value JobWrite payload
job = JobWrite payload
job {payload = value}

-- | Set the group key.
setGroupKey :: Maybe Text -> JobWrite payload -> JobWrite payload
setGroupKey :: forall payload. Maybe Text -> JobWrite payload -> JobWrite payload
setGroupKey Maybe Text
value JobWrite payload
job = JobWrite payload
job {groupKey = value}

-- | Set the claim priority. Lower numbers claim first. In a group, a retried job goes first.
setPriority :: Int32 -> JobWrite payload -> JobWrite payload
setPriority :: forall payload. Int32 -> JobWrite payload -> JobWrite payload
setPriority Int32
value JobWrite payload
job = JobWrite payload
job {priority = value}

-- | Delay the job's first visibility.
setNotVisibleUntil :: Maybe UTCTime -> JobWrite payload -> JobWrite payload
setNotVisibleUntil :: forall payload.
Maybe UTCTime -> JobWrite payload -> JobWrite payload
setNotVisibleUntil Maybe UTCTime
value JobWrite payload
job = JobWrite payload
job {notVisibleUntil = value}

-- | Set the dedup key.
setDedupKey :: Maybe DedupKey -> JobWrite payload -> JobWrite payload
setDedupKey :: forall payload.
Maybe DedupKey -> JobWrite payload -> JobWrite payload
setDedupKey Maybe DedupKey
value JobWrite payload
job = JobWrite payload
job {dedupKey = value}

-- | Set the attempt limit. 'Nothing' takes 'defaultMaxAttempts'. Values below
-- 'minMaxAttempts' are raised to it.
setMaxAttempts :: Maybe Int32 -> JobWrite payload -> JobWrite payload
setMaxAttempts :: forall payload. Maybe Int32 -> JobWrite payload -> JobWrite payload
setMaxAttempts Maybe Int32
value JobWrite payload
job = JobWrite payload
job {maxAttempts = value}

-- | Attach a trace context.
setTraceContext :: Maybe TraceContext -> JobWrite payload -> JobWrite payload
setTraceContext :: forall payload.
Maybe TraceContext -> JobWrite payload -> JobWrite payload
setTraceContext Maybe TraceContext
value JobWrite payload
job = JobWrite payload
job {traceContext = value}

-- | Set the archive retention, in seconds.
setArchiveFor :: Maybe Int32 -> JobWrite payload -> JobWrite payload
setArchiveFor :: forall payload. Maybe Int32 -> JobWrite payload -> JobWrite payload
setArchiveFor Maybe Int32
value JobWrite payload
job = JobWrite payload
job {archiveFor = value}

-- | Transform a job's payload without changing its stored metadata.
mapPayload
  :: (payload -> payload')
  -> Job payload key q insertedAt adm
  -> Job payload' key q insertedAt adm
mapPayload :: forall payload payload' key q insertedAt adm.
(payload -> payload')
-> Job payload key q insertedAt adm
-> Job payload' key q insertedAt adm
mapPayload payload -> payload'
transform Job payload key q insertedAt adm
job = Job payload key q insertedAt adm
job {payload = transform (payload job)}

-- | The full payload contract. JSON round-trip for JSONB storage plus the kind,
-- rate-limit and concurrency declarations. All three default to none.
type JobPayload payload =
  (FromJSON payload, ToJSON payload, HasKind payload, HasRateLimit payload, HasConcurrency payload)

-- | The constraint that lets the migration collect a registry's declared policies of both kinds.
type RegistryAdmissionPolicies registry =
  (RegistryConcurrencyPolicies registry, RegistryRateLimitPolicies registry)

-- | A job's primary key.
type JobId = Int64

-- | The token identifying one claim of a job.
type ClaimSeq = Int64

-- | When the worker thread received the job's batch.
type ClaimTime = UTCTime

-- | The worker's clock reading after the extend landed.
type CurrentTime = UTCTime

-- | When the worker thread received the job's batch.
type StartTime = UTCTime

-- | For a success, when the ack committed. For a failure, when the handler failed the job.
type EndTime = UTCTime

-- | A failure message.
type ErrorMsg = Text

-- | How long to wait before the next attempt.
type BackoffDelay = NominalDiffTime

-- | Callbacks fired at each point of a job's lifecycle, for metrics, logging or tracing.
-- The worker catches an exception thrown inside one and logs it at Warning.
data ObservabilityHooks m payload = ObservabilityHooks
  { forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> UTCTime -> m ()
onJobClaimed
      :: (JobPayload payload)
      => JobRead payload
      -> ClaimTime
      -> m ()
  -- ^ Called when a worker thread starts a claimed job.
  , forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
onJobSuccess
      :: (JobPayload payload)
      => JobRead payload
      -> StartTime
      -> EndTime
      -> m ()
  -- ^ Called when the job's ack or spawn commits. In batched mode this can occur while the
  -- handler runs.
  , forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
onJobFailure
      :: (JobPayload payload)
      => JobRead payload
      -> ErrorMsg
      -> StartTime
      -> EndTime
      -> m ()
  -- ^ Called after a job handler fails and the job was retried or dead-lettered.
  -- A deliberate cancel reports through 'onJobCancelled'.
  , forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> BackoffDelay -> m ()
onJobRetry
      :: (JobPayload payload)
      => JobRead payload
      -> BackoffDelay
      -> m ()
  -- ^ Called when a failed job is successfully scheduled for retry.
  , forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobFailedAndMovedToDLQ
      :: (JobPayload payload)
      => JobRead payload
      -> ErrorMsg
      -> m ()
  -- ^ Called when a worker moves a job to the dead-letter queue after a handler failure.
  -- A reaper sweep or an undecodable row fires no hook.
  , forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobCancelled
      :: (JobPayload payload)
      => JobRead payload
      -> ErrorMsg
      -> m ()
  -- ^ Called when a handler or an operator force-cancel cancelled the job. It also fires
  -- when no rows were deleted.
  , forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobUnavailable
      :: (JobPayload payload)
      => JobRead payload
      -> ErrorMsg
      -> m ()
  -- ^ Called when a claimed job went away mid-flight and will not be retried here.
  , forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
onJobHeartbeat
      :: (JobPayload payload)
      => JobRead payload
      -> CurrentTime
      -> StartTime
      -> m ()
  -- ^ Called after each landed extend, on its own thread. It can overlap an earlier
  -- call for the same job and run after the handler has finished.
  }

-- | No-op hooks. Override fields to add observability:
--
-- @
-- myHooks = defaultObservabilityHooks
--   { onJobSuccess = \\job startTime endTime -> do
--       let duration = diffUTCTime endTime startTime
--       logInfo $ "Job " \<\> show (primaryKey job) \<\> " took " \<\> show duration
--   }
-- @
defaultObservabilityHooks :: (Applicative m) => ObservabilityHooks m payload
defaultObservabilityHooks :: forall (m :: * -> *) payload.
Applicative m =>
ObservabilityHooks m payload
defaultObservabilityHooks =
  ObservabilityHooks
    { onJobClaimed :: JobPayload payload => JobRead payload -> UTCTime -> m ()
onJobClaimed = \JobRead payload
_ UTCTime
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , onJobSuccess :: JobPayload payload => JobRead payload -> UTCTime -> UTCTime -> m ()
onJobSuccess = \JobRead payload
_ UTCTime
_ UTCTime
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , onJobFailure :: JobPayload payload =>
JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
onJobFailure = \JobRead payload
_ Text
_ UTCTime
_ UTCTime
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , onJobRetry :: JobPayload payload => JobRead payload -> BackoffDelay -> m ()
onJobRetry = \JobRead payload
_ BackoffDelay
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , onJobFailedAndMovedToDLQ :: JobPayload payload => JobRead payload -> Text -> m ()
onJobFailedAndMovedToDLQ = \JobRead payload
_ Text
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , onJobCancelled :: JobPayload payload => JobRead payload -> Text -> m ()
onJobCancelled = \JobRead payload
_ Text
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , onJobUnavailable :: JobPayload payload => JobRead payload -> Text -> m ()
onJobUnavailable = \JobRead payload
_ Text
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , onJobHeartbeat :: JobPayload payload => JobRead payload -> UTCTime -> UTCTime -> m ()
onJobHeartbeat = \JobRead payload
_ UTCTime
_ UTCTime
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    }

-- | Hooks written in @m@, run in @n@ through the given natural transformation.
-- It must be a monad morphism, such as @lift@.
hoistObservabilityHooks :: (forall a. m a -> n a) -> ObservabilityHooks m payload -> ObservabilityHooks n payload
hoistObservabilityHooks :: forall (m :: * -> *) (n :: * -> *) payload.
(forall a. m a -> n a)
-> ObservabilityHooks m payload -> ObservabilityHooks n payload
hoistObservabilityHooks forall a. m a -> n a
nat ObservabilityHooks m payload
hooks =
  ObservabilityHooks
    { onJobClaimed :: JobPayload payload => JobRead payload -> UTCTime -> n ()
onJobClaimed = \JobRead payload
job UTCTime
claimTime -> m () -> n ()
forall a. m a -> n a
nat (ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> UTCTime -> m ()
onJobClaimed ObservabilityHooks m payload
hooks JobRead payload
job UTCTime
claimTime)
    , onJobSuccess :: JobPayload payload => JobRead payload -> UTCTime -> UTCTime -> n ()
onJobSuccess = \JobRead payload
job UTCTime
start UTCTime
end -> m () -> n ()
forall a. m a -> n a
nat (ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
onJobSuccess ObservabilityHooks m payload
hooks JobRead payload
job UTCTime
start UTCTime
end)
    , onJobFailure :: JobPayload payload =>
JobRead payload -> Text -> UTCTime -> UTCTime -> n ()
onJobFailure = \JobRead payload
job Text
msg UTCTime
start UTCTime
end -> m () -> n ()
forall a. m a -> n a
nat (ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
onJobFailure ObservabilityHooks m payload
hooks JobRead payload
job Text
msg UTCTime
start UTCTime
end)
    , onJobRetry :: JobPayload payload => JobRead payload -> BackoffDelay -> n ()
onJobRetry = \JobRead payload
job BackoffDelay
delay -> m () -> n ()
forall a. m a -> n a
nat (ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> BackoffDelay -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> BackoffDelay -> m ()
onJobRetry ObservabilityHooks m payload
hooks JobRead payload
job BackoffDelay
delay)
    , onJobFailedAndMovedToDLQ :: JobPayload payload => JobRead payload -> Text -> n ()
onJobFailedAndMovedToDLQ = \JobRead payload
job Text
msg -> m () -> n ()
forall a. m a -> n a
nat (ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobFailedAndMovedToDLQ ObservabilityHooks m payload
hooks JobRead payload
job Text
msg)
    , onJobCancelled :: JobPayload payload => JobRead payload -> Text -> n ()
onJobCancelled = \JobRead payload
job Text
msg -> m () -> n ()
forall a. m a -> n a
nat (ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobCancelled ObservabilityHooks m payload
hooks JobRead payload
job Text
msg)
    , onJobUnavailable :: JobPayload payload => JobRead payload -> Text -> n ()
onJobUnavailable = \JobRead payload
job Text
msg -> m () -> n ()
forall a. m a -> n a
nat (ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobUnavailable ObservabilityHooks m payload
hooks JobRead payload
job Text
msg)
    , onJobHeartbeat :: JobPayload payload => JobRead payload -> UTCTime -> UTCTime -> n ()
onJobHeartbeat = \JobRead payload
job UTCTime
now UTCTime
start -> m () -> n ()
forall a. m a -> n a
nat (ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
onJobHeartbeat ObservabilityHooks m payload
hooks JobRead payload
job UTCTime
now UTCTime
start)
    }

-- | Run both hooks at each lifecycle point, left before right. The right one runs
-- however the left ended. When both throw, the right's failure propagates.
instance (MonadUnliftIO m) => Semigroup (ObservabilityHooks m payload) where
  ObservabilityHooks m payload
left <> :: ObservabilityHooks m payload
-> ObservabilityHooks m payload -> ObservabilityHooks m payload
<> ObservabilityHooks m payload
right =
    ObservabilityHooks
      { onJobClaimed :: JobPayload payload => JobRead payload -> UTCTime -> m ()
onJobClaimed = \JobRead payload
job UTCTime
claimTime -> ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> UTCTime -> m ()
onJobClaimed ObservabilityHooks m payload
left JobRead payload
job UTCTime
claimTime m () -> m () -> m ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
`andThen` ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> UTCTime -> m ()
onJobClaimed ObservabilityHooks m payload
right JobRead payload
job UTCTime
claimTime
      , onJobSuccess :: JobPayload payload => JobRead payload -> UTCTime -> UTCTime -> m ()
onJobSuccess = \JobRead payload
job UTCTime
start UTCTime
end -> ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
onJobSuccess ObservabilityHooks m payload
left JobRead payload
job UTCTime
start UTCTime
end m () -> m () -> m ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
`andThen` ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
onJobSuccess ObservabilityHooks m payload
right JobRead payload
job UTCTime
start UTCTime
end
      , onJobFailure :: JobPayload payload =>
JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
onJobFailure = \JobRead payload
job Text
msg UTCTime
start UTCTime
end -> ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
onJobFailure ObservabilityHooks m payload
left JobRead payload
job Text
msg UTCTime
start UTCTime
end m () -> m () -> m ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
`andThen` ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> Text -> UTCTime -> UTCTime -> m ()
onJobFailure ObservabilityHooks m payload
right JobRead payload
job Text
msg UTCTime
start UTCTime
end
      , onJobRetry :: JobPayload payload => JobRead payload -> BackoffDelay -> m ()
onJobRetry = \JobRead payload
job BackoffDelay
delay -> ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> BackoffDelay -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> BackoffDelay -> m ()
onJobRetry ObservabilityHooks m payload
left JobRead payload
job BackoffDelay
delay m () -> m () -> m ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
`andThen` ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> BackoffDelay -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> BackoffDelay -> m ()
onJobRetry ObservabilityHooks m payload
right JobRead payload
job BackoffDelay
delay
      , onJobFailedAndMovedToDLQ :: JobPayload payload => JobRead payload -> Text -> m ()
onJobFailedAndMovedToDLQ = \JobRead payload
job Text
msg -> ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobFailedAndMovedToDLQ ObservabilityHooks m payload
left JobRead payload
job Text
msg m () -> m () -> m ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
`andThen` ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobFailedAndMovedToDLQ ObservabilityHooks m payload
right JobRead payload
job Text
msg
      , onJobCancelled :: JobPayload payload => JobRead payload -> Text -> m ()
onJobCancelled = \JobRead payload
job Text
msg -> ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobCancelled ObservabilityHooks m payload
left JobRead payload
job Text
msg m () -> m () -> m ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
`andThen` ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobCancelled ObservabilityHooks m payload
right JobRead payload
job Text
msg
      , onJobUnavailable :: JobPayload payload => JobRead payload -> Text -> m ()
onJobUnavailable = \JobRead payload
job Text
msg -> ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobUnavailable ObservabilityHooks m payload
left JobRead payload
job Text
msg m () -> m () -> m ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
`andThen` ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload => JobRead payload -> Text -> m ()
onJobUnavailable ObservabilityHooks m payload
right JobRead payload
job Text
msg
      , onJobHeartbeat :: JobPayload payload => JobRead payload -> UTCTime -> UTCTime -> m ()
onJobHeartbeat = \JobRead payload
job UTCTime
now UTCTime
start -> ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
onJobHeartbeat ObservabilityHooks m payload
left JobRead payload
job UTCTime
now UTCTime
start m () -> m () -> m ()
forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
`andThen` ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
forall (m :: * -> *) payload.
ObservabilityHooks m payload
-> JobPayload payload =>
   JobRead payload -> UTCTime -> UTCTime -> m ()
onJobHeartbeat ObservabilityHooks m payload
right JobRead payload
job UTCTime
now UTCTime
start
      }

instance (MonadUnliftIO m) => Monoid (ObservabilityHooks m payload) where
  mempty :: ObservabilityHooks m payload
mempty = ObservabilityHooks m payload
forall (m :: * -> *) payload.
Applicative m =>
ObservabilityHooks m payload
defaultObservabilityHooks

-- | base's @finally@. The second action stays interruptible.
andThen :: (MonadUnliftIO m) => m () -> m () -> m ()
andThen :: forall (m :: * -> *). MonadUnliftIO m => m () -> m () -> m ()
andThen m ()
first m ()
second = ((forall a. m a -> IO a) -> IO ()) -> m ()
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> m () -> IO ()
forall a. m a -> IO a
run m ()
first IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`E.finally` m () -> IO ()
forall a. m a -> IO a
run m ()
second