{-# 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.GetResponsePlan
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the details of the specified response plan.
module Amazonka.SSMIncidents.GetResponsePlan
  ( -- * Creating a Request
    GetResponsePlan (..),
    newGetResponsePlan,

    -- * Request Lenses
    getResponsePlan_arn,

    -- * Destructuring the Response
    GetResponsePlanResponse (..),
    newGetResponsePlanResponse,

    -- * Response Lenses
    getResponsePlanResponse_actions,
    getResponsePlanResponse_chatChannel,
    getResponsePlanResponse_displayName,
    getResponsePlanResponse_engagements,
    getResponsePlanResponse_integrations,
    getResponsePlanResponse_httpStatus,
    getResponsePlanResponse_arn,
    getResponsePlanResponse_incidentTemplate,
    getResponsePlanResponse_name,
  )
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:/ 'newGetResponsePlan' smart constructor.
data GetResponsePlan = GetResponsePlan'
  { -- | The Amazon Resource Name (ARN) of the response plan.
    GetResponsePlan -> Text
arn :: Prelude.Text
  }
  deriving (GetResponsePlan -> GetResponsePlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetResponsePlan -> GetResponsePlan -> Bool
$c/= :: GetResponsePlan -> GetResponsePlan -> Bool
== :: GetResponsePlan -> GetResponsePlan -> Bool
$c== :: GetResponsePlan -> GetResponsePlan -> Bool
Prelude.Eq, ReadPrec [GetResponsePlan]
ReadPrec GetResponsePlan
Int -> ReadS GetResponsePlan
ReadS [GetResponsePlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetResponsePlan]
$creadListPrec :: ReadPrec [GetResponsePlan]
readPrec :: ReadPrec GetResponsePlan
$creadPrec :: ReadPrec GetResponsePlan
readList :: ReadS [GetResponsePlan]
$creadList :: ReadS [GetResponsePlan]
readsPrec :: Int -> ReadS GetResponsePlan
$creadsPrec :: Int -> ReadS GetResponsePlan
Prelude.Read, Int -> GetResponsePlan -> ShowS
[GetResponsePlan] -> ShowS
GetResponsePlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetResponsePlan] -> ShowS
$cshowList :: [GetResponsePlan] -> ShowS
show :: GetResponsePlan -> String
$cshow :: GetResponsePlan -> String
showsPrec :: Int -> GetResponsePlan -> ShowS
$cshowsPrec :: Int -> GetResponsePlan -> ShowS
Prelude.Show, forall x. Rep GetResponsePlan x -> GetResponsePlan
forall x. GetResponsePlan -> Rep GetResponsePlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetResponsePlan x -> GetResponsePlan
$cfrom :: forall x. GetResponsePlan -> Rep GetResponsePlan x
Prelude.Generic)

-- |
-- Create a value of 'GetResponsePlan' 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:
--
-- 'arn', 'getResponsePlan_arn' - The Amazon Resource Name (ARN) of the response plan.
newGetResponsePlan ::
  -- | 'arn'
  Prelude.Text ->
  GetResponsePlan
newGetResponsePlan :: Text -> GetResponsePlan
newGetResponsePlan Text
pArn_ =
  GetResponsePlan' {$sel:arn:GetResponsePlan' :: Text
arn = Text
pArn_}

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

instance Core.AWSRequest GetResponsePlan where
  type
    AWSResponse GetResponsePlan =
      GetResponsePlanResponse
  request :: (Service -> Service) -> GetResponsePlan -> Request GetResponsePlan
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetResponsePlan
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetResponsePlan)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [Action]
-> Maybe ChatChannel
-> Maybe Text
-> Maybe [Text]
-> Maybe [Integration]
-> Int
-> Text
-> IncidentTemplate
-> Text
-> GetResponsePlanResponse
GetResponsePlanResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"actions" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"chatChannel")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"displayName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"engagements" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"integrations" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"incidentTemplate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"name")
      )

instance Prelude.Hashable GetResponsePlan where
  hashWithSalt :: Int -> GetResponsePlan -> Int
hashWithSalt Int
_salt GetResponsePlan' {Text
arn :: Text
$sel:arn:GetResponsePlan' :: GetResponsePlan -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData GetResponsePlan where
  rnf :: GetResponsePlan -> ()
rnf GetResponsePlan' {Text
arn :: Text
$sel:arn:GetResponsePlan' :: GetResponsePlan -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
arn

instance Data.ToHeaders GetResponsePlan where
  toHeaders :: GetResponsePlan -> 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.ToPath GetResponsePlan where
  toPath :: GetResponsePlan -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/getResponsePlan"

instance Data.ToQuery GetResponsePlan where
  toQuery :: GetResponsePlan -> QueryString
toQuery GetResponsePlan' {Text
arn :: Text
$sel:arn:GetResponsePlan' :: GetResponsePlan -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"arn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
arn]

-- | /See:/ 'newGetResponsePlanResponse' smart constructor.
data GetResponsePlanResponse = GetResponsePlanResponse'
  { -- | The actions that this response plan takes at the beginning of the
    -- incident.
    GetResponsePlanResponse -> Maybe [Action]
actions :: Prelude.Maybe [Action],
    -- | The Chatbot chat channel used for collaboration during an incident.
    GetResponsePlanResponse -> Maybe ChatChannel
chatChannel :: Prelude.Maybe ChatChannel,
    -- | The long format name of the response plan. Can contain spaces.
    GetResponsePlanResponse -> 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.
    GetResponsePlanResponse -> Maybe [Text]
engagements :: Prelude.Maybe [Prelude.Text],
    -- | Information about third-party services integrated into the Incident
    -- Manager response plan.
    GetResponsePlanResponse -> Maybe [Integration]
integrations :: Prelude.Maybe [Integration],
    -- | The response's http status code.
    GetResponsePlanResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ARN of the response plan.
    GetResponsePlanResponse -> Text
arn :: Prelude.Text,
    -- | Details used to create the incident when using this response plan.
    GetResponsePlanResponse -> IncidentTemplate
incidentTemplate :: IncidentTemplate,
    -- | The short format name of the response plan. The name can\'t contain
    -- spaces.
    GetResponsePlanResponse -> Text
name :: Prelude.Text
  }
  deriving (GetResponsePlanResponse -> GetResponsePlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetResponsePlanResponse -> GetResponsePlanResponse -> Bool
$c/= :: GetResponsePlanResponse -> GetResponsePlanResponse -> Bool
== :: GetResponsePlanResponse -> GetResponsePlanResponse -> Bool
$c== :: GetResponsePlanResponse -> GetResponsePlanResponse -> Bool
Prelude.Eq, ReadPrec [GetResponsePlanResponse]
ReadPrec GetResponsePlanResponse
Int -> ReadS GetResponsePlanResponse
ReadS [GetResponsePlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetResponsePlanResponse]
$creadListPrec :: ReadPrec [GetResponsePlanResponse]
readPrec :: ReadPrec GetResponsePlanResponse
$creadPrec :: ReadPrec GetResponsePlanResponse
readList :: ReadS [GetResponsePlanResponse]
$creadList :: ReadS [GetResponsePlanResponse]
readsPrec :: Int -> ReadS GetResponsePlanResponse
$creadsPrec :: Int -> ReadS GetResponsePlanResponse
Prelude.Read, Int -> GetResponsePlanResponse -> ShowS
[GetResponsePlanResponse] -> ShowS
GetResponsePlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetResponsePlanResponse] -> ShowS
$cshowList :: [GetResponsePlanResponse] -> ShowS
show :: GetResponsePlanResponse -> String
$cshow :: GetResponsePlanResponse -> String
showsPrec :: Int -> GetResponsePlanResponse -> ShowS
$cshowsPrec :: Int -> GetResponsePlanResponse -> ShowS
Prelude.Show, forall x. Rep GetResponsePlanResponse x -> GetResponsePlanResponse
forall x. GetResponsePlanResponse -> Rep GetResponsePlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetResponsePlanResponse x -> GetResponsePlanResponse
$cfrom :: forall x. GetResponsePlanResponse -> Rep GetResponsePlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetResponsePlanResponse' 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', 'getResponsePlanResponse_actions' - The actions that this response plan takes at the beginning of the
-- incident.
--
-- 'chatChannel', 'getResponsePlanResponse_chatChannel' - The Chatbot chat channel used for collaboration during an incident.
--
-- 'displayName', 'getResponsePlanResponse_displayName' - The long format name of the response plan. Can contain spaces.
--
-- 'engagements', 'getResponsePlanResponse_engagements' - The Amazon Resource Name (ARN) for the contacts and escalation plans
-- that the response plan engages during an incident.
--
-- 'integrations', 'getResponsePlanResponse_integrations' - Information about third-party services integrated into the Incident
-- Manager response plan.
--
-- 'httpStatus', 'getResponsePlanResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'getResponsePlanResponse_arn' - The ARN of the response plan.
--
-- 'incidentTemplate', 'getResponsePlanResponse_incidentTemplate' - Details used to create the incident when using this response plan.
--
-- 'name', 'getResponsePlanResponse_name' - The short format name of the response plan. The name can\'t contain
-- spaces.
newGetResponsePlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'incidentTemplate'
  IncidentTemplate ->
  -- | 'name'
  Prelude.Text ->
  GetResponsePlanResponse
newGetResponsePlanResponse :: Int -> Text -> IncidentTemplate -> Text -> GetResponsePlanResponse
newGetResponsePlanResponse
  Int
pHttpStatus_
  Text
pArn_
  IncidentTemplate
pIncidentTemplate_
  Text
pName_ =
    GetResponsePlanResponse'
      { $sel:actions:GetResponsePlanResponse' :: Maybe [Action]
actions = forall a. Maybe a
Prelude.Nothing,
        $sel:chatChannel:GetResponsePlanResponse' :: Maybe ChatChannel
chatChannel = forall a. Maybe a
Prelude.Nothing,
        $sel:displayName:GetResponsePlanResponse' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
        $sel:engagements:GetResponsePlanResponse' :: Maybe [Text]
engagements = forall a. Maybe a
Prelude.Nothing,
        $sel:integrations:GetResponsePlanResponse' :: Maybe [Integration]
integrations = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetResponsePlanResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:arn:GetResponsePlanResponse' :: Text
arn = Text
pArn_,
        $sel:incidentTemplate:GetResponsePlanResponse' :: IncidentTemplate
incidentTemplate = IncidentTemplate
pIncidentTemplate_,
        $sel:name:GetResponsePlanResponse' :: Text
name = Text
pName_
      }

-- | The actions that this response plan takes at the beginning of the
-- incident.
getResponsePlanResponse_actions :: Lens.Lens' GetResponsePlanResponse (Prelude.Maybe [Action])
getResponsePlanResponse_actions :: Lens' GetResponsePlanResponse (Maybe [Action])
getResponsePlanResponse_actions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResponsePlanResponse' {Maybe [Action]
actions :: Maybe [Action]
$sel:actions:GetResponsePlanResponse' :: GetResponsePlanResponse -> Maybe [Action]
actions} -> Maybe [Action]
actions) (\s :: GetResponsePlanResponse
s@GetResponsePlanResponse' {} Maybe [Action]
a -> GetResponsePlanResponse
s {$sel:actions:GetResponsePlanResponse' :: Maybe [Action]
actions = Maybe [Action]
a} :: GetResponsePlanResponse) 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.
getResponsePlanResponse_chatChannel :: Lens.Lens' GetResponsePlanResponse (Prelude.Maybe ChatChannel)
getResponsePlanResponse_chatChannel :: Lens' GetResponsePlanResponse (Maybe ChatChannel)
getResponsePlanResponse_chatChannel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResponsePlanResponse' {Maybe ChatChannel
chatChannel :: Maybe ChatChannel
$sel:chatChannel:GetResponsePlanResponse' :: GetResponsePlanResponse -> Maybe ChatChannel
chatChannel} -> Maybe ChatChannel
chatChannel) (\s :: GetResponsePlanResponse
s@GetResponsePlanResponse' {} Maybe ChatChannel
a -> GetResponsePlanResponse
s {$sel:chatChannel:GetResponsePlanResponse' :: Maybe ChatChannel
chatChannel = Maybe ChatChannel
a} :: GetResponsePlanResponse)

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

-- | The Amazon Resource Name (ARN) for the contacts and escalation plans
-- that the response plan engages during an incident.
getResponsePlanResponse_engagements :: Lens.Lens' GetResponsePlanResponse (Prelude.Maybe [Prelude.Text])
getResponsePlanResponse_engagements :: Lens' GetResponsePlanResponse (Maybe [Text])
getResponsePlanResponse_engagements = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResponsePlanResponse' {Maybe [Text]
engagements :: Maybe [Text]
$sel:engagements:GetResponsePlanResponse' :: GetResponsePlanResponse -> Maybe [Text]
engagements} -> Maybe [Text]
engagements) (\s :: GetResponsePlanResponse
s@GetResponsePlanResponse' {} Maybe [Text]
a -> GetResponsePlanResponse
s {$sel:engagements:GetResponsePlanResponse' :: Maybe [Text]
engagements = Maybe [Text]
a} :: GetResponsePlanResponse) 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

-- | Information about third-party services integrated into the Incident
-- Manager response plan.
getResponsePlanResponse_integrations :: Lens.Lens' GetResponsePlanResponse (Prelude.Maybe [Integration])
getResponsePlanResponse_integrations :: Lens' GetResponsePlanResponse (Maybe [Integration])
getResponsePlanResponse_integrations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResponsePlanResponse' {Maybe [Integration]
integrations :: Maybe [Integration]
$sel:integrations:GetResponsePlanResponse' :: GetResponsePlanResponse -> Maybe [Integration]
integrations} -> Maybe [Integration]
integrations) (\s :: GetResponsePlanResponse
s@GetResponsePlanResponse' {} Maybe [Integration]
a -> GetResponsePlanResponse
s {$sel:integrations:GetResponsePlanResponse' :: Maybe [Integration]
integrations = Maybe [Integration]
a} :: GetResponsePlanResponse) 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 response's http status code.
getResponsePlanResponse_httpStatus :: Lens.Lens' GetResponsePlanResponse Prelude.Int
getResponsePlanResponse_httpStatus :: Lens' GetResponsePlanResponse Int
getResponsePlanResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResponsePlanResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetResponsePlanResponse' :: GetResponsePlanResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetResponsePlanResponse
s@GetResponsePlanResponse' {} Int
a -> GetResponsePlanResponse
s {$sel:httpStatus:GetResponsePlanResponse' :: Int
httpStatus = Int
a} :: GetResponsePlanResponse)

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

-- | Details used to create the incident when using this response plan.
getResponsePlanResponse_incidentTemplate :: Lens.Lens' GetResponsePlanResponse IncidentTemplate
getResponsePlanResponse_incidentTemplate :: Lens' GetResponsePlanResponse IncidentTemplate
getResponsePlanResponse_incidentTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResponsePlanResponse' {IncidentTemplate
incidentTemplate :: IncidentTemplate
$sel:incidentTemplate:GetResponsePlanResponse' :: GetResponsePlanResponse -> IncidentTemplate
incidentTemplate} -> IncidentTemplate
incidentTemplate) (\s :: GetResponsePlanResponse
s@GetResponsePlanResponse' {} IncidentTemplate
a -> GetResponsePlanResponse
s {$sel:incidentTemplate:GetResponsePlanResponse' :: IncidentTemplate
incidentTemplate = IncidentTemplate
a} :: GetResponsePlanResponse)

-- | The short format name of the response plan. The name can\'t contain
-- spaces.
getResponsePlanResponse_name :: Lens.Lens' GetResponsePlanResponse Prelude.Text
getResponsePlanResponse_name :: Lens' GetResponsePlanResponse Text
getResponsePlanResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResponsePlanResponse' {Text
name :: Text
$sel:name:GetResponsePlanResponse' :: GetResponsePlanResponse -> Text
name} -> Text
name) (\s :: GetResponsePlanResponse
s@GetResponsePlanResponse' {} Text
a -> GetResponsePlanResponse
s {$sel:name:GetResponsePlanResponse' :: Text
name = Text
a} :: GetResponsePlanResponse)

instance Prelude.NFData GetResponsePlanResponse where
  rnf :: GetResponsePlanResponse -> ()
rnf GetResponsePlanResponse' {Int
Maybe [Text]
Maybe [Integration]
Maybe [Action]
Maybe Text
Maybe ChatChannel
Text
IncidentTemplate
name :: Text
incidentTemplate :: IncidentTemplate
arn :: Text
httpStatus :: Int
integrations :: Maybe [Integration]
engagements :: Maybe [Text]
displayName :: Maybe Text
chatChannel :: Maybe ChatChannel
actions :: Maybe [Action]
$sel:name:GetResponsePlanResponse' :: GetResponsePlanResponse -> Text
$sel:incidentTemplate:GetResponsePlanResponse' :: GetResponsePlanResponse -> IncidentTemplate
$sel:arn:GetResponsePlanResponse' :: GetResponsePlanResponse -> Text
$sel:httpStatus:GetResponsePlanResponse' :: GetResponsePlanResponse -> Int
$sel:integrations:GetResponsePlanResponse' :: GetResponsePlanResponse -> Maybe [Integration]
$sel:engagements:GetResponsePlanResponse' :: GetResponsePlanResponse -> Maybe [Text]
$sel:displayName:GetResponsePlanResponse' :: GetResponsePlanResponse -> Maybe Text
$sel:chatChannel:GetResponsePlanResponse' :: GetResponsePlanResponse -> Maybe ChatChannel
$sel:actions:GetResponsePlanResponse' :: GetResponsePlanResponse -> 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
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 [Integration]
integrations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IncidentTemplate
incidentTemplate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name