{-# 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.ResilienceHub.Types.ResourceError
-- 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.ResilienceHub.Types.ResourceError where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Defines application resource errors.
--
-- /See:/ 'newResourceError' smart constructor.
data ResourceError = ResourceError'
  { -- | This is the identifier of the resource.
    ResourceError -> Maybe Text
logicalResourceId :: Prelude.Maybe Prelude.Text,
    -- | This is the identifier of the physical resource.
    ResourceError -> Maybe Text
physicalResourceId :: Prelude.Maybe Prelude.Text,
    -- | This is the error message.
    ResourceError -> Maybe Text
reason :: Prelude.Maybe Prelude.Text
  }
  deriving (ResourceError -> ResourceError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceError -> ResourceError -> Bool
$c/= :: ResourceError -> ResourceError -> Bool
== :: ResourceError -> ResourceError -> Bool
$c== :: ResourceError -> ResourceError -> Bool
Prelude.Eq, ReadPrec [ResourceError]
ReadPrec ResourceError
Int -> ReadS ResourceError
ReadS [ResourceError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResourceError]
$creadListPrec :: ReadPrec [ResourceError]
readPrec :: ReadPrec ResourceError
$creadPrec :: ReadPrec ResourceError
readList :: ReadS [ResourceError]
$creadList :: ReadS [ResourceError]
readsPrec :: Int -> ReadS ResourceError
$creadsPrec :: Int -> ReadS ResourceError
Prelude.Read, Int -> ResourceError -> ShowS
[ResourceError] -> ShowS
ResourceError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceError] -> ShowS
$cshowList :: [ResourceError] -> ShowS
show :: ResourceError -> String
$cshow :: ResourceError -> String
showsPrec :: Int -> ResourceError -> ShowS
$cshowsPrec :: Int -> ResourceError -> ShowS
Prelude.Show, forall x. Rep ResourceError x -> ResourceError
forall x. ResourceError -> Rep ResourceError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResourceError x -> ResourceError
$cfrom :: forall x. ResourceError -> Rep ResourceError x
Prelude.Generic)

-- |
-- Create a value of 'ResourceError' 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:
--
-- 'logicalResourceId', 'resourceError_logicalResourceId' - This is the identifier of the resource.
--
-- 'physicalResourceId', 'resourceError_physicalResourceId' - This is the identifier of the physical resource.
--
-- 'reason', 'resourceError_reason' - This is the error message.
newResourceError ::
  ResourceError
newResourceError :: ResourceError
newResourceError =
  ResourceError'
    { $sel:logicalResourceId:ResourceError' :: Maybe Text
logicalResourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:physicalResourceId:ResourceError' :: Maybe Text
physicalResourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:reason:ResourceError' :: Maybe Text
reason = forall a. Maybe a
Prelude.Nothing
    }

-- | This is the identifier of the resource.
resourceError_logicalResourceId :: Lens.Lens' ResourceError (Prelude.Maybe Prelude.Text)
resourceError_logicalResourceId :: Lens' ResourceError (Maybe Text)
resourceError_logicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceError' {Maybe Text
logicalResourceId :: Maybe Text
$sel:logicalResourceId:ResourceError' :: ResourceError -> Maybe Text
logicalResourceId} -> Maybe Text
logicalResourceId) (\s :: ResourceError
s@ResourceError' {} Maybe Text
a -> ResourceError
s {$sel:logicalResourceId:ResourceError' :: Maybe Text
logicalResourceId = Maybe Text
a} :: ResourceError)

-- | This is the identifier of the physical resource.
resourceError_physicalResourceId :: Lens.Lens' ResourceError (Prelude.Maybe Prelude.Text)
resourceError_physicalResourceId :: Lens' ResourceError (Maybe Text)
resourceError_physicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceError' {Maybe Text
physicalResourceId :: Maybe Text
$sel:physicalResourceId:ResourceError' :: ResourceError -> Maybe Text
physicalResourceId} -> Maybe Text
physicalResourceId) (\s :: ResourceError
s@ResourceError' {} Maybe Text
a -> ResourceError
s {$sel:physicalResourceId:ResourceError' :: Maybe Text
physicalResourceId = Maybe Text
a} :: ResourceError)

-- | This is the error message.
resourceError_reason :: Lens.Lens' ResourceError (Prelude.Maybe Prelude.Text)
resourceError_reason :: Lens' ResourceError (Maybe Text)
resourceError_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResourceError' {Maybe Text
reason :: Maybe Text
$sel:reason:ResourceError' :: ResourceError -> Maybe Text
reason} -> Maybe Text
reason) (\s :: ResourceError
s@ResourceError' {} Maybe Text
a -> ResourceError
s {$sel:reason:ResourceError' :: Maybe Text
reason = Maybe Text
a} :: ResourceError)

instance Data.FromJSON ResourceError where
  parseJSON :: Value -> Parser ResourceError
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ResourceError"
      ( \Object
x ->
          Maybe Text -> Maybe Text -> Maybe Text -> ResourceError
ResourceError'
            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
"logicalResourceId")
            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
"physicalResourceId")
            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
"reason")
      )

instance Prelude.Hashable ResourceError where
  hashWithSalt :: Int -> ResourceError -> Int
hashWithSalt Int
_salt ResourceError' {Maybe Text
reason :: Maybe Text
physicalResourceId :: Maybe Text
logicalResourceId :: Maybe Text
$sel:reason:ResourceError' :: ResourceError -> Maybe Text
$sel:physicalResourceId:ResourceError' :: ResourceError -> Maybe Text
$sel:logicalResourceId:ResourceError' :: ResourceError -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
physicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reason

instance Prelude.NFData ResourceError where
  rnf :: ResourceError -> ()
rnf ResourceError' {Maybe Text
reason :: Maybe Text
physicalResourceId :: Maybe Text
logicalResourceId :: Maybe Text
$sel:reason:ResourceError' :: ResourceError -> Maybe Text
$sel:physicalResourceId:ResourceError' :: ResourceError -> Maybe Text
$sel:logicalResourceId:ResourceError' :: ResourceError -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logicalResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
physicalResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reason