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

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

-- |
-- Module      : Amazonka.SSMIncidents.UpdateResponsePlan
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the specified response plan.
module Amazonka.SSMIncidents.UpdateResponsePlan
  ( -- * Creating a Request
    UpdateResponsePlan (..),
    newUpdateResponsePlan,

    -- * Request Lenses
    updateResponsePlan_actions,
    updateResponsePlan_chatChannel,
    updateResponsePlan_clientToken,
    updateResponsePlan_displayName,
    updateResponsePlan_engagements,
    updateResponsePlan_incidentTemplateDedupeString,
    updateResponsePlan_incidentTemplateImpact,
    updateResponsePlan_incidentTemplateNotificationTargets,
    updateResponsePlan_incidentTemplateSummary,
    updateResponsePlan_incidentTemplateTags,
    updateResponsePlan_incidentTemplateTitle,
    updateResponsePlan_integrations,
    updateResponsePlan_arn,

    -- * Destructuring the Response
    UpdateResponsePlanResponse (..),
    newUpdateResponsePlanResponse,

    -- * Response Lenses
    updateResponsePlanResponse_httpStatus,
  )
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
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SSMIncidents.Types

-- | /See:/ 'newUpdateResponsePlan' smart constructor.
data UpdateResponsePlan = UpdateResponsePlan'
  { -- | The actions that this response plan takes at the beginning of an
    -- incident.
    UpdateResponsePlan -> Maybe [Action]
actions :: Prelude.Maybe [Action],
    -- | The Chatbot chat channel used for collaboration during an incident.
    --
    -- Use the empty structure to remove the chat channel from the response
    -- plan.
    UpdateResponsePlan -> Maybe ChatChannel
chatChannel :: Prelude.Maybe ChatChannel,
    -- | A token ensuring that the operation is called only once with the
    -- specified details.
    UpdateResponsePlan -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The long format name of the response plan. The display name can\'t
    -- contain spaces.
    UpdateResponsePlan -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) for the contacts and escalation plans
    -- that the response plan engages during an incident.
    UpdateResponsePlan -> Maybe [Text]
engagements :: Prelude.Maybe [Prelude.Text],
    -- | The string Incident Manager uses to prevent duplicate incidents from
    -- being created by the same incident in the same account.
    UpdateResponsePlan -> Maybe Text
incidentTemplateDedupeString :: Prelude.Maybe Prelude.Text,
    -- | Defines the impact to the customers. Providing an impact overwrites the
    -- impact provided by a response plan.
    --
    -- __Possible impacts:__
    --
    -- -   @5@ - Severe impact
    --
    -- -   @4@ - High impact
    --
    -- -   @3@ - Medium impact
    --
    -- -   @2@ - Low impact
    --
    -- -   @1@ - No impact
    UpdateResponsePlan -> Maybe Natural
incidentTemplateImpact :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon SNS targets that are notified when updates are made to an
    -- incident.
    UpdateResponsePlan -> Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets :: Prelude.Maybe [NotificationTargetItem],
    -- | A brief summary of the incident. This typically contains what has
    -- happened, what\'s currently happening, and next steps.
    UpdateResponsePlan -> Maybe Text
incidentTemplateSummary :: Prelude.Maybe Prelude.Text,
    -- | Tags to assign to the template. When the @StartIncident@ API action is
    -- called, Incident Manager assigns the tags specified in the template to
    -- the incident. To call this action, you must also have permission to call
    -- the @TagResource@ API action for the incident record resource.
    UpdateResponsePlan -> Maybe (HashMap Text Text)
incidentTemplateTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The short format name of the incident. The title can\'t contain spaces.
    UpdateResponsePlan -> Maybe Text
incidentTemplateTitle :: Prelude.Maybe Prelude.Text,
    -- | Information about third-party services integrated into the response
    -- plan.
    UpdateResponsePlan -> Maybe [Integration]
integrations :: Prelude.Maybe [Integration],
    -- | The Amazon Resource Name (ARN) of the response plan.
    UpdateResponsePlan -> Text
arn :: Prelude.Text
  }
  deriving (UpdateResponsePlan -> UpdateResponsePlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateResponsePlan -> UpdateResponsePlan -> Bool
$c/= :: UpdateResponsePlan -> UpdateResponsePlan -> Bool
== :: UpdateResponsePlan -> UpdateResponsePlan -> Bool
$c== :: UpdateResponsePlan -> UpdateResponsePlan -> Bool
Prelude.Eq, ReadPrec [UpdateResponsePlan]
ReadPrec UpdateResponsePlan
Int -> ReadS UpdateResponsePlan
ReadS [UpdateResponsePlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateResponsePlan]
$creadListPrec :: ReadPrec [UpdateResponsePlan]
readPrec :: ReadPrec UpdateResponsePlan
$creadPrec :: ReadPrec UpdateResponsePlan
readList :: ReadS [UpdateResponsePlan]
$creadList :: ReadS [UpdateResponsePlan]
readsPrec :: Int -> ReadS UpdateResponsePlan
$creadsPrec :: Int -> ReadS UpdateResponsePlan
Prelude.Read, Int -> UpdateResponsePlan -> ShowS
[UpdateResponsePlan] -> ShowS
UpdateResponsePlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateResponsePlan] -> ShowS
$cshowList :: [UpdateResponsePlan] -> ShowS
show :: UpdateResponsePlan -> String
$cshow :: UpdateResponsePlan -> String
showsPrec :: Int -> UpdateResponsePlan -> ShowS
$cshowsPrec :: Int -> UpdateResponsePlan -> ShowS
Prelude.Show, forall x. Rep UpdateResponsePlan x -> UpdateResponsePlan
forall x. UpdateResponsePlan -> Rep UpdateResponsePlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateResponsePlan x -> UpdateResponsePlan
$cfrom :: forall x. UpdateResponsePlan -> Rep UpdateResponsePlan x
Prelude.Generic)

-- |
-- Create a value of 'UpdateResponsePlan' 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:
--
-- 'actions', 'updateResponsePlan_actions' - The actions that this response plan takes at the beginning of an
-- incident.
--
-- 'chatChannel', 'updateResponsePlan_chatChannel' - The Chatbot chat channel used for collaboration during an incident.
--
-- Use the empty structure to remove the chat channel from the response
-- plan.
--
-- 'clientToken', 'updateResponsePlan_clientToken' - A token ensuring that the operation is called only once with the
-- specified details.
--
-- 'displayName', 'updateResponsePlan_displayName' - The long format name of the response plan. The display name can\'t
-- contain spaces.
--
-- 'engagements', 'updateResponsePlan_engagements' - The Amazon Resource Name (ARN) for the contacts and escalation plans
-- that the response plan engages during an incident.
--
-- 'incidentTemplateDedupeString', 'updateResponsePlan_incidentTemplateDedupeString' - The string Incident Manager uses to prevent duplicate incidents from
-- being created by the same incident in the same account.
--
-- 'incidentTemplateImpact', 'updateResponsePlan_incidentTemplateImpact' - Defines the impact to the customers. Providing an impact overwrites the
-- impact provided by a response plan.
--
-- __Possible impacts:__
--
-- -   @5@ - Severe impact
--
-- -   @4@ - High impact
--
-- -   @3@ - Medium impact
--
-- -   @2@ - Low impact
--
-- -   @1@ - No impact
--
-- 'incidentTemplateNotificationTargets', 'updateResponsePlan_incidentTemplateNotificationTargets' - The Amazon SNS targets that are notified when updates are made to an
-- incident.
--
-- 'incidentTemplateSummary', 'updateResponsePlan_incidentTemplateSummary' - A brief summary of the incident. This typically contains what has
-- happened, what\'s currently happening, and next steps.
--
-- 'incidentTemplateTags', 'updateResponsePlan_incidentTemplateTags' - Tags to assign to the template. When the @StartIncident@ API action is
-- called, Incident Manager assigns the tags specified in the template to
-- the incident. To call this action, you must also have permission to call
-- the @TagResource@ API action for the incident record resource.
--
-- 'incidentTemplateTitle', 'updateResponsePlan_incidentTemplateTitle' - The short format name of the incident. The title can\'t contain spaces.
--
-- 'integrations', 'updateResponsePlan_integrations' - Information about third-party services integrated into the response
-- plan.
--
-- 'arn', 'updateResponsePlan_arn' - The Amazon Resource Name (ARN) of the response plan.
newUpdateResponsePlan ::
  -- | 'arn'
  Prelude.Text ->
  UpdateResponsePlan
newUpdateResponsePlan :: Text -> UpdateResponsePlan
newUpdateResponsePlan Text
pArn_ =
  UpdateResponsePlan'
    { $sel:actions:UpdateResponsePlan' :: Maybe [Action]
actions = forall a. Maybe a
Prelude.Nothing,
      $sel:chatChannel:UpdateResponsePlan' :: Maybe ChatChannel
chatChannel = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:UpdateResponsePlan' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:UpdateResponsePlan' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:engagements:UpdateResponsePlan' :: Maybe [Text]
engagements = forall a. Maybe a
Prelude.Nothing,
      $sel:incidentTemplateDedupeString:UpdateResponsePlan' :: Maybe Text
incidentTemplateDedupeString = forall a. Maybe a
Prelude.Nothing,
      $sel:incidentTemplateImpact:UpdateResponsePlan' :: Maybe Natural
incidentTemplateImpact = forall a. Maybe a
Prelude.Nothing,
      $sel:incidentTemplateNotificationTargets:UpdateResponsePlan' :: Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets =
        forall a. Maybe a
Prelude.Nothing,
      $sel:incidentTemplateSummary:UpdateResponsePlan' :: Maybe Text
incidentTemplateSummary = forall a. Maybe a
Prelude.Nothing,
      $sel:incidentTemplateTags:UpdateResponsePlan' :: Maybe (HashMap Text Text)
incidentTemplateTags = forall a. Maybe a
Prelude.Nothing,
      $sel:incidentTemplateTitle:UpdateResponsePlan' :: Maybe Text
incidentTemplateTitle = forall a. Maybe a
Prelude.Nothing,
      $sel:integrations:UpdateResponsePlan' :: Maybe [Integration]
integrations = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:UpdateResponsePlan' :: Text
arn = Text
pArn_
    }

-- | The actions that this response plan takes at the beginning of an
-- incident.
updateResponsePlan_actions :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe [Action])
updateResponsePlan_actions :: Lens' UpdateResponsePlan (Maybe [Action])
updateResponsePlan_actions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe [Action]
actions :: Maybe [Action]
$sel:actions:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Action]
actions} -> Maybe [Action]
actions) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe [Action]
a -> UpdateResponsePlan
s {$sel:actions:UpdateResponsePlan' :: Maybe [Action]
actions = Maybe [Action]
a} :: UpdateResponsePlan) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Chatbot chat channel used for collaboration during an incident.
--
-- Use the empty structure to remove the chat channel from the response
-- plan.
updateResponsePlan_chatChannel :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe ChatChannel)
updateResponsePlan_chatChannel :: Lens' UpdateResponsePlan (Maybe ChatChannel)
updateResponsePlan_chatChannel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe ChatChannel
chatChannel :: Maybe ChatChannel
$sel:chatChannel:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe ChatChannel
chatChannel} -> Maybe ChatChannel
chatChannel) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe ChatChannel
a -> UpdateResponsePlan
s {$sel:chatChannel:UpdateResponsePlan' :: Maybe ChatChannel
chatChannel = Maybe ChatChannel
a} :: UpdateResponsePlan)

-- | A token ensuring that the operation is called only once with the
-- specified details.
updateResponsePlan_clientToken :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe Prelude.Text)
updateResponsePlan_clientToken :: Lens' UpdateResponsePlan (Maybe Text)
updateResponsePlan_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe Text
a -> UpdateResponsePlan
s {$sel:clientToken:UpdateResponsePlan' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateResponsePlan)

-- | The long format name of the response plan. The display name can\'t
-- contain spaces.
updateResponsePlan_displayName :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe Prelude.Text)
updateResponsePlan_displayName :: Lens' UpdateResponsePlan (Maybe Text)
updateResponsePlan_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe Text
displayName :: Maybe Text
$sel:displayName:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe Text
a -> UpdateResponsePlan
s {$sel:displayName:UpdateResponsePlan' :: Maybe Text
displayName = Maybe Text
a} :: UpdateResponsePlan)

-- | The Amazon Resource Name (ARN) for the contacts and escalation plans
-- that the response plan engages during an incident.
updateResponsePlan_engagements :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe [Prelude.Text])
updateResponsePlan_engagements :: Lens' UpdateResponsePlan (Maybe [Text])
updateResponsePlan_engagements = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe [Text]
engagements :: Maybe [Text]
$sel:engagements:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Text]
engagements} -> Maybe [Text]
engagements) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe [Text]
a -> UpdateResponsePlan
s {$sel:engagements:UpdateResponsePlan' :: Maybe [Text]
engagements = Maybe [Text]
a} :: UpdateResponsePlan) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The string Incident Manager uses to prevent duplicate incidents from
-- being created by the same incident in the same account.
updateResponsePlan_incidentTemplateDedupeString :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe Prelude.Text)
updateResponsePlan_incidentTemplateDedupeString :: Lens' UpdateResponsePlan (Maybe Text)
updateResponsePlan_incidentTemplateDedupeString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe Text
incidentTemplateDedupeString :: Maybe Text
$sel:incidentTemplateDedupeString:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
incidentTemplateDedupeString} -> Maybe Text
incidentTemplateDedupeString) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe Text
a -> UpdateResponsePlan
s {$sel:incidentTemplateDedupeString:UpdateResponsePlan' :: Maybe Text
incidentTemplateDedupeString = Maybe Text
a} :: UpdateResponsePlan)

-- | Defines the impact to the customers. Providing an impact overwrites the
-- impact provided by a response plan.
--
-- __Possible impacts:__
--
-- -   @5@ - Severe impact
--
-- -   @4@ - High impact
--
-- -   @3@ - Medium impact
--
-- -   @2@ - Low impact
--
-- -   @1@ - No impact
updateResponsePlan_incidentTemplateImpact :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe Prelude.Natural)
updateResponsePlan_incidentTemplateImpact :: Lens' UpdateResponsePlan (Maybe Natural)
updateResponsePlan_incidentTemplateImpact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe Natural
incidentTemplateImpact :: Maybe Natural
$sel:incidentTemplateImpact:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Natural
incidentTemplateImpact} -> Maybe Natural
incidentTemplateImpact) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe Natural
a -> UpdateResponsePlan
s {$sel:incidentTemplateImpact:UpdateResponsePlan' :: Maybe Natural
incidentTemplateImpact = Maybe Natural
a} :: UpdateResponsePlan)

-- | The Amazon SNS targets that are notified when updates are made to an
-- incident.
updateResponsePlan_incidentTemplateNotificationTargets :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe [NotificationTargetItem])
updateResponsePlan_incidentTemplateNotificationTargets :: Lens' UpdateResponsePlan (Maybe [NotificationTargetItem])
updateResponsePlan_incidentTemplateNotificationTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets :: Maybe [NotificationTargetItem]
$sel:incidentTemplateNotificationTargets:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets} -> Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe [NotificationTargetItem]
a -> UpdateResponsePlan
s {$sel:incidentTemplateNotificationTargets:UpdateResponsePlan' :: Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets = Maybe [NotificationTargetItem]
a} :: UpdateResponsePlan) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A brief summary of the incident. This typically contains what has
-- happened, what\'s currently happening, and next steps.
updateResponsePlan_incidentTemplateSummary :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe Prelude.Text)
updateResponsePlan_incidentTemplateSummary :: Lens' UpdateResponsePlan (Maybe Text)
updateResponsePlan_incidentTemplateSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe Text
incidentTemplateSummary :: Maybe Text
$sel:incidentTemplateSummary:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
incidentTemplateSummary} -> Maybe Text
incidentTemplateSummary) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe Text
a -> UpdateResponsePlan
s {$sel:incidentTemplateSummary:UpdateResponsePlan' :: Maybe Text
incidentTemplateSummary = Maybe Text
a} :: UpdateResponsePlan)

-- | Tags to assign to the template. When the @StartIncident@ API action is
-- called, Incident Manager assigns the tags specified in the template to
-- the incident. To call this action, you must also have permission to call
-- the @TagResource@ API action for the incident record resource.
updateResponsePlan_incidentTemplateTags :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateResponsePlan_incidentTemplateTags :: Lens' UpdateResponsePlan (Maybe (HashMap Text Text))
updateResponsePlan_incidentTemplateTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe (HashMap Text Text)
incidentTemplateTags :: Maybe (HashMap Text Text)
$sel:incidentTemplateTags:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe (HashMap Text Text)
incidentTemplateTags} -> Maybe (HashMap Text Text)
incidentTemplateTags) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe (HashMap Text Text)
a -> UpdateResponsePlan
s {$sel:incidentTemplateTags:UpdateResponsePlan' :: Maybe (HashMap Text Text)
incidentTemplateTags = Maybe (HashMap Text Text)
a} :: UpdateResponsePlan) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The short format name of the incident. The title can\'t contain spaces.
updateResponsePlan_incidentTemplateTitle :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe Prelude.Text)
updateResponsePlan_incidentTemplateTitle :: Lens' UpdateResponsePlan (Maybe Text)
updateResponsePlan_incidentTemplateTitle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe Text
incidentTemplateTitle :: Maybe Text
$sel:incidentTemplateTitle:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
incidentTemplateTitle} -> Maybe Text
incidentTemplateTitle) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe Text
a -> UpdateResponsePlan
s {$sel:incidentTemplateTitle:UpdateResponsePlan' :: Maybe Text
incidentTemplateTitle = Maybe Text
a} :: UpdateResponsePlan)

-- | Information about third-party services integrated into the response
-- plan.
updateResponsePlan_integrations :: Lens.Lens' UpdateResponsePlan (Prelude.Maybe [Integration])
updateResponsePlan_integrations :: Lens' UpdateResponsePlan (Maybe [Integration])
updateResponsePlan_integrations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Maybe [Integration]
integrations :: Maybe [Integration]
$sel:integrations:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Integration]
integrations} -> Maybe [Integration]
integrations) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Maybe [Integration]
a -> UpdateResponsePlan
s {$sel:integrations:UpdateResponsePlan' :: Maybe [Integration]
integrations = Maybe [Integration]
a} :: UpdateResponsePlan) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon Resource Name (ARN) of the response plan.
updateResponsePlan_arn :: Lens.Lens' UpdateResponsePlan Prelude.Text
updateResponsePlan_arn :: Lens' UpdateResponsePlan Text
updateResponsePlan_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlan' {Text
arn :: Text
$sel:arn:UpdateResponsePlan' :: UpdateResponsePlan -> Text
arn} -> Text
arn) (\s :: UpdateResponsePlan
s@UpdateResponsePlan' {} Text
a -> UpdateResponsePlan
s {$sel:arn:UpdateResponsePlan' :: Text
arn = Text
a} :: UpdateResponsePlan)

instance Core.AWSRequest UpdateResponsePlan where
  type
    AWSResponse UpdateResponsePlan =
      UpdateResponsePlanResponse
  request :: (Service -> Service)
-> UpdateResponsePlan -> Request UpdateResponsePlan
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateResponsePlan
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateResponsePlan)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateResponsePlanResponse
UpdateResponsePlanResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateResponsePlan where
  hashWithSalt :: Int -> UpdateResponsePlan -> Int
hashWithSalt Int
_salt UpdateResponsePlan' {Maybe Natural
Maybe [Text]
Maybe [NotificationTargetItem]
Maybe [Integration]
Maybe [Action]
Maybe Text
Maybe (HashMap Text Text)
Maybe ChatChannel
Text
arn :: Text
integrations :: Maybe [Integration]
incidentTemplateTitle :: Maybe Text
incidentTemplateTags :: Maybe (HashMap Text Text)
incidentTemplateSummary :: Maybe Text
incidentTemplateNotificationTargets :: Maybe [NotificationTargetItem]
incidentTemplateImpact :: Maybe Natural
incidentTemplateDedupeString :: Maybe Text
engagements :: Maybe [Text]
displayName :: Maybe Text
clientToken :: Maybe Text
chatChannel :: Maybe ChatChannel
actions :: Maybe [Action]
$sel:arn:UpdateResponsePlan' :: UpdateResponsePlan -> Text
$sel:integrations:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Integration]
$sel:incidentTemplateTitle:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:incidentTemplateTags:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe (HashMap Text Text)
$sel:incidentTemplateSummary:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:incidentTemplateNotificationTargets:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [NotificationTargetItem]
$sel:incidentTemplateImpact:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Natural
$sel:incidentTemplateDedupeString:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:engagements:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Text]
$sel:displayName:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:clientToken:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:chatChannel:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe ChatChannel
$sel:actions:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Action]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Action]
actions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChatChannel
chatChannel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
engagements
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
incidentTemplateDedupeString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
incidentTemplateImpact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
incidentTemplateSummary
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
incidentTemplateTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
incidentTemplateTitle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Integration]
integrations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData UpdateResponsePlan where
  rnf :: UpdateResponsePlan -> ()
rnf UpdateResponsePlan' {Maybe Natural
Maybe [Text]
Maybe [NotificationTargetItem]
Maybe [Integration]
Maybe [Action]
Maybe Text
Maybe (HashMap Text Text)
Maybe ChatChannel
Text
arn :: Text
integrations :: Maybe [Integration]
incidentTemplateTitle :: Maybe Text
incidentTemplateTags :: Maybe (HashMap Text Text)
incidentTemplateSummary :: Maybe Text
incidentTemplateNotificationTargets :: Maybe [NotificationTargetItem]
incidentTemplateImpact :: Maybe Natural
incidentTemplateDedupeString :: Maybe Text
engagements :: Maybe [Text]
displayName :: Maybe Text
clientToken :: Maybe Text
chatChannel :: Maybe ChatChannel
actions :: Maybe [Action]
$sel:arn:UpdateResponsePlan' :: UpdateResponsePlan -> Text
$sel:integrations:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Integration]
$sel:incidentTemplateTitle:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:incidentTemplateTags:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe (HashMap Text Text)
$sel:incidentTemplateSummary:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:incidentTemplateNotificationTargets:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [NotificationTargetItem]
$sel:incidentTemplateImpact:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Natural
$sel:incidentTemplateDedupeString:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:engagements:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Text]
$sel:displayName:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:clientToken:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:chatChannel:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe ChatChannel
$sel:actions:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Action]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Action]
actions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChatChannel
chatChannel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
engagements
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
incidentTemplateDedupeString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
incidentTemplateImpact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
incidentTemplateSummary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
incidentTemplateTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
incidentTemplateTitle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Integration]
integrations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn

instance Data.ToHeaders UpdateResponsePlan where
  toHeaders :: UpdateResponsePlan -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateResponsePlan where
  toJSON :: UpdateResponsePlan -> Value
toJSON UpdateResponsePlan' {Maybe Natural
Maybe [Text]
Maybe [NotificationTargetItem]
Maybe [Integration]
Maybe [Action]
Maybe Text
Maybe (HashMap Text Text)
Maybe ChatChannel
Text
arn :: Text
integrations :: Maybe [Integration]
incidentTemplateTitle :: Maybe Text
incidentTemplateTags :: Maybe (HashMap Text Text)
incidentTemplateSummary :: Maybe Text
incidentTemplateNotificationTargets :: Maybe [NotificationTargetItem]
incidentTemplateImpact :: Maybe Natural
incidentTemplateDedupeString :: Maybe Text
engagements :: Maybe [Text]
displayName :: Maybe Text
clientToken :: Maybe Text
chatChannel :: Maybe ChatChannel
actions :: Maybe [Action]
$sel:arn:UpdateResponsePlan' :: UpdateResponsePlan -> Text
$sel:integrations:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Integration]
$sel:incidentTemplateTitle:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:incidentTemplateTags:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe (HashMap Text Text)
$sel:incidentTemplateSummary:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:incidentTemplateNotificationTargets:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [NotificationTargetItem]
$sel:incidentTemplateImpact:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Natural
$sel:incidentTemplateDedupeString:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:engagements:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Text]
$sel:displayName:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:clientToken:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe Text
$sel:chatChannel:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe ChatChannel
$sel:actions:UpdateResponsePlan' :: UpdateResponsePlan -> Maybe [Action]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"actions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Action]
actions,
            (Key
"chatChannel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ChatChannel
chatChannel,
            (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            (Key
"displayName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
displayName,
            (Key
"engagements" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
engagements,
            (Key
"incidentTemplateDedupeString" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
incidentTemplateDedupeString,
            (Key
"incidentTemplateImpact" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
incidentTemplateImpact,
            (Key
"incidentTemplateNotificationTargets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [NotificationTargetItem]
incidentTemplateNotificationTargets,
            (Key
"incidentTemplateSummary" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
incidentTemplateSummary,
            (Key
"incidentTemplateTags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
incidentTemplateTags,
            (Key
"incidentTemplateTitle" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
incidentTemplateTitle,
            (Key
"integrations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Integration]
integrations,
            forall a. a -> Maybe a
Prelude.Just (Key
"arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn)
          ]
      )

instance Data.ToPath UpdateResponsePlan where
  toPath :: UpdateResponsePlan -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/updateResponsePlan"

instance Data.ToQuery UpdateResponsePlan where
  toQuery :: UpdateResponsePlan -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateResponsePlanResponse' smart constructor.
data UpdateResponsePlanResponse = UpdateResponsePlanResponse'
  { -- | The response's http status code.
    UpdateResponsePlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateResponsePlanResponse -> UpdateResponsePlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateResponsePlanResponse -> UpdateResponsePlanResponse -> Bool
$c/= :: UpdateResponsePlanResponse -> UpdateResponsePlanResponse -> Bool
== :: UpdateResponsePlanResponse -> UpdateResponsePlanResponse -> Bool
$c== :: UpdateResponsePlanResponse -> UpdateResponsePlanResponse -> Bool
Prelude.Eq, ReadPrec [UpdateResponsePlanResponse]
ReadPrec UpdateResponsePlanResponse
Int -> ReadS UpdateResponsePlanResponse
ReadS [UpdateResponsePlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateResponsePlanResponse]
$creadListPrec :: ReadPrec [UpdateResponsePlanResponse]
readPrec :: ReadPrec UpdateResponsePlanResponse
$creadPrec :: ReadPrec UpdateResponsePlanResponse
readList :: ReadS [UpdateResponsePlanResponse]
$creadList :: ReadS [UpdateResponsePlanResponse]
readsPrec :: Int -> ReadS UpdateResponsePlanResponse
$creadsPrec :: Int -> ReadS UpdateResponsePlanResponse
Prelude.Read, Int -> UpdateResponsePlanResponse -> ShowS
[UpdateResponsePlanResponse] -> ShowS
UpdateResponsePlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateResponsePlanResponse] -> ShowS
$cshowList :: [UpdateResponsePlanResponse] -> ShowS
show :: UpdateResponsePlanResponse -> String
$cshow :: UpdateResponsePlanResponse -> String
showsPrec :: Int -> UpdateResponsePlanResponse -> ShowS
$cshowsPrec :: Int -> UpdateResponsePlanResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateResponsePlanResponse x -> UpdateResponsePlanResponse
forall x.
UpdateResponsePlanResponse -> Rep UpdateResponsePlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateResponsePlanResponse x -> UpdateResponsePlanResponse
$cfrom :: forall x.
UpdateResponsePlanResponse -> Rep UpdateResponsePlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateResponsePlanResponse' 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:
--
-- 'httpStatus', 'updateResponsePlanResponse_httpStatus' - The response's http status code.
newUpdateResponsePlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateResponsePlanResponse
newUpdateResponsePlanResponse :: Int -> UpdateResponsePlanResponse
newUpdateResponsePlanResponse Int
pHttpStatus_ =
  UpdateResponsePlanResponse'
    { $sel:httpStatus:UpdateResponsePlanResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

-- | The response's http status code.
updateResponsePlanResponse_httpStatus :: Lens.Lens' UpdateResponsePlanResponse Prelude.Int
updateResponsePlanResponse_httpStatus :: Lens' UpdateResponsePlanResponse Int
updateResponsePlanResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResponsePlanResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateResponsePlanResponse' :: UpdateResponsePlanResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateResponsePlanResponse
s@UpdateResponsePlanResponse' {} Int
a -> UpdateResponsePlanResponse
s {$sel:httpStatus:UpdateResponsePlanResponse' :: Int
httpStatus = Int
a} :: UpdateResponsePlanResponse)

instance Prelude.NFData UpdateResponsePlanResponse where
  rnf :: UpdateResponsePlanResponse -> ()
rnf UpdateResponsePlanResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateResponsePlanResponse' :: UpdateResponsePlanResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus