module Faktory.JobFailure
  ( JobFailure(..)
  ) where

import Faktory.Prelude

import Data.Aeson
import Data.Time (UTCTime)

data JobFailure = JobFailure
  { JobFailure -> Int
jfRetryCount :: Int
  , JobFailure -> UTCTime
jfFailedAt :: UTCTime
  , JobFailure -> Maybe UTCTime
jfNextAt :: Maybe UTCTime
  , JobFailure -> Maybe Text
jfErrorMessage :: Maybe Text
  , JobFailure -> Maybe Text
jfErrorType :: Maybe Text
  , JobFailure -> Maybe [Text]
jfBacktrace :: Maybe [Text]
  }

-- brittany-disable-next-binding

instance FromJSON JobFailure where
  parseJSON :: Value -> Parser JobFailure
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Failure" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> JobFailure
JobFailure
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"retry_count"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failed_at"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"next_at"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_message"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_type"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backtrace"