{-# 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.ServiceCatalog.CreateProvisionedProductPlan
-- 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 plan.
--
-- A plan includes the list of resources to be created (when provisioning a
-- new product) or modified (when updating a provisioned product) when the
-- plan is executed.
--
-- You can create one plan for each provisioned product. To create a plan
-- for an existing provisioned product, the product status must be
-- AVAILABLE or TAINTED.
--
-- To view the resource changes in the change set, use
-- DescribeProvisionedProductPlan. To create or modify the provisioned
-- product, use ExecuteProvisionedProductPlan.
module Amazonka.ServiceCatalog.CreateProvisionedProductPlan
  ( -- * Creating a Request
    CreateProvisionedProductPlan (..),
    newCreateProvisionedProductPlan,

    -- * Request Lenses
    createProvisionedProductPlan_acceptLanguage,
    createProvisionedProductPlan_notificationArns,
    createProvisionedProductPlan_pathId,
    createProvisionedProductPlan_provisioningParameters,
    createProvisionedProductPlan_tags,
    createProvisionedProductPlan_planName,
    createProvisionedProductPlan_planType,
    createProvisionedProductPlan_productId,
    createProvisionedProductPlan_provisionedProductName,
    createProvisionedProductPlan_provisioningArtifactId,
    createProvisionedProductPlan_idempotencyToken,

    -- * Destructuring the Response
    CreateProvisionedProductPlanResponse (..),
    newCreateProvisionedProductPlanResponse,

    -- * Response Lenses
    createProvisionedProductPlanResponse_planId,
    createProvisionedProductPlanResponse_planName,
    createProvisionedProductPlanResponse_provisionProductId,
    createProvisionedProductPlanResponse_provisionedProductName,
    createProvisionedProductPlanResponse_provisioningArtifactId,
    createProvisionedProductPlanResponse_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.ServiceCatalog.Types

-- | /See:/ 'newCreateProvisionedProductPlan' smart constructor.
data CreateProvisionedProductPlan = CreateProvisionedProductPlan'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    CreateProvisionedProductPlan -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | Passed to CloudFormation. The SNS topic ARNs to which to publish
    -- stack-related events.
    CreateProvisionedProductPlan -> Maybe [Text]
notificationArns :: Prelude.Maybe [Prelude.Text],
    -- | The path identifier of the product. This value is optional if the
    -- product has a default path, and required if the product has more than
    -- one path. To list the paths for a product, use ListLaunchPaths.
    CreateProvisionedProductPlan -> Maybe Text
pathId :: Prelude.Maybe Prelude.Text,
    -- | Parameters specified by the administrator that are required for
    -- provisioning the product.
    CreateProvisionedProductPlan -> Maybe [UpdateProvisioningParameter]
provisioningParameters :: Prelude.Maybe [UpdateProvisioningParameter],
    -- | One or more tags.
    --
    -- If the plan is for an existing provisioned product, the product must
    -- have a @RESOURCE_UPDATE@ constraint with
    -- @TagUpdatesOnProvisionedProduct@ set to @ALLOWED@ to allow tag updates.
    CreateProvisionedProductPlan -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the plan.
    CreateProvisionedProductPlan -> Text
planName :: Prelude.Text,
    -- | The plan type.
    CreateProvisionedProductPlan -> ProvisionedProductPlanType
planType :: ProvisionedProductPlanType,
    -- | The product identifier.
    CreateProvisionedProductPlan -> Text
productId :: Prelude.Text,
    -- | A user-friendly name for the provisioned product. This value must be
    -- unique for the Amazon Web Services account and cannot be updated after
    -- the product is provisioned.
    CreateProvisionedProductPlan -> Text
provisionedProductName :: Prelude.Text,
    -- | The identifier of the provisioning artifact.
    CreateProvisionedProductPlan -> Text
provisioningArtifactId :: Prelude.Text,
    -- | A unique identifier that you provide to ensure idempotency. If multiple
    -- requests differ only by the idempotency token, the same response is
    -- returned for each repeated request.
    CreateProvisionedProductPlan -> Text
idempotencyToken :: Prelude.Text
  }
  deriving (CreateProvisionedProductPlan
-> CreateProvisionedProductPlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProvisionedProductPlan
-> CreateProvisionedProductPlan -> Bool
$c/= :: CreateProvisionedProductPlan
-> CreateProvisionedProductPlan -> Bool
== :: CreateProvisionedProductPlan
-> CreateProvisionedProductPlan -> Bool
$c== :: CreateProvisionedProductPlan
-> CreateProvisionedProductPlan -> Bool
Prelude.Eq, ReadPrec [CreateProvisionedProductPlan]
ReadPrec CreateProvisionedProductPlan
Int -> ReadS CreateProvisionedProductPlan
ReadS [CreateProvisionedProductPlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateProvisionedProductPlan]
$creadListPrec :: ReadPrec [CreateProvisionedProductPlan]
readPrec :: ReadPrec CreateProvisionedProductPlan
$creadPrec :: ReadPrec CreateProvisionedProductPlan
readList :: ReadS [CreateProvisionedProductPlan]
$creadList :: ReadS [CreateProvisionedProductPlan]
readsPrec :: Int -> ReadS CreateProvisionedProductPlan
$creadsPrec :: Int -> ReadS CreateProvisionedProductPlan
Prelude.Read, Int -> CreateProvisionedProductPlan -> ShowS
[CreateProvisionedProductPlan] -> ShowS
CreateProvisionedProductPlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProvisionedProductPlan] -> ShowS
$cshowList :: [CreateProvisionedProductPlan] -> ShowS
show :: CreateProvisionedProductPlan -> String
$cshow :: CreateProvisionedProductPlan -> String
showsPrec :: Int -> CreateProvisionedProductPlan -> ShowS
$cshowsPrec :: Int -> CreateProvisionedProductPlan -> ShowS
Prelude.Show, forall x.
Rep CreateProvisionedProductPlan x -> CreateProvisionedProductPlan
forall x.
CreateProvisionedProductPlan -> Rep CreateProvisionedProductPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateProvisionedProductPlan x -> CreateProvisionedProductPlan
$cfrom :: forall x.
CreateProvisionedProductPlan -> Rep CreateProvisionedProductPlan x
Prelude.Generic)

-- |
-- Create a value of 'CreateProvisionedProductPlan' 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:
--
-- 'acceptLanguage', 'createProvisionedProductPlan_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'notificationArns', 'createProvisionedProductPlan_notificationArns' - Passed to CloudFormation. The SNS topic ARNs to which to publish
-- stack-related events.
--
-- 'pathId', 'createProvisionedProductPlan_pathId' - The path identifier of the product. This value is optional if the
-- product has a default path, and required if the product has more than
-- one path. To list the paths for a product, use ListLaunchPaths.
--
-- 'provisioningParameters', 'createProvisionedProductPlan_provisioningParameters' - Parameters specified by the administrator that are required for
-- provisioning the product.
--
-- 'tags', 'createProvisionedProductPlan_tags' - One or more tags.
--
-- If the plan is for an existing provisioned product, the product must
-- have a @RESOURCE_UPDATE@ constraint with
-- @TagUpdatesOnProvisionedProduct@ set to @ALLOWED@ to allow tag updates.
--
-- 'planName', 'createProvisionedProductPlan_planName' - The name of the plan.
--
-- 'planType', 'createProvisionedProductPlan_planType' - The plan type.
--
-- 'productId', 'createProvisionedProductPlan_productId' - The product identifier.
--
-- 'provisionedProductName', 'createProvisionedProductPlan_provisionedProductName' - A user-friendly name for the provisioned product. This value must be
-- unique for the Amazon Web Services account and cannot be updated after
-- the product is provisioned.
--
-- 'provisioningArtifactId', 'createProvisionedProductPlan_provisioningArtifactId' - The identifier of the provisioning artifact.
--
-- 'idempotencyToken', 'createProvisionedProductPlan_idempotencyToken' - A unique identifier that you provide to ensure idempotency. If multiple
-- requests differ only by the idempotency token, the same response is
-- returned for each repeated request.
newCreateProvisionedProductPlan ::
  -- | 'planName'
  Prelude.Text ->
  -- | 'planType'
  ProvisionedProductPlanType ->
  -- | 'productId'
  Prelude.Text ->
  -- | 'provisionedProductName'
  Prelude.Text ->
  -- | 'provisioningArtifactId'
  Prelude.Text ->
  -- | 'idempotencyToken'
  Prelude.Text ->
  CreateProvisionedProductPlan
newCreateProvisionedProductPlan :: Text
-> ProvisionedProductPlanType
-> Text
-> Text
-> Text
-> Text
-> CreateProvisionedProductPlan
newCreateProvisionedProductPlan
  Text
pPlanName_
  ProvisionedProductPlanType
pPlanType_
  Text
pProductId_
  Text
pProvisionedProductName_
  Text
pProvisioningArtifactId_
  Text
pIdempotencyToken_ =
    CreateProvisionedProductPlan'
      { $sel:acceptLanguage:CreateProvisionedProductPlan' :: Maybe Text
acceptLanguage =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notificationArns:CreateProvisionedProductPlan' :: Maybe [Text]
notificationArns = forall a. Maybe a
Prelude.Nothing,
        $sel:pathId:CreateProvisionedProductPlan' :: Maybe Text
pathId = forall a. Maybe a
Prelude.Nothing,
        $sel:provisioningParameters:CreateProvisionedProductPlan' :: Maybe [UpdateProvisioningParameter]
provisioningParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateProvisionedProductPlan' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:planName:CreateProvisionedProductPlan' :: Text
planName = Text
pPlanName_,
        $sel:planType:CreateProvisionedProductPlan' :: ProvisionedProductPlanType
planType = ProvisionedProductPlanType
pPlanType_,
        $sel:productId:CreateProvisionedProductPlan' :: Text
productId = Text
pProductId_,
        $sel:provisionedProductName:CreateProvisionedProductPlan' :: Text
provisionedProductName =
          Text
pProvisionedProductName_,
        $sel:provisioningArtifactId:CreateProvisionedProductPlan' :: Text
provisioningArtifactId =
          Text
pProvisioningArtifactId_,
        $sel:idempotencyToken:CreateProvisionedProductPlan' :: Text
idempotencyToken = Text
pIdempotencyToken_
      }

-- | The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
createProvisionedProductPlan_acceptLanguage :: Lens.Lens' CreateProvisionedProductPlan (Prelude.Maybe Prelude.Text)
createProvisionedProductPlan_acceptLanguage :: Lens' CreateProvisionedProductPlan (Maybe Text)
createProvisionedProductPlan_acceptLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Maybe Text
acceptLanguage :: Maybe Text
$sel:acceptLanguage:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe Text
acceptLanguage} -> Maybe Text
acceptLanguage) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Maybe Text
a -> CreateProvisionedProductPlan
s {$sel:acceptLanguage:CreateProvisionedProductPlan' :: Maybe Text
acceptLanguage = Maybe Text
a} :: CreateProvisionedProductPlan)

-- | Passed to CloudFormation. The SNS topic ARNs to which to publish
-- stack-related events.
createProvisionedProductPlan_notificationArns :: Lens.Lens' CreateProvisionedProductPlan (Prelude.Maybe [Prelude.Text])
createProvisionedProductPlan_notificationArns :: Lens' CreateProvisionedProductPlan (Maybe [Text])
createProvisionedProductPlan_notificationArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Maybe [Text]
notificationArns :: Maybe [Text]
$sel:notificationArns:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [Text]
notificationArns} -> Maybe [Text]
notificationArns) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Maybe [Text]
a -> CreateProvisionedProductPlan
s {$sel:notificationArns:CreateProvisionedProductPlan' :: Maybe [Text]
notificationArns = Maybe [Text]
a} :: CreateProvisionedProductPlan) 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 path identifier of the product. This value is optional if the
-- product has a default path, and required if the product has more than
-- one path. To list the paths for a product, use ListLaunchPaths.
createProvisionedProductPlan_pathId :: Lens.Lens' CreateProvisionedProductPlan (Prelude.Maybe Prelude.Text)
createProvisionedProductPlan_pathId :: Lens' CreateProvisionedProductPlan (Maybe Text)
createProvisionedProductPlan_pathId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Maybe Text
pathId :: Maybe Text
$sel:pathId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe Text
pathId} -> Maybe Text
pathId) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Maybe Text
a -> CreateProvisionedProductPlan
s {$sel:pathId:CreateProvisionedProductPlan' :: Maybe Text
pathId = Maybe Text
a} :: CreateProvisionedProductPlan)

-- | Parameters specified by the administrator that are required for
-- provisioning the product.
createProvisionedProductPlan_provisioningParameters :: Lens.Lens' CreateProvisionedProductPlan (Prelude.Maybe [UpdateProvisioningParameter])
createProvisionedProductPlan_provisioningParameters :: Lens'
  CreateProvisionedProductPlan (Maybe [UpdateProvisioningParameter])
createProvisionedProductPlan_provisioningParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Maybe [UpdateProvisioningParameter]
provisioningParameters :: Maybe [UpdateProvisioningParameter]
$sel:provisioningParameters:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [UpdateProvisioningParameter]
provisioningParameters} -> Maybe [UpdateProvisioningParameter]
provisioningParameters) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Maybe [UpdateProvisioningParameter]
a -> CreateProvisionedProductPlan
s {$sel:provisioningParameters:CreateProvisionedProductPlan' :: Maybe [UpdateProvisioningParameter]
provisioningParameters = Maybe [UpdateProvisioningParameter]
a} :: CreateProvisionedProductPlan) 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

-- | One or more tags.
--
-- If the plan is for an existing provisioned product, the product must
-- have a @RESOURCE_UPDATE@ constraint with
-- @TagUpdatesOnProvisionedProduct@ set to @ALLOWED@ to allow tag updates.
createProvisionedProductPlan_tags :: Lens.Lens' CreateProvisionedProductPlan (Prelude.Maybe [Tag])
createProvisionedProductPlan_tags :: Lens' CreateProvisionedProductPlan (Maybe [Tag])
createProvisionedProductPlan_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Maybe [Tag]
a -> CreateProvisionedProductPlan
s {$sel:tags:CreateProvisionedProductPlan' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateProvisionedProductPlan) 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 name of the plan.
createProvisionedProductPlan_planName :: Lens.Lens' CreateProvisionedProductPlan Prelude.Text
createProvisionedProductPlan_planName :: Lens' CreateProvisionedProductPlan Text
createProvisionedProductPlan_planName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Text
planName :: Text
$sel:planName:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
planName} -> Text
planName) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Text
a -> CreateProvisionedProductPlan
s {$sel:planName:CreateProvisionedProductPlan' :: Text
planName = Text
a} :: CreateProvisionedProductPlan)

-- | The plan type.
createProvisionedProductPlan_planType :: Lens.Lens' CreateProvisionedProductPlan ProvisionedProductPlanType
createProvisionedProductPlan_planType :: Lens' CreateProvisionedProductPlan ProvisionedProductPlanType
createProvisionedProductPlan_planType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {ProvisionedProductPlanType
planType :: ProvisionedProductPlanType
$sel:planType:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> ProvisionedProductPlanType
planType} -> ProvisionedProductPlanType
planType) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} ProvisionedProductPlanType
a -> CreateProvisionedProductPlan
s {$sel:planType:CreateProvisionedProductPlan' :: ProvisionedProductPlanType
planType = ProvisionedProductPlanType
a} :: CreateProvisionedProductPlan)

-- | The product identifier.
createProvisionedProductPlan_productId :: Lens.Lens' CreateProvisionedProductPlan Prelude.Text
createProvisionedProductPlan_productId :: Lens' CreateProvisionedProductPlan Text
createProvisionedProductPlan_productId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Text
productId :: Text
$sel:productId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
productId} -> Text
productId) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Text
a -> CreateProvisionedProductPlan
s {$sel:productId:CreateProvisionedProductPlan' :: Text
productId = Text
a} :: CreateProvisionedProductPlan)

-- | A user-friendly name for the provisioned product. This value must be
-- unique for the Amazon Web Services account and cannot be updated after
-- the product is provisioned.
createProvisionedProductPlan_provisionedProductName :: Lens.Lens' CreateProvisionedProductPlan Prelude.Text
createProvisionedProductPlan_provisionedProductName :: Lens' CreateProvisionedProductPlan Text
createProvisionedProductPlan_provisionedProductName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Text
provisionedProductName :: Text
$sel:provisionedProductName:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
provisionedProductName} -> Text
provisionedProductName) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Text
a -> CreateProvisionedProductPlan
s {$sel:provisionedProductName:CreateProvisionedProductPlan' :: Text
provisionedProductName = Text
a} :: CreateProvisionedProductPlan)

-- | The identifier of the provisioning artifact.
createProvisionedProductPlan_provisioningArtifactId :: Lens.Lens' CreateProvisionedProductPlan Prelude.Text
createProvisionedProductPlan_provisioningArtifactId :: Lens' CreateProvisionedProductPlan Text
createProvisionedProductPlan_provisioningArtifactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Text
provisioningArtifactId :: Text
$sel:provisioningArtifactId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
provisioningArtifactId} -> Text
provisioningArtifactId) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Text
a -> CreateProvisionedProductPlan
s {$sel:provisioningArtifactId:CreateProvisionedProductPlan' :: Text
provisioningArtifactId = Text
a} :: CreateProvisionedProductPlan)

-- | A unique identifier that you provide to ensure idempotency. If multiple
-- requests differ only by the idempotency token, the same response is
-- returned for each repeated request.
createProvisionedProductPlan_idempotencyToken :: Lens.Lens' CreateProvisionedProductPlan Prelude.Text
createProvisionedProductPlan_idempotencyToken :: Lens' CreateProvisionedProductPlan Text
createProvisionedProductPlan_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlan' {Text
idempotencyToken :: Text
$sel:idempotencyToken:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
idempotencyToken} -> Text
idempotencyToken) (\s :: CreateProvisionedProductPlan
s@CreateProvisionedProductPlan' {} Text
a -> CreateProvisionedProductPlan
s {$sel:idempotencyToken:CreateProvisionedProductPlan' :: Text
idempotencyToken = Text
a} :: CreateProvisionedProductPlan)

instance Core.AWSRequest CreateProvisionedProductPlan where
  type
    AWSResponse CreateProvisionedProductPlan =
      CreateProvisionedProductPlanResponse
  request :: (Service -> Service)
-> CreateProvisionedProductPlan
-> Request CreateProvisionedProductPlan
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 CreateProvisionedProductPlan
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateProvisionedProductPlan)))
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> CreateProvisionedProductPlanResponse
CreateProvisionedProductPlanResponse'
            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
"PlanId")
            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
"PlanName")
            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
"ProvisionProductId")
            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
"ProvisionedProductName")
            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
"ProvisioningArtifactId")
            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))
      )

instance
  Prelude.Hashable
    CreateProvisionedProductPlan
  where
  hashWithSalt :: Int -> CreateProvisionedProductPlan -> Int
hashWithSalt Int
_salt CreateProvisionedProductPlan' {Maybe [Text]
Maybe [Tag]
Maybe [UpdateProvisioningParameter]
Maybe Text
Text
ProvisionedProductPlanType
idempotencyToken :: Text
provisioningArtifactId :: Text
provisionedProductName :: Text
productId :: Text
planType :: ProvisionedProductPlanType
planName :: Text
tags :: Maybe [Tag]
provisioningParameters :: Maybe [UpdateProvisioningParameter]
pathId :: Maybe Text
notificationArns :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:provisioningArtifactId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:provisionedProductName:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:productId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:planType:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> ProvisionedProductPlanType
$sel:planName:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:tags:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [Tag]
$sel:provisioningParameters:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [UpdateProvisioningParameter]
$sel:pathId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe Text
$sel:notificationArns:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [Text]
$sel:acceptLanguage:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
acceptLanguage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
notificationArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pathId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [UpdateProvisioningParameter]
provisioningParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
planName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ProvisionedProductPlanType
planType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
productId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
provisionedProductName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
provisioningArtifactId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
idempotencyToken

instance Prelude.NFData CreateProvisionedProductPlan where
  rnf :: CreateProvisionedProductPlan -> ()
rnf CreateProvisionedProductPlan' {Maybe [Text]
Maybe [Tag]
Maybe [UpdateProvisioningParameter]
Maybe Text
Text
ProvisionedProductPlanType
idempotencyToken :: Text
provisioningArtifactId :: Text
provisionedProductName :: Text
productId :: Text
planType :: ProvisionedProductPlanType
planName :: Text
tags :: Maybe [Tag]
provisioningParameters :: Maybe [UpdateProvisioningParameter]
pathId :: Maybe Text
notificationArns :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:provisioningArtifactId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:provisionedProductName:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:productId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:planType:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> ProvisionedProductPlanType
$sel:planName:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:tags:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [Tag]
$sel:provisioningParameters:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [UpdateProvisioningParameter]
$sel:pathId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe Text
$sel:notificationArns:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [Text]
$sel:acceptLanguage:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
acceptLanguage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
notificationArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pathId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UpdateProvisioningParameter]
provisioningParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
planName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProvisionedProductPlanType
planType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
productId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
provisionedProductName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
provisioningArtifactId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
idempotencyToken

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

instance Data.ToJSON CreateProvisionedProductPlan where
  toJSON :: CreateProvisionedProductPlan -> Value
toJSON CreateProvisionedProductPlan' {Maybe [Text]
Maybe [Tag]
Maybe [UpdateProvisioningParameter]
Maybe Text
Text
ProvisionedProductPlanType
idempotencyToken :: Text
provisioningArtifactId :: Text
provisionedProductName :: Text
productId :: Text
planType :: ProvisionedProductPlanType
planName :: Text
tags :: Maybe [Tag]
provisioningParameters :: Maybe [UpdateProvisioningParameter]
pathId :: Maybe Text
notificationArns :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:provisioningArtifactId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:provisionedProductName:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:productId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:planType:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> ProvisionedProductPlanType
$sel:planName:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Text
$sel:tags:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [Tag]
$sel:provisioningParameters:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [UpdateProvisioningParameter]
$sel:pathId:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe Text
$sel:notificationArns:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe [Text]
$sel:acceptLanguage:CreateProvisionedProductPlan' :: CreateProvisionedProductPlan -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AcceptLanguage" 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
acceptLanguage,
            (Key
"NotificationArns" 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]
notificationArns,
            (Key
"PathId" 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
pathId,
            (Key
"ProvisioningParameters" 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 [UpdateProvisioningParameter]
provisioningParameters,
            (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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"PlanName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
planName),
            forall a. a -> Maybe a
Prelude.Just (Key
"PlanType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ProvisionedProductPlanType
planType),
            forall a. a -> Maybe a
Prelude.Just (Key
"ProductId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
productId),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ProvisionedProductName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
provisionedProductName
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ProvisioningArtifactId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
provisioningArtifactId
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IdempotencyToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
idempotencyToken)
          ]
      )

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

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

-- | /See:/ 'newCreateProvisionedProductPlanResponse' smart constructor.
data CreateProvisionedProductPlanResponse = CreateProvisionedProductPlanResponse'
  { -- | The plan identifier.
    CreateProvisionedProductPlanResponse -> Maybe Text
planId :: Prelude.Maybe Prelude.Text,
    -- | The name of the plan.
    CreateProvisionedProductPlanResponse -> Maybe Text
planName :: Prelude.Maybe Prelude.Text,
    -- | The product identifier.
    CreateProvisionedProductPlanResponse -> Maybe Text
provisionProductId :: Prelude.Maybe Prelude.Text,
    -- | The user-friendly name of the provisioned product.
    CreateProvisionedProductPlanResponse -> Maybe Text
provisionedProductName :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the provisioning artifact.
    CreateProvisionedProductPlanResponse -> Maybe Text
provisioningArtifactId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateProvisionedProductPlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateProvisionedProductPlanResponse
-> CreateProvisionedProductPlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProvisionedProductPlanResponse
-> CreateProvisionedProductPlanResponse -> Bool
$c/= :: CreateProvisionedProductPlanResponse
-> CreateProvisionedProductPlanResponse -> Bool
== :: CreateProvisionedProductPlanResponse
-> CreateProvisionedProductPlanResponse -> Bool
$c== :: CreateProvisionedProductPlanResponse
-> CreateProvisionedProductPlanResponse -> Bool
Prelude.Eq, ReadPrec [CreateProvisionedProductPlanResponse]
ReadPrec CreateProvisionedProductPlanResponse
Int -> ReadS CreateProvisionedProductPlanResponse
ReadS [CreateProvisionedProductPlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateProvisionedProductPlanResponse]
$creadListPrec :: ReadPrec [CreateProvisionedProductPlanResponse]
readPrec :: ReadPrec CreateProvisionedProductPlanResponse
$creadPrec :: ReadPrec CreateProvisionedProductPlanResponse
readList :: ReadS [CreateProvisionedProductPlanResponse]
$creadList :: ReadS [CreateProvisionedProductPlanResponse]
readsPrec :: Int -> ReadS CreateProvisionedProductPlanResponse
$creadsPrec :: Int -> ReadS CreateProvisionedProductPlanResponse
Prelude.Read, Int -> CreateProvisionedProductPlanResponse -> ShowS
[CreateProvisionedProductPlanResponse] -> ShowS
CreateProvisionedProductPlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProvisionedProductPlanResponse] -> ShowS
$cshowList :: [CreateProvisionedProductPlanResponse] -> ShowS
show :: CreateProvisionedProductPlanResponse -> String
$cshow :: CreateProvisionedProductPlanResponse -> String
showsPrec :: Int -> CreateProvisionedProductPlanResponse -> ShowS
$cshowsPrec :: Int -> CreateProvisionedProductPlanResponse -> ShowS
Prelude.Show, forall x.
Rep CreateProvisionedProductPlanResponse x
-> CreateProvisionedProductPlanResponse
forall x.
CreateProvisionedProductPlanResponse
-> Rep CreateProvisionedProductPlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateProvisionedProductPlanResponse x
-> CreateProvisionedProductPlanResponse
$cfrom :: forall x.
CreateProvisionedProductPlanResponse
-> Rep CreateProvisionedProductPlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateProvisionedProductPlanResponse' 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:
--
-- 'planId', 'createProvisionedProductPlanResponse_planId' - The plan identifier.
--
-- 'planName', 'createProvisionedProductPlanResponse_planName' - The name of the plan.
--
-- 'provisionProductId', 'createProvisionedProductPlanResponse_provisionProductId' - The product identifier.
--
-- 'provisionedProductName', 'createProvisionedProductPlanResponse_provisionedProductName' - The user-friendly name of the provisioned product.
--
-- 'provisioningArtifactId', 'createProvisionedProductPlanResponse_provisioningArtifactId' - The identifier of the provisioning artifact.
--
-- 'httpStatus', 'createProvisionedProductPlanResponse_httpStatus' - The response's http status code.
newCreateProvisionedProductPlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateProvisionedProductPlanResponse
newCreateProvisionedProductPlanResponse :: Int -> CreateProvisionedProductPlanResponse
newCreateProvisionedProductPlanResponse Int
pHttpStatus_ =
  CreateProvisionedProductPlanResponse'
    { $sel:planId:CreateProvisionedProductPlanResponse' :: Maybe Text
planId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:planName:CreateProvisionedProductPlanResponse' :: Maybe Text
planName = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionProductId:CreateProvisionedProductPlanResponse' :: Maybe Text
provisionProductId = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedProductName:CreateProvisionedProductPlanResponse' :: Maybe Text
provisionedProductName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:provisioningArtifactId:CreateProvisionedProductPlanResponse' :: Maybe Text
provisioningArtifactId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateProvisionedProductPlanResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The plan identifier.
createProvisionedProductPlanResponse_planId :: Lens.Lens' CreateProvisionedProductPlanResponse (Prelude.Maybe Prelude.Text)
createProvisionedProductPlanResponse_planId :: Lens' CreateProvisionedProductPlanResponse (Maybe Text)
createProvisionedProductPlanResponse_planId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlanResponse' {Maybe Text
planId :: Maybe Text
$sel:planId:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
planId} -> Maybe Text
planId) (\s :: CreateProvisionedProductPlanResponse
s@CreateProvisionedProductPlanResponse' {} Maybe Text
a -> CreateProvisionedProductPlanResponse
s {$sel:planId:CreateProvisionedProductPlanResponse' :: Maybe Text
planId = Maybe Text
a} :: CreateProvisionedProductPlanResponse)

-- | The name of the plan.
createProvisionedProductPlanResponse_planName :: Lens.Lens' CreateProvisionedProductPlanResponse (Prelude.Maybe Prelude.Text)
createProvisionedProductPlanResponse_planName :: Lens' CreateProvisionedProductPlanResponse (Maybe Text)
createProvisionedProductPlanResponse_planName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlanResponse' {Maybe Text
planName :: Maybe Text
$sel:planName:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
planName} -> Maybe Text
planName) (\s :: CreateProvisionedProductPlanResponse
s@CreateProvisionedProductPlanResponse' {} Maybe Text
a -> CreateProvisionedProductPlanResponse
s {$sel:planName:CreateProvisionedProductPlanResponse' :: Maybe Text
planName = Maybe Text
a} :: CreateProvisionedProductPlanResponse)

-- | The product identifier.
createProvisionedProductPlanResponse_provisionProductId :: Lens.Lens' CreateProvisionedProductPlanResponse (Prelude.Maybe Prelude.Text)
createProvisionedProductPlanResponse_provisionProductId :: Lens' CreateProvisionedProductPlanResponse (Maybe Text)
createProvisionedProductPlanResponse_provisionProductId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlanResponse' {Maybe Text
provisionProductId :: Maybe Text
$sel:provisionProductId:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
provisionProductId} -> Maybe Text
provisionProductId) (\s :: CreateProvisionedProductPlanResponse
s@CreateProvisionedProductPlanResponse' {} Maybe Text
a -> CreateProvisionedProductPlanResponse
s {$sel:provisionProductId:CreateProvisionedProductPlanResponse' :: Maybe Text
provisionProductId = Maybe Text
a} :: CreateProvisionedProductPlanResponse)

-- | The user-friendly name of the provisioned product.
createProvisionedProductPlanResponse_provisionedProductName :: Lens.Lens' CreateProvisionedProductPlanResponse (Prelude.Maybe Prelude.Text)
createProvisionedProductPlanResponse_provisionedProductName :: Lens' CreateProvisionedProductPlanResponse (Maybe Text)
createProvisionedProductPlanResponse_provisionedProductName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlanResponse' {Maybe Text
provisionedProductName :: Maybe Text
$sel:provisionedProductName:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
provisionedProductName} -> Maybe Text
provisionedProductName) (\s :: CreateProvisionedProductPlanResponse
s@CreateProvisionedProductPlanResponse' {} Maybe Text
a -> CreateProvisionedProductPlanResponse
s {$sel:provisionedProductName:CreateProvisionedProductPlanResponse' :: Maybe Text
provisionedProductName = Maybe Text
a} :: CreateProvisionedProductPlanResponse)

-- | The identifier of the provisioning artifact.
createProvisionedProductPlanResponse_provisioningArtifactId :: Lens.Lens' CreateProvisionedProductPlanResponse (Prelude.Maybe Prelude.Text)
createProvisionedProductPlanResponse_provisioningArtifactId :: Lens' CreateProvisionedProductPlanResponse (Maybe Text)
createProvisionedProductPlanResponse_provisioningArtifactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProvisionedProductPlanResponse' {Maybe Text
provisioningArtifactId :: Maybe Text
$sel:provisioningArtifactId:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
provisioningArtifactId} -> Maybe Text
provisioningArtifactId) (\s :: CreateProvisionedProductPlanResponse
s@CreateProvisionedProductPlanResponse' {} Maybe Text
a -> CreateProvisionedProductPlanResponse
s {$sel:provisioningArtifactId:CreateProvisionedProductPlanResponse' :: Maybe Text
provisioningArtifactId = Maybe Text
a} :: CreateProvisionedProductPlanResponse)

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

instance
  Prelude.NFData
    CreateProvisionedProductPlanResponse
  where
  rnf :: CreateProvisionedProductPlanResponse -> ()
rnf CreateProvisionedProductPlanResponse' {Int
Maybe Text
httpStatus :: Int
provisioningArtifactId :: Maybe Text
provisionedProductName :: Maybe Text
provisionProductId :: Maybe Text
planName :: Maybe Text
planId :: Maybe Text
$sel:httpStatus:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Int
$sel:provisioningArtifactId:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
$sel:provisionedProductName:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
$sel:provisionProductId:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
$sel:planName:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
$sel:planId:CreateProvisionedProductPlanResponse' :: CreateProvisionedProductPlanResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
planId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
planName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
provisionProductId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
provisionedProductName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
provisioningArtifactId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus