{-# 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.CreateResponsePlan
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a response plan that automates the initial response to
-- incidents. A response plan engages contacts, starts chat channel
-- collaboration, and initiates runbooks at the beginning of an incident.
module Amazonka.SSMIncidents.CreateResponsePlan
  ( -- * Creating a Request
    CreateResponsePlan (..),
    newCreateResponsePlan,

    -- * Request Lenses
    createResponsePlan_actions,
    createResponsePlan_chatChannel,
    createResponsePlan_clientToken,
    createResponsePlan_displayName,
    createResponsePlan_engagements,
    createResponsePlan_integrations,
    createResponsePlan_tags,
    createResponsePlan_incidentTemplate,
    createResponsePlan_name,

    -- * Destructuring the Response
    CreateResponsePlanResponse (..),
    newCreateResponsePlanResponse,

    -- * Response Lenses
    createResponsePlanResponse_httpStatus,
    createResponsePlanResponse_arn,
  )
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:/ 'newCreateResponsePlan' smart constructor.
data CreateResponsePlan = CreateResponsePlan'
  { -- | The actions that the response plan starts at the beginning of an
    -- incident.
    CreateResponsePlan -> Maybe [Action]
actions :: Prelude.Maybe [Action],
    -- | The Chatbot chat channel used for collaboration during an incident.
    CreateResponsePlan -> Maybe ChatChannel
chatChannel :: Prelude.Maybe ChatChannel,
    -- | A token ensuring that the operation is called only once with the
    -- specified details.
    CreateResponsePlan -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The long format of the response plan name. This field can contain
    -- spaces.
    CreateResponsePlan -> 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.
    CreateResponsePlan -> Maybe [Text]
engagements :: Prelude.Maybe [Prelude.Text],
    -- | Information about third-party services integrated into the response
    -- plan.
    CreateResponsePlan -> Maybe [Integration]
integrations :: Prelude.Maybe [Integration],
    -- | A list of tags that you are adding to the response plan.
    CreateResponsePlan -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Details used to create an incident when using this response plan.
    CreateResponsePlan -> IncidentTemplate
incidentTemplate :: IncidentTemplate,
    -- | The short format name of the response plan. Can\'t include spaces.
    CreateResponsePlan -> Text
name :: Prelude.Text
  }
  deriving (CreateResponsePlan -> CreateResponsePlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateResponsePlan -> CreateResponsePlan -> Bool
$c/= :: CreateResponsePlan -> CreateResponsePlan -> Bool
== :: CreateResponsePlan -> CreateResponsePlan -> Bool
$c== :: CreateResponsePlan -> CreateResponsePlan -> Bool
Prelude.Eq, ReadPrec [CreateResponsePlan]
ReadPrec CreateResponsePlan
Int -> ReadS CreateResponsePlan
ReadS [CreateResponsePlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateResponsePlan]
$creadListPrec :: ReadPrec [CreateResponsePlan]
readPrec :: ReadPrec CreateResponsePlan
$creadPrec :: ReadPrec CreateResponsePlan
readList :: ReadS [CreateResponsePlan]
$creadList :: ReadS [CreateResponsePlan]
readsPrec :: Int -> ReadS CreateResponsePlan
$creadsPrec :: Int -> ReadS CreateResponsePlan
Prelude.Read, Int -> CreateResponsePlan -> ShowS
[CreateResponsePlan] -> ShowS
CreateResponsePlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateResponsePlan] -> ShowS
$cshowList :: [CreateResponsePlan] -> ShowS
show :: CreateResponsePlan -> String
$cshow :: CreateResponsePlan -> String
showsPrec :: Int -> CreateResponsePlan -> ShowS
$cshowsPrec :: Int -> CreateResponsePlan -> ShowS
Prelude.Show, forall x. Rep CreateResponsePlan x -> CreateResponsePlan
forall x. CreateResponsePlan -> Rep CreateResponsePlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateResponsePlan x -> CreateResponsePlan
$cfrom :: forall x. CreateResponsePlan -> Rep CreateResponsePlan x
Prelude.Generic)

-- |
-- Create a value of 'CreateResponsePlan' 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', 'createResponsePlan_actions' - The actions that the response plan starts at the beginning of an
-- incident.
--
-- 'chatChannel', 'createResponsePlan_chatChannel' - The Chatbot chat channel used for collaboration during an incident.
--
-- 'clientToken', 'createResponsePlan_clientToken' - A token ensuring that the operation is called only once with the
-- specified details.
--
-- 'displayName', 'createResponsePlan_displayName' - The long format of the response plan name. This field can contain
-- spaces.
--
-- 'engagements', 'createResponsePlan_engagements' - The Amazon Resource Name (ARN) for the contacts and escalation plans
-- that the response plan engages during an incident.
--
-- 'integrations', 'createResponsePlan_integrations' - Information about third-party services integrated into the response
-- plan.
--
-- 'tags', 'createResponsePlan_tags' - A list of tags that you are adding to the response plan.
--
-- 'incidentTemplate', 'createResponsePlan_incidentTemplate' - Details used to create an incident when using this response plan.
--
-- 'name', 'createResponsePlan_name' - The short format name of the response plan. Can\'t include spaces.
newCreateResponsePlan ::
  -- | 'incidentTemplate'
  IncidentTemplate ->
  -- | 'name'
  Prelude.Text ->
  CreateResponsePlan
newCreateResponsePlan :: IncidentTemplate -> Text -> CreateResponsePlan
newCreateResponsePlan IncidentTemplate
pIncidentTemplate_ Text
pName_ =
  CreateResponsePlan'
    { $sel:actions:CreateResponsePlan' :: Maybe [Action]
actions = forall a. Maybe a
Prelude.Nothing,
      $sel:chatChannel:CreateResponsePlan' :: Maybe ChatChannel
chatChannel = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateResponsePlan' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:CreateResponsePlan' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:engagements:CreateResponsePlan' :: Maybe [Text]
engagements = forall a. Maybe a
Prelude.Nothing,
      $sel:integrations:CreateResponsePlan' :: Maybe [Integration]
integrations = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateResponsePlan' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:incidentTemplate:CreateResponsePlan' :: IncidentTemplate
incidentTemplate = IncidentTemplate
pIncidentTemplate_,
      $sel:name:CreateResponsePlan' :: Text
name = Text
pName_
    }

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

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

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

-- | The Amazon Resource Name (ARN) for the contacts and escalation plans
-- that the response plan engages during an incident.
createResponsePlan_engagements :: Lens.Lens' CreateResponsePlan (Prelude.Maybe [Prelude.Text])
createResponsePlan_engagements :: Lens' CreateResponsePlan (Maybe [Text])
createResponsePlan_engagements = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResponsePlan' {Maybe [Text]
engagements :: Maybe [Text]
$sel:engagements:CreateResponsePlan' :: CreateResponsePlan -> Maybe [Text]
engagements} -> Maybe [Text]
engagements) (\s :: CreateResponsePlan
s@CreateResponsePlan' {} Maybe [Text]
a -> CreateResponsePlan
s {$sel:engagements:CreateResponsePlan' :: Maybe [Text]
engagements = Maybe [Text]
a} :: CreateResponsePlan) 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 response
-- plan.
createResponsePlan_integrations :: Lens.Lens' CreateResponsePlan (Prelude.Maybe [Integration])
createResponsePlan_integrations :: Lens' CreateResponsePlan (Maybe [Integration])
createResponsePlan_integrations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResponsePlan' {Maybe [Integration]
integrations :: Maybe [Integration]
$sel:integrations:CreateResponsePlan' :: CreateResponsePlan -> Maybe [Integration]
integrations} -> Maybe [Integration]
integrations) (\s :: CreateResponsePlan
s@CreateResponsePlan' {} Maybe [Integration]
a -> CreateResponsePlan
s {$sel:integrations:CreateResponsePlan' :: Maybe [Integration]
integrations = Maybe [Integration]
a} :: CreateResponsePlan) 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 list of tags that you are adding to the response plan.
createResponsePlan_tags :: Lens.Lens' CreateResponsePlan (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createResponsePlan_tags :: Lens' CreateResponsePlan (Maybe (HashMap Text Text))
createResponsePlan_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResponsePlan' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateResponsePlan' :: CreateResponsePlan -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateResponsePlan
s@CreateResponsePlan' {} Maybe (HashMap Text Text)
a -> CreateResponsePlan
s {$sel:tags:CreateResponsePlan' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateResponsePlan) 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

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

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

instance Core.AWSRequest CreateResponsePlan where
  type
    AWSResponse CreateResponsePlan =
      CreateResponsePlanResponse
  request :: (Service -> Service)
-> CreateResponsePlan -> Request CreateResponsePlan
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 CreateResponsePlan
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateResponsePlan)))
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 ->
          Int -> Text -> CreateResponsePlanResponse
CreateResponsePlanResponse'
            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))
            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")
      )

instance Prelude.Hashable CreateResponsePlan where
  hashWithSalt :: Int -> CreateResponsePlan -> Int
hashWithSalt Int
_salt CreateResponsePlan' {Maybe [Text]
Maybe [Integration]
Maybe [Action]
Maybe Text
Maybe (HashMap Text Text)
Maybe ChatChannel
Text
IncidentTemplate
name :: Text
incidentTemplate :: IncidentTemplate
tags :: Maybe (HashMap Text Text)
integrations :: Maybe [Integration]
engagements :: Maybe [Text]
displayName :: Maybe Text
clientToken :: Maybe Text
chatChannel :: Maybe ChatChannel
actions :: Maybe [Action]
$sel:name:CreateResponsePlan' :: CreateResponsePlan -> Text
$sel:incidentTemplate:CreateResponsePlan' :: CreateResponsePlan -> IncidentTemplate
$sel:tags:CreateResponsePlan' :: CreateResponsePlan -> Maybe (HashMap Text Text)
$sel:integrations:CreateResponsePlan' :: CreateResponsePlan -> Maybe [Integration]
$sel:engagements:CreateResponsePlan' :: CreateResponsePlan -> Maybe [Text]
$sel:displayName:CreateResponsePlan' :: CreateResponsePlan -> Maybe Text
$sel:clientToken:CreateResponsePlan' :: CreateResponsePlan -> Maybe Text
$sel:chatChannel:CreateResponsePlan' :: CreateResponsePlan -> Maybe ChatChannel
$sel:actions:CreateResponsePlan' :: CreateResponsePlan -> 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 [Integration]
integrations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IncidentTemplate
incidentTemplate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

instance Data.ToHeaders CreateResponsePlan where
  toHeaders :: CreateResponsePlan -> 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 CreateResponsePlan where
  toJSON :: CreateResponsePlan -> Value
toJSON CreateResponsePlan' {Maybe [Text]
Maybe [Integration]
Maybe [Action]
Maybe Text
Maybe (HashMap Text Text)
Maybe ChatChannel
Text
IncidentTemplate
name :: Text
incidentTemplate :: IncidentTemplate
tags :: Maybe (HashMap Text Text)
integrations :: Maybe [Integration]
engagements :: Maybe [Text]
displayName :: Maybe Text
clientToken :: Maybe Text
chatChannel :: Maybe ChatChannel
actions :: Maybe [Action]
$sel:name:CreateResponsePlan' :: CreateResponsePlan -> Text
$sel:incidentTemplate:CreateResponsePlan' :: CreateResponsePlan -> IncidentTemplate
$sel:tags:CreateResponsePlan' :: CreateResponsePlan -> Maybe (HashMap Text Text)
$sel:integrations:CreateResponsePlan' :: CreateResponsePlan -> Maybe [Integration]
$sel:engagements:CreateResponsePlan' :: CreateResponsePlan -> Maybe [Text]
$sel:displayName:CreateResponsePlan' :: CreateResponsePlan -> Maybe Text
$sel:clientToken:CreateResponsePlan' :: CreateResponsePlan -> Maybe Text
$sel:chatChannel:CreateResponsePlan' :: CreateResponsePlan -> Maybe ChatChannel
$sel:actions:CreateResponsePlan' :: CreateResponsePlan -> 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
"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,
            (Key
"tags" 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)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"incidentTemplate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IncidentTemplate
incidentTemplate),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateResponsePlanResponse' 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', 'createResponsePlanResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'createResponsePlanResponse_arn' - The Amazon Resource Name (ARN) of the response plan.
newCreateResponsePlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  CreateResponsePlanResponse
newCreateResponsePlanResponse :: Int -> Text -> CreateResponsePlanResponse
newCreateResponsePlanResponse Int
pHttpStatus_ Text
pArn_ =
  CreateResponsePlanResponse'
    { $sel:httpStatus:CreateResponsePlanResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:arn:CreateResponsePlanResponse' :: Text
arn = Text
pArn_
    }

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

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

instance Prelude.NFData CreateResponsePlanResponse where
  rnf :: CreateResponsePlanResponse -> ()
rnf CreateResponsePlanResponse' {Int
Text
arn :: Text
httpStatus :: Int
$sel:arn:CreateResponsePlanResponse' :: CreateResponsePlanResponse -> Text
$sel:httpStatus:CreateResponsePlanResponse' :: CreateResponsePlanResponse -> Int
..} =
    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