{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.DataExchange.Types.JobError
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.DataExchange.Types.JobError where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DataExchange.Types.Code
import Amazonka.DataExchange.Types.Details
import Amazonka.DataExchange.Types.JobErrorLimitName
import Amazonka.DataExchange.Types.JobErrorResourceTypes
import qualified Amazonka.Prelude as Prelude

-- | An error that occurred with the job request.
--
-- /See:/ 'newJobError' smart constructor.
data JobError = JobError'
  { -- | The details about the job error.
    JobError -> Maybe Details
details :: Prelude.Maybe Details,
    -- | The name of the limit that was reached.
    JobError -> Maybe JobErrorLimitName
limitName :: Prelude.Maybe JobErrorLimitName,
    -- | The value of the exceeded limit.
    JobError -> Maybe Double
limitValue :: Prelude.Maybe Prelude.Double,
    -- | The unique identifier for the resource related to the error.
    JobError -> Maybe Text
resourceId :: Prelude.Maybe Prelude.Text,
    -- | The type of resource related to the error.
    JobError -> Maybe JobErrorResourceTypes
resourceType :: Prelude.Maybe JobErrorResourceTypes,
    -- | The code for the job error.
    JobError -> Code
code :: Code,
    -- | The message related to the job error.
    JobError -> Text
message :: Prelude.Text
  }
  deriving (JobError -> JobError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobError -> JobError -> Bool
$c/= :: JobError -> JobError -> Bool
== :: JobError -> JobError -> Bool
$c== :: JobError -> JobError -> Bool
Prelude.Eq, ReadPrec [JobError]
ReadPrec JobError
Int -> ReadS JobError
ReadS [JobError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JobError]
$creadListPrec :: ReadPrec [JobError]
readPrec :: ReadPrec JobError
$creadPrec :: ReadPrec JobError
readList :: ReadS [JobError]
$creadList :: ReadS [JobError]
readsPrec :: Int -> ReadS JobError
$creadsPrec :: Int -> ReadS JobError
Prelude.Read, Int -> JobError -> ShowS
[JobError] -> ShowS
JobError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobError] -> ShowS
$cshowList :: [JobError] -> ShowS
show :: JobError -> String
$cshow :: JobError -> String
showsPrec :: Int -> JobError -> ShowS
$cshowsPrec :: Int -> JobError -> ShowS
Prelude.Show, forall x. Rep JobError x -> JobError
forall x. JobError -> Rep JobError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobError x -> JobError
$cfrom :: forall x. JobError -> Rep JobError x
Prelude.Generic)

-- |
-- Create a value of 'JobError' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'details', 'jobError_details' - The details about the job error.
--
-- 'limitName', 'jobError_limitName' - The name of the limit that was reached.
--
-- 'limitValue', 'jobError_limitValue' - The value of the exceeded limit.
--
-- 'resourceId', 'jobError_resourceId' - The unique identifier for the resource related to the error.
--
-- 'resourceType', 'jobError_resourceType' - The type of resource related to the error.
--
-- 'code', 'jobError_code' - The code for the job error.
--
-- 'message', 'jobError_message' - The message related to the job error.
newJobError ::
  -- | 'code'
  Code ->
  -- | 'message'
  Prelude.Text ->
  JobError
newJobError :: Code -> Text -> JobError
newJobError Code
pCode_ Text
pMessage_ =
  JobError'
    { $sel:details:JobError' :: Maybe Details
details = forall a. Maybe a
Prelude.Nothing,
      $sel:limitName:JobError' :: Maybe JobErrorLimitName
limitName = forall a. Maybe a
Prelude.Nothing,
      $sel:limitValue:JobError' :: Maybe Double
limitValue = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceId:JobError' :: Maybe Text
resourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:JobError' :: Maybe JobErrorResourceTypes
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:code:JobError' :: Code
code = Code
pCode_,
      $sel:message:JobError' :: Text
message = Text
pMessage_
    }

-- | The details about the job error.
jobError_details :: Lens.Lens' JobError (Prelude.Maybe Details)
jobError_details :: Lens' JobError (Maybe Details)
jobError_details = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobError' {Maybe Details
details :: Maybe Details
$sel:details:JobError' :: JobError -> Maybe Details
details} -> Maybe Details
details) (\s :: JobError
s@JobError' {} Maybe Details
a -> JobError
s {$sel:details:JobError' :: Maybe Details
details = Maybe Details
a} :: JobError)

-- | The name of the limit that was reached.
jobError_limitName :: Lens.Lens' JobError (Prelude.Maybe JobErrorLimitName)
jobError_limitName :: Lens' JobError (Maybe JobErrorLimitName)
jobError_limitName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobError' {Maybe JobErrorLimitName
limitName :: Maybe JobErrorLimitName
$sel:limitName:JobError' :: JobError -> Maybe JobErrorLimitName
limitName} -> Maybe JobErrorLimitName
limitName) (\s :: JobError
s@JobError' {} Maybe JobErrorLimitName
a -> JobError
s {$sel:limitName:JobError' :: Maybe JobErrorLimitName
limitName = Maybe JobErrorLimitName
a} :: JobError)

-- | The value of the exceeded limit.
jobError_limitValue :: Lens.Lens' JobError (Prelude.Maybe Prelude.Double)
jobError_limitValue :: Lens' JobError (Maybe Double)
jobError_limitValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobError' {Maybe Double
limitValue :: Maybe Double
$sel:limitValue:JobError' :: JobError -> Maybe Double
limitValue} -> Maybe Double
limitValue) (\s :: JobError
s@JobError' {} Maybe Double
a -> JobError
s {$sel:limitValue:JobError' :: Maybe Double
limitValue = Maybe Double
a} :: JobError)

-- | The unique identifier for the resource related to the error.
jobError_resourceId :: Lens.Lens' JobError (Prelude.Maybe Prelude.Text)
jobError_resourceId :: Lens' JobError (Maybe Text)
jobError_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobError' {Maybe Text
resourceId :: Maybe Text
$sel:resourceId:JobError' :: JobError -> Maybe Text
resourceId} -> Maybe Text
resourceId) (\s :: JobError
s@JobError' {} Maybe Text
a -> JobError
s {$sel:resourceId:JobError' :: Maybe Text
resourceId = Maybe Text
a} :: JobError)

-- | The type of resource related to the error.
jobError_resourceType :: Lens.Lens' JobError (Prelude.Maybe JobErrorResourceTypes)
jobError_resourceType :: Lens' JobError (Maybe JobErrorResourceTypes)
jobError_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobError' {Maybe JobErrorResourceTypes
resourceType :: Maybe JobErrorResourceTypes
$sel:resourceType:JobError' :: JobError -> Maybe JobErrorResourceTypes
resourceType} -> Maybe JobErrorResourceTypes
resourceType) (\s :: JobError
s@JobError' {} Maybe JobErrorResourceTypes
a -> JobError
s {$sel:resourceType:JobError' :: Maybe JobErrorResourceTypes
resourceType = Maybe JobErrorResourceTypes
a} :: JobError)

-- | The code for the job error.
jobError_code :: Lens.Lens' JobError Code
jobError_code :: Lens' JobError Code
jobError_code = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobError' {Code
code :: Code
$sel:code:JobError' :: JobError -> Code
code} -> Code
code) (\s :: JobError
s@JobError' {} Code
a -> JobError
s {$sel:code:JobError' :: Code
code = Code
a} :: JobError)

-- | The message related to the job error.
jobError_message :: Lens.Lens' JobError Prelude.Text
jobError_message :: Lens' JobError Text
jobError_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobError' {Text
message :: Text
$sel:message:JobError' :: JobError -> Text
message} -> Text
message) (\s :: JobError
s@JobError' {} Text
a -> JobError
s {$sel:message:JobError' :: Text
message = Text
a} :: JobError)

instance Data.FromJSON JobError where
  parseJSON :: Value -> Parser JobError
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"JobError"
      ( \Object
x ->
          Maybe Details
-> Maybe JobErrorLimitName
-> Maybe Double
-> Maybe Text
-> Maybe JobErrorResourceTypes
-> Code
-> Text
-> JobError
JobError'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Details")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"LimitName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"LimitValue")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ResourceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ResourceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Code")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Message")
      )

instance Prelude.Hashable JobError where
  hashWithSalt :: Int -> JobError -> Int
hashWithSalt Int
_salt JobError' {Maybe Double
Maybe Text
Maybe Details
Maybe JobErrorLimitName
Maybe JobErrorResourceTypes
Text
Code
message :: Text
code :: Code
resourceType :: Maybe JobErrorResourceTypes
resourceId :: Maybe Text
limitValue :: Maybe Double
limitName :: Maybe JobErrorLimitName
details :: Maybe Details
$sel:message:JobError' :: JobError -> Text
$sel:code:JobError' :: JobError -> Code
$sel:resourceType:JobError' :: JobError -> Maybe JobErrorResourceTypes
$sel:resourceId:JobError' :: JobError -> Maybe Text
$sel:limitValue:JobError' :: JobError -> Maybe Double
$sel:limitName:JobError' :: JobError -> Maybe JobErrorLimitName
$sel:details:JobError' :: JobError -> Maybe Details
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Details
details
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobErrorLimitName
limitName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
limitValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobErrorResourceTypes
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Code
code
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
message

instance Prelude.NFData JobError where
  rnf :: JobError -> ()
rnf JobError' {Maybe Double
Maybe Text
Maybe Details
Maybe JobErrorLimitName
Maybe JobErrorResourceTypes
Text
Code
message :: Text
code :: Code
resourceType :: Maybe JobErrorResourceTypes
resourceId :: Maybe Text
limitValue :: Maybe Double
limitName :: Maybe JobErrorLimitName
details :: Maybe Details
$sel:message:JobError' :: JobError -> Text
$sel:code:JobError' :: JobError -> Code
$sel:resourceType:JobError' :: JobError -> Maybe JobErrorResourceTypes
$sel:resourceId:JobError' :: JobError -> Maybe Text
$sel:limitValue:JobError' :: JobError -> Maybe Double
$sel:limitName:JobError' :: JobError -> Maybe JobErrorLimitName
$sel:details:JobError' :: JobError -> Maybe Details
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Details
details
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobErrorLimitName
limitName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
limitValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobErrorResourceTypes
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Code
code
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
message