{-# LANGUAGE OverloadedStrings #-}

-- | Dead-letter queue types. Arbiter moves jobs here after a permanent failure or the last retry.
-- Recover a job with 'Arbiter.Core.HighLevel.retryFromDLQ' or delete it with
-- 'Arbiter.Core.HighLevel.deleteDLQJob'.
module Arbiter.Core.Job.DLQ
  ( DLQJob (..)
  , JobSnapshot
  ) where

import Data.Aeson (FromJSON (..), KeyValue (..), ToJSON (..), object, pairs, withObject, (.:))
import Data.Int (Int64)
import Data.Time (UTCTime)
import GHC.Generics (Generic)

import Arbiter.Core.Job.Types (JobRead)

-- | Full job state when the job left the main queue.
type JobSnapshot payload = JobRead payload

-- | A job in the dead-letter queue.
data DLQJob payload = DLQJob
  { forall payload. DLQJob payload -> Int64
dlqPrimaryKey :: Int64
  -- ^ DLQ table primary key. The snapshot keeps its own job id.
  , forall payload. DLQJob payload -> UTCTime
failedAt :: UTCTime
  -- ^ When the job was moved to the DLQ.
  , forall payload. DLQJob payload -> JobSnapshot payload
jobSnapshot :: JobSnapshot payload
  -- ^ Full job state at time of failure. Its 'Arbiter.Core.Job.Types.lastError' holds
  -- the final error.
  -- For DLQ rollup finalizers, 'Arbiter.Core.Job.Types.parentState' in the snapshot contains the
  -- accumulated child results captured before the descendants moved to the DLQ.
  }
  deriving stock (DLQJob payload -> DLQJob payload -> Bool
(DLQJob payload -> DLQJob payload -> Bool)
-> (DLQJob payload -> DLQJob payload -> Bool)
-> Eq (DLQJob payload)
forall payload.
Eq payload =>
DLQJob payload -> DLQJob payload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall payload.
Eq payload =>
DLQJob payload -> DLQJob payload -> Bool
== :: DLQJob payload -> DLQJob payload -> Bool
$c/= :: forall payload.
Eq payload =>
DLQJob payload -> DLQJob payload -> Bool
/= :: DLQJob payload -> DLQJob payload -> Bool
Eq, (forall x. DLQJob payload -> Rep (DLQJob payload) x)
-> (forall x. Rep (DLQJob payload) x -> DLQJob payload)
-> Generic (DLQJob payload)
forall x. Rep (DLQJob payload) x -> DLQJob payload
forall x. DLQJob payload -> Rep (DLQJob payload) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall payload x. Rep (DLQJob payload) x -> DLQJob payload
forall payload x. DLQJob payload -> Rep (DLQJob payload) x
$cfrom :: forall payload x. DLQJob payload -> Rep (DLQJob payload) x
from :: forall x. DLQJob payload -> Rep (DLQJob payload) x
$cto :: forall payload x. Rep (DLQJob payload) x -> DLQJob payload
to :: forall x. Rep (DLQJob payload) x -> DLQJob payload
Generic, Int -> DLQJob payload -> ShowS
[DLQJob payload] -> ShowS
DLQJob payload -> String
(Int -> DLQJob payload -> ShowS)
-> (DLQJob payload -> String)
-> ([DLQJob payload] -> ShowS)
-> Show (DLQJob payload)
forall payload. Show payload => Int -> DLQJob payload -> ShowS
forall payload. Show payload => [DLQJob payload] -> ShowS
forall payload. Show payload => DLQJob payload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall payload. Show payload => Int -> DLQJob payload -> ShowS
showsPrec :: Int -> DLQJob payload -> ShowS
$cshow :: forall payload. Show payload => DLQJob payload -> String
show :: DLQJob payload -> String
$cshowList :: forall payload. Show payload => [DLQJob payload] -> ShowS
showList :: [DLQJob payload] -> ShowS
Show)

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

dlqJobFields :: (KeyValue e kv, ToJSON payload) => DLQJob payload -> [kv]
dlqJobFields :: forall e kv payload.
(KeyValue e kv, ToJSON payload) =>
DLQJob payload -> [kv]
dlqJobFields DLQJob payload
dlq =
  [ Key
"dlqPrimaryKey" Key -> Int64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DLQJob payload -> Int64
forall payload. DLQJob payload -> Int64
dlqPrimaryKey DLQJob payload
dlq
  , Key
"failedAt" Key -> UTCTime -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DLQJob payload -> UTCTime
forall payload. DLQJob payload -> UTCTime
failedAt DLQJob payload
dlq
  , Key
"jobSnapshot" Key -> JobSnapshot payload -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DLQJob payload -> JobSnapshot payload
forall payload. DLQJob payload -> JobSnapshot payload
jobSnapshot DLQJob payload
dlq
  ]

instance (FromJSON payload) => FromJSON (DLQJob payload) where
  parseJSON :: Value -> Parser (DLQJob payload)
parseJSON = String
-> (Object -> Parser (DLQJob payload))
-> Value
-> Parser (DLQJob payload)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DLQJob" ((Object -> Parser (DLQJob payload))
 -> Value -> Parser (DLQJob payload))
-> (Object -> Parser (DLQJob payload))
-> Value
-> Parser (DLQJob payload)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Int64 -> UTCTime -> JobSnapshot payload -> DLQJob payload
forall payload.
Int64 -> UTCTime -> JobSnapshot payload -> DLQJob payload
DLQJob (Int64 -> UTCTime -> JobSnapshot payload -> DLQJob payload)
-> Parser Int64
-> Parser (UTCTime -> JobSnapshot payload -> DLQJob 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
"dlqPrimaryKey" Parser (UTCTime -> JobSnapshot payload -> DLQJob payload)
-> Parser UTCTime -> Parser (JobSnapshot payload -> DLQJob 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
"failedAt" Parser (JobSnapshot payload -> DLQJob payload)
-> Parser (JobSnapshot payload) -> Parser (DLQJob 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 (JobSnapshot payload)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jobSnapshot"