{-# 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.MQ.Types.ActionRequired
-- 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.MQ.Types.ActionRequired 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

-- | The action required to resolve a broker issue when the broker is in a
-- CRITICAL_ACTION_REQUIRED state.
--
-- /See:/ 'newActionRequired' smart constructor.
data ActionRequired = ActionRequired'
  { -- | The code you can use to resolve your broker issue when the broker is in
    -- a CRITICAL_ACTION_REQUIRED state. You can find instructions by choosing
    -- the link for your code from the list of action required codes in
    -- <https://docs.aws.amazon.com//latest/developer-guide/troubleshooting-action-required-codes.html Amazon MQ action required codes>.
    -- Each code references a topic with detailed information, instructions,
    -- and recommendations for how to resolve the issue and prevent future
    -- occurrences.
    ActionRequired -> Maybe Text
actionRequiredCode :: Prelude.Maybe Prelude.Text,
    -- | Information about the action required to resolve your broker issue when
    -- the broker is in a CRITICAL_ACTION_REQUIRED state.
    ActionRequired -> Maybe Text
actionRequiredInfo :: Prelude.Maybe Prelude.Text
  }
  deriving (ActionRequired -> ActionRequired -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionRequired -> ActionRequired -> Bool
$c/= :: ActionRequired -> ActionRequired -> Bool
== :: ActionRequired -> ActionRequired -> Bool
$c== :: ActionRequired -> ActionRequired -> Bool
Prelude.Eq, ReadPrec [ActionRequired]
ReadPrec ActionRequired
Int -> ReadS ActionRequired
ReadS [ActionRequired]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActionRequired]
$creadListPrec :: ReadPrec [ActionRequired]
readPrec :: ReadPrec ActionRequired
$creadPrec :: ReadPrec ActionRequired
readList :: ReadS [ActionRequired]
$creadList :: ReadS [ActionRequired]
readsPrec :: Int -> ReadS ActionRequired
$creadsPrec :: Int -> ReadS ActionRequired
Prelude.Read, Int -> ActionRequired -> ShowS
[ActionRequired] -> ShowS
ActionRequired -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionRequired] -> ShowS
$cshowList :: [ActionRequired] -> ShowS
show :: ActionRequired -> String
$cshow :: ActionRequired -> String
showsPrec :: Int -> ActionRequired -> ShowS
$cshowsPrec :: Int -> ActionRequired -> ShowS
Prelude.Show, forall x. Rep ActionRequired x -> ActionRequired
forall x. ActionRequired -> Rep ActionRequired x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActionRequired x -> ActionRequired
$cfrom :: forall x. ActionRequired -> Rep ActionRequired x
Prelude.Generic)

-- |
-- Create a value of 'ActionRequired' 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:
--
-- 'actionRequiredCode', 'actionRequired_actionRequiredCode' - The code you can use to resolve your broker issue when the broker is in
-- a CRITICAL_ACTION_REQUIRED state. You can find instructions by choosing
-- the link for your code from the list of action required codes in
-- <https://docs.aws.amazon.com//latest/developer-guide/troubleshooting-action-required-codes.html Amazon MQ action required codes>.
-- Each code references a topic with detailed information, instructions,
-- and recommendations for how to resolve the issue and prevent future
-- occurrences.
--
-- 'actionRequiredInfo', 'actionRequired_actionRequiredInfo' - Information about the action required to resolve your broker issue when
-- the broker is in a CRITICAL_ACTION_REQUIRED state.
newActionRequired ::
  ActionRequired
newActionRequired :: ActionRequired
newActionRequired =
  ActionRequired'
    { $sel:actionRequiredCode:ActionRequired' :: Maybe Text
actionRequiredCode =
        forall a. Maybe a
Prelude.Nothing,
      $sel:actionRequiredInfo:ActionRequired' :: Maybe Text
actionRequiredInfo = forall a. Maybe a
Prelude.Nothing
    }

-- | The code you can use to resolve your broker issue when the broker is in
-- a CRITICAL_ACTION_REQUIRED state. You can find instructions by choosing
-- the link for your code from the list of action required codes in
-- <https://docs.aws.amazon.com//latest/developer-guide/troubleshooting-action-required-codes.html Amazon MQ action required codes>.
-- Each code references a topic with detailed information, instructions,
-- and recommendations for how to resolve the issue and prevent future
-- occurrences.
actionRequired_actionRequiredCode :: Lens.Lens' ActionRequired (Prelude.Maybe Prelude.Text)
actionRequired_actionRequiredCode :: Lens' ActionRequired (Maybe Text)
actionRequired_actionRequiredCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActionRequired' {Maybe Text
actionRequiredCode :: Maybe Text
$sel:actionRequiredCode:ActionRequired' :: ActionRequired -> Maybe Text
actionRequiredCode} -> Maybe Text
actionRequiredCode) (\s :: ActionRequired
s@ActionRequired' {} Maybe Text
a -> ActionRequired
s {$sel:actionRequiredCode:ActionRequired' :: Maybe Text
actionRequiredCode = Maybe Text
a} :: ActionRequired)

-- | Information about the action required to resolve your broker issue when
-- the broker is in a CRITICAL_ACTION_REQUIRED state.
actionRequired_actionRequiredInfo :: Lens.Lens' ActionRequired (Prelude.Maybe Prelude.Text)
actionRequired_actionRequiredInfo :: Lens' ActionRequired (Maybe Text)
actionRequired_actionRequiredInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActionRequired' {Maybe Text
actionRequiredInfo :: Maybe Text
$sel:actionRequiredInfo:ActionRequired' :: ActionRequired -> Maybe Text
actionRequiredInfo} -> Maybe Text
actionRequiredInfo) (\s :: ActionRequired
s@ActionRequired' {} Maybe Text
a -> ActionRequired
s {$sel:actionRequiredInfo:ActionRequired' :: Maybe Text
actionRequiredInfo = Maybe Text
a} :: ActionRequired)

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

instance Prelude.Hashable ActionRequired where
  hashWithSalt :: Int -> ActionRequired -> Int
hashWithSalt Int
_salt ActionRequired' {Maybe Text
actionRequiredInfo :: Maybe Text
actionRequiredCode :: Maybe Text
$sel:actionRequiredInfo:ActionRequired' :: ActionRequired -> Maybe Text
$sel:actionRequiredCode:ActionRequired' :: ActionRequired -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
actionRequiredCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
actionRequiredInfo

instance Prelude.NFData ActionRequired where
  rnf :: ActionRequired -> ()
rnf ActionRequired' {Maybe Text
actionRequiredInfo :: Maybe Text
actionRequiredCode :: Maybe Text
$sel:actionRequiredInfo:ActionRequired' :: ActionRequired -> Maybe Text
$sel:actionRequiredCode:ActionRequired' :: ActionRequired -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionRequiredCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionRequiredInfo