{-# 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.ProvisionProduct
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provisions the specified product.
--
-- A provisioned product is a resourced instance of a product. For example,
-- provisioning a product based on a CloudFormation template launches a
-- CloudFormation stack and its underlying resources. You can check the
-- status of this request using DescribeRecord.
--
-- If the request contains a tag key with an empty list of values, there is
-- a tag conflict for that key. Do not include conflicted keys as tags, or
-- this causes the error \"Parameter validation failed: Missing required
-- parameter in Tags[/N/]:/Value/\".
module Amazonka.ServiceCatalog.ProvisionProduct
  ( -- * Creating a Request
    ProvisionProduct (..),
    newProvisionProduct,

    -- * Request Lenses
    provisionProduct_acceptLanguage,
    provisionProduct_notificationArns,
    provisionProduct_pathId,
    provisionProduct_pathName,
    provisionProduct_productId,
    provisionProduct_productName,
    provisionProduct_provisioningArtifactId,
    provisionProduct_provisioningArtifactName,
    provisionProduct_provisioningParameters,
    provisionProduct_provisioningPreferences,
    provisionProduct_tags,
    provisionProduct_provisionedProductName,
    provisionProduct_provisionToken,

    -- * Destructuring the Response
    ProvisionProductResponse (..),
    newProvisionProductResponse,

    -- * Response Lenses
    provisionProductResponse_recordDetail,
    provisionProductResponse_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:/ 'newProvisionProduct' smart constructor.
data ProvisionProduct = ProvisionProduct'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    ProvisionProduct -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | Passed to CloudFormation. The SNS topic ARNs to which to publish
    -- stack-related events.
    ProvisionProduct -> 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. You must
    -- provide the name or ID, but not both.
    ProvisionProduct -> Maybe Text
pathId :: Prelude.Maybe Prelude.Text,
    -- | The name of the path. You must provide the name or ID, but not both.
    ProvisionProduct -> Maybe Text
pathName :: Prelude.Maybe Prelude.Text,
    -- | The product identifier. You must provide the name or ID, but not both.
    ProvisionProduct -> Maybe Text
productId :: Prelude.Maybe Prelude.Text,
    -- | The name of the product. You must provide the name or ID, but not both.
    ProvisionProduct -> Maybe Text
productName :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the provisioning artifact. You must provide the name
    -- or ID, but not both.
    ProvisionProduct -> Maybe Text
provisioningArtifactId :: Prelude.Maybe Prelude.Text,
    -- | The name of the provisioning artifact. You must provide the name or ID,
    -- but not both.
    ProvisionProduct -> Maybe Text
provisioningArtifactName :: Prelude.Maybe Prelude.Text,
    -- | Parameters specified by the administrator that are required for
    -- provisioning the product.
    ProvisionProduct -> Maybe [ProvisioningParameter]
provisioningParameters :: Prelude.Maybe [ProvisioningParameter],
    -- | An object that contains information about the provisioning preferences
    -- for a stack set.
    ProvisionProduct -> Maybe ProvisioningPreferences
provisioningPreferences :: Prelude.Maybe ProvisioningPreferences,
    -- | One or more tags.
    ProvisionProduct -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | 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.
    ProvisionProduct -> Text
provisionedProductName :: Prelude.Text,
    -- | An idempotency token that uniquely identifies the provisioning request.
    ProvisionProduct -> Text
provisionToken :: Prelude.Text
  }
  deriving (ProvisionProduct -> ProvisionProduct -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProvisionProduct -> ProvisionProduct -> Bool
$c/= :: ProvisionProduct -> ProvisionProduct -> Bool
== :: ProvisionProduct -> ProvisionProduct -> Bool
$c== :: ProvisionProduct -> ProvisionProduct -> Bool
Prelude.Eq, ReadPrec [ProvisionProduct]
ReadPrec ProvisionProduct
Int -> ReadS ProvisionProduct
ReadS [ProvisionProduct]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProvisionProduct]
$creadListPrec :: ReadPrec [ProvisionProduct]
readPrec :: ReadPrec ProvisionProduct
$creadPrec :: ReadPrec ProvisionProduct
readList :: ReadS [ProvisionProduct]
$creadList :: ReadS [ProvisionProduct]
readsPrec :: Int -> ReadS ProvisionProduct
$creadsPrec :: Int -> ReadS ProvisionProduct
Prelude.Read, Int -> ProvisionProduct -> ShowS
[ProvisionProduct] -> ShowS
ProvisionProduct -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProvisionProduct] -> ShowS
$cshowList :: [ProvisionProduct] -> ShowS
show :: ProvisionProduct -> String
$cshow :: ProvisionProduct -> String
showsPrec :: Int -> ProvisionProduct -> ShowS
$cshowsPrec :: Int -> ProvisionProduct -> ShowS
Prelude.Show, forall x. Rep ProvisionProduct x -> ProvisionProduct
forall x. ProvisionProduct -> Rep ProvisionProduct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProvisionProduct x -> ProvisionProduct
$cfrom :: forall x. ProvisionProduct -> Rep ProvisionProduct x
Prelude.Generic)

-- |
-- Create a value of 'ProvisionProduct' 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', 'provisionProduct_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'notificationArns', 'provisionProduct_notificationArns' - Passed to CloudFormation. The SNS topic ARNs to which to publish
-- stack-related events.
--
-- 'pathId', 'provisionProduct_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. You must
-- provide the name or ID, but not both.
--
-- 'pathName', 'provisionProduct_pathName' - The name of the path. You must provide the name or ID, but not both.
--
-- 'productId', 'provisionProduct_productId' - The product identifier. You must provide the name or ID, but not both.
--
-- 'productName', 'provisionProduct_productName' - The name of the product. You must provide the name or ID, but not both.
--
-- 'provisioningArtifactId', 'provisionProduct_provisioningArtifactId' - The identifier of the provisioning artifact. You must provide the name
-- or ID, but not both.
--
-- 'provisioningArtifactName', 'provisionProduct_provisioningArtifactName' - The name of the provisioning artifact. You must provide the name or ID,
-- but not both.
--
-- 'provisioningParameters', 'provisionProduct_provisioningParameters' - Parameters specified by the administrator that are required for
-- provisioning the product.
--
-- 'provisioningPreferences', 'provisionProduct_provisioningPreferences' - An object that contains information about the provisioning preferences
-- for a stack set.
--
-- 'tags', 'provisionProduct_tags' - One or more tags.
--
-- 'provisionedProductName', 'provisionProduct_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.
--
-- 'provisionToken', 'provisionProduct_provisionToken' - An idempotency token that uniquely identifies the provisioning request.
newProvisionProduct ::
  -- | 'provisionedProductName'
  Prelude.Text ->
  -- | 'provisionToken'
  Prelude.Text ->
  ProvisionProduct
newProvisionProduct :: Text -> Text -> ProvisionProduct
newProvisionProduct
  Text
pProvisionedProductName_
  Text
pProvisionToken_ =
    ProvisionProduct'
      { $sel:acceptLanguage:ProvisionProduct' :: Maybe Text
acceptLanguage = forall a. Maybe a
Prelude.Nothing,
        $sel:notificationArns:ProvisionProduct' :: Maybe [Text]
notificationArns = forall a. Maybe a
Prelude.Nothing,
        $sel:pathId:ProvisionProduct' :: Maybe Text
pathId = forall a. Maybe a
Prelude.Nothing,
        $sel:pathName:ProvisionProduct' :: Maybe Text
pathName = forall a. Maybe a
Prelude.Nothing,
        $sel:productId:ProvisionProduct' :: Maybe Text
productId = forall a. Maybe a
Prelude.Nothing,
        $sel:productName:ProvisionProduct' :: Maybe Text
productName = forall a. Maybe a
Prelude.Nothing,
        $sel:provisioningArtifactId:ProvisionProduct' :: Maybe Text
provisioningArtifactId = forall a. Maybe a
Prelude.Nothing,
        $sel:provisioningArtifactName:ProvisionProduct' :: Maybe Text
provisioningArtifactName = forall a. Maybe a
Prelude.Nothing,
        $sel:provisioningParameters:ProvisionProduct' :: Maybe [ProvisioningParameter]
provisioningParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:provisioningPreferences:ProvisionProduct' :: Maybe ProvisioningPreferences
provisioningPreferences = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:ProvisionProduct' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:provisionedProductName:ProvisionProduct' :: Text
provisionedProductName = Text
pProvisionedProductName_,
        $sel:provisionToken:ProvisionProduct' :: Text
provisionToken = Text
pProvisionToken_
      }

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

-- | Passed to CloudFormation. The SNS topic ARNs to which to publish
-- stack-related events.
provisionProduct_notificationArns :: Lens.Lens' ProvisionProduct (Prelude.Maybe [Prelude.Text])
provisionProduct_notificationArns :: Lens' ProvisionProduct (Maybe [Text])
provisionProduct_notificationArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe [Text]
notificationArns :: Maybe [Text]
$sel:notificationArns:ProvisionProduct' :: ProvisionProduct -> Maybe [Text]
notificationArns} -> Maybe [Text]
notificationArns) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe [Text]
a -> ProvisionProduct
s {$sel:notificationArns:ProvisionProduct' :: Maybe [Text]
notificationArns = Maybe [Text]
a} :: ProvisionProduct) 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. You must
-- provide the name or ID, but not both.
provisionProduct_pathId :: Lens.Lens' ProvisionProduct (Prelude.Maybe Prelude.Text)
provisionProduct_pathId :: Lens' ProvisionProduct (Maybe Text)
provisionProduct_pathId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe Text
pathId :: Maybe Text
$sel:pathId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
pathId} -> Maybe Text
pathId) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe Text
a -> ProvisionProduct
s {$sel:pathId:ProvisionProduct' :: Maybe Text
pathId = Maybe Text
a} :: ProvisionProduct)

-- | The name of the path. You must provide the name or ID, but not both.
provisionProduct_pathName :: Lens.Lens' ProvisionProduct (Prelude.Maybe Prelude.Text)
provisionProduct_pathName :: Lens' ProvisionProduct (Maybe Text)
provisionProduct_pathName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe Text
pathName :: Maybe Text
$sel:pathName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
pathName} -> Maybe Text
pathName) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe Text
a -> ProvisionProduct
s {$sel:pathName:ProvisionProduct' :: Maybe Text
pathName = Maybe Text
a} :: ProvisionProduct)

-- | The product identifier. You must provide the name or ID, but not both.
provisionProduct_productId :: Lens.Lens' ProvisionProduct (Prelude.Maybe Prelude.Text)
provisionProduct_productId :: Lens' ProvisionProduct (Maybe Text)
provisionProduct_productId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe Text
productId :: Maybe Text
$sel:productId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
productId} -> Maybe Text
productId) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe Text
a -> ProvisionProduct
s {$sel:productId:ProvisionProduct' :: Maybe Text
productId = Maybe Text
a} :: ProvisionProduct)

-- | The name of the product. You must provide the name or ID, but not both.
provisionProduct_productName :: Lens.Lens' ProvisionProduct (Prelude.Maybe Prelude.Text)
provisionProduct_productName :: Lens' ProvisionProduct (Maybe Text)
provisionProduct_productName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe Text
productName :: Maybe Text
$sel:productName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
productName} -> Maybe Text
productName) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe Text
a -> ProvisionProduct
s {$sel:productName:ProvisionProduct' :: Maybe Text
productName = Maybe Text
a} :: ProvisionProduct)

-- | The identifier of the provisioning artifact. You must provide the name
-- or ID, but not both.
provisionProduct_provisioningArtifactId :: Lens.Lens' ProvisionProduct (Prelude.Maybe Prelude.Text)
provisionProduct_provisioningArtifactId :: Lens' ProvisionProduct (Maybe Text)
provisionProduct_provisioningArtifactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe Text
provisioningArtifactId :: Maybe Text
$sel:provisioningArtifactId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
provisioningArtifactId} -> Maybe Text
provisioningArtifactId) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe Text
a -> ProvisionProduct
s {$sel:provisioningArtifactId:ProvisionProduct' :: Maybe Text
provisioningArtifactId = Maybe Text
a} :: ProvisionProduct)

-- | The name of the provisioning artifact. You must provide the name or ID,
-- but not both.
provisionProduct_provisioningArtifactName :: Lens.Lens' ProvisionProduct (Prelude.Maybe Prelude.Text)
provisionProduct_provisioningArtifactName :: Lens' ProvisionProduct (Maybe Text)
provisionProduct_provisioningArtifactName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe Text
provisioningArtifactName :: Maybe Text
$sel:provisioningArtifactName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
provisioningArtifactName} -> Maybe Text
provisioningArtifactName) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe Text
a -> ProvisionProduct
s {$sel:provisioningArtifactName:ProvisionProduct' :: Maybe Text
provisioningArtifactName = Maybe Text
a} :: ProvisionProduct)

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

-- | An object that contains information about the provisioning preferences
-- for a stack set.
provisionProduct_provisioningPreferences :: Lens.Lens' ProvisionProduct (Prelude.Maybe ProvisioningPreferences)
provisionProduct_provisioningPreferences :: Lens' ProvisionProduct (Maybe ProvisioningPreferences)
provisionProduct_provisioningPreferences = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe ProvisioningPreferences
provisioningPreferences :: Maybe ProvisioningPreferences
$sel:provisioningPreferences:ProvisionProduct' :: ProvisionProduct -> Maybe ProvisioningPreferences
provisioningPreferences} -> Maybe ProvisioningPreferences
provisioningPreferences) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe ProvisioningPreferences
a -> ProvisionProduct
s {$sel:provisioningPreferences:ProvisionProduct' :: Maybe ProvisioningPreferences
provisioningPreferences = Maybe ProvisioningPreferences
a} :: ProvisionProduct)

-- | One or more tags.
provisionProduct_tags :: Lens.Lens' ProvisionProduct (Prelude.Maybe [Tag])
provisionProduct_tags :: Lens' ProvisionProduct (Maybe [Tag])
provisionProduct_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ProvisionProduct' :: ProvisionProduct -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ProvisionProduct
s@ProvisionProduct' {} Maybe [Tag]
a -> ProvisionProduct
s {$sel:tags:ProvisionProduct' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ProvisionProduct) 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 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.
provisionProduct_provisionedProductName :: Lens.Lens' ProvisionProduct Prelude.Text
provisionProduct_provisionedProductName :: Lens' ProvisionProduct Text
provisionProduct_provisionedProductName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Text
provisionedProductName :: Text
$sel:provisionedProductName:ProvisionProduct' :: ProvisionProduct -> Text
provisionedProductName} -> Text
provisionedProductName) (\s :: ProvisionProduct
s@ProvisionProduct' {} Text
a -> ProvisionProduct
s {$sel:provisionedProductName:ProvisionProduct' :: Text
provisionedProductName = Text
a} :: ProvisionProduct)

-- | An idempotency token that uniquely identifies the provisioning request.
provisionProduct_provisionToken :: Lens.Lens' ProvisionProduct Prelude.Text
provisionProduct_provisionToken :: Lens' ProvisionProduct Text
provisionProduct_provisionToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProduct' {Text
provisionToken :: Text
$sel:provisionToken:ProvisionProduct' :: ProvisionProduct -> Text
provisionToken} -> Text
provisionToken) (\s :: ProvisionProduct
s@ProvisionProduct' {} Text
a -> ProvisionProduct
s {$sel:provisionToken:ProvisionProduct' :: Text
provisionToken = Text
a} :: ProvisionProduct)

instance Core.AWSRequest ProvisionProduct where
  type
    AWSResponse ProvisionProduct =
      ProvisionProductResponse
  request :: (Service -> Service)
-> ProvisionProduct -> Request ProvisionProduct
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 ProvisionProduct
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ProvisionProduct)))
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 RecordDetail -> Int -> ProvisionProductResponse
ProvisionProductResponse'
            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
"RecordDetail")
            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 ProvisionProduct where
  hashWithSalt :: Int -> ProvisionProduct -> Int
hashWithSalt Int
_salt ProvisionProduct' {Maybe [Text]
Maybe [ProvisioningParameter]
Maybe [Tag]
Maybe Text
Maybe ProvisioningPreferences
Text
provisionToken :: Text
provisionedProductName :: Text
tags :: Maybe [Tag]
provisioningPreferences :: Maybe ProvisioningPreferences
provisioningParameters :: Maybe [ProvisioningParameter]
provisioningArtifactName :: Maybe Text
provisioningArtifactId :: Maybe Text
productName :: Maybe Text
productId :: Maybe Text
pathName :: Maybe Text
pathId :: Maybe Text
notificationArns :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:provisionToken:ProvisionProduct' :: ProvisionProduct -> Text
$sel:provisionedProductName:ProvisionProduct' :: ProvisionProduct -> Text
$sel:tags:ProvisionProduct' :: ProvisionProduct -> Maybe [Tag]
$sel:provisioningPreferences:ProvisionProduct' :: ProvisionProduct -> Maybe ProvisioningPreferences
$sel:provisioningParameters:ProvisionProduct' :: ProvisionProduct -> Maybe [ProvisioningParameter]
$sel:provisioningArtifactName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:provisioningArtifactId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:productName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:productId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:pathName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:pathId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:notificationArns:ProvisionProduct' :: ProvisionProduct -> Maybe [Text]
$sel:acceptLanguage:ProvisionProduct' :: ProvisionProduct -> 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 Text
pathName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
productId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
productName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
provisioningArtifactId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
provisioningArtifactName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ProvisioningParameter]
provisioningParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProvisioningPreferences
provisioningPreferences
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
provisionedProductName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
provisionToken

instance Prelude.NFData ProvisionProduct where
  rnf :: ProvisionProduct -> ()
rnf ProvisionProduct' {Maybe [Text]
Maybe [ProvisioningParameter]
Maybe [Tag]
Maybe Text
Maybe ProvisioningPreferences
Text
provisionToken :: Text
provisionedProductName :: Text
tags :: Maybe [Tag]
provisioningPreferences :: Maybe ProvisioningPreferences
provisioningParameters :: Maybe [ProvisioningParameter]
provisioningArtifactName :: Maybe Text
provisioningArtifactId :: Maybe Text
productName :: Maybe Text
productId :: Maybe Text
pathName :: Maybe Text
pathId :: Maybe Text
notificationArns :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:provisionToken:ProvisionProduct' :: ProvisionProduct -> Text
$sel:provisionedProductName:ProvisionProduct' :: ProvisionProduct -> Text
$sel:tags:ProvisionProduct' :: ProvisionProduct -> Maybe [Tag]
$sel:provisioningPreferences:ProvisionProduct' :: ProvisionProduct -> Maybe ProvisioningPreferences
$sel:provisioningParameters:ProvisionProduct' :: ProvisionProduct -> Maybe [ProvisioningParameter]
$sel:provisioningArtifactName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:provisioningArtifactId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:productName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:productId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:pathName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:pathId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:notificationArns:ProvisionProduct' :: ProvisionProduct -> Maybe [Text]
$sel:acceptLanguage:ProvisionProduct' :: ProvisionProduct -> 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 Text
pathName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
productId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
productName
      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 Maybe Text
provisioningArtifactName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ProvisioningParameter]
provisioningParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProvisioningPreferences
provisioningPreferences
      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
provisionedProductName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
provisionToken

instance Data.ToHeaders ProvisionProduct where
  toHeaders :: ProvisionProduct -> 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.ProvisionProduct" ::
                          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 ProvisionProduct where
  toJSON :: ProvisionProduct -> Value
toJSON ProvisionProduct' {Maybe [Text]
Maybe [ProvisioningParameter]
Maybe [Tag]
Maybe Text
Maybe ProvisioningPreferences
Text
provisionToken :: Text
provisionedProductName :: Text
tags :: Maybe [Tag]
provisioningPreferences :: Maybe ProvisioningPreferences
provisioningParameters :: Maybe [ProvisioningParameter]
provisioningArtifactName :: Maybe Text
provisioningArtifactId :: Maybe Text
productName :: Maybe Text
productId :: Maybe Text
pathName :: Maybe Text
pathId :: Maybe Text
notificationArns :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:provisionToken:ProvisionProduct' :: ProvisionProduct -> Text
$sel:provisionedProductName:ProvisionProduct' :: ProvisionProduct -> Text
$sel:tags:ProvisionProduct' :: ProvisionProduct -> Maybe [Tag]
$sel:provisioningPreferences:ProvisionProduct' :: ProvisionProduct -> Maybe ProvisioningPreferences
$sel:provisioningParameters:ProvisionProduct' :: ProvisionProduct -> Maybe [ProvisioningParameter]
$sel:provisioningArtifactName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:provisioningArtifactId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:productName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:productId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:pathName:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:pathId:ProvisionProduct' :: ProvisionProduct -> Maybe Text
$sel:notificationArns:ProvisionProduct' :: ProvisionProduct -> Maybe [Text]
$sel:acceptLanguage:ProvisionProduct' :: ProvisionProduct -> 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
"PathName" 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
pathName,
            (Key
"ProductId" 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
productId,
            (Key
"ProductName" 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
productName,
            (Key
"ProvisioningArtifactId" 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
provisioningArtifactId,
            (Key
"ProvisioningArtifactName" 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
provisioningArtifactName,
            (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 [ProvisioningParameter]
provisioningParameters,
            (Key
"ProvisioningPreferences" 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 ProvisioningPreferences
provisioningPreferences,
            (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
"ProvisionedProductName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
provisionedProductName
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ProvisionToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
provisionToken)
          ]
      )

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

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

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

-- |
-- Create a value of 'ProvisionProductResponse' 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:
--
-- 'recordDetail', 'provisionProductResponse_recordDetail' - Information about the result of provisioning the product.
--
-- 'httpStatus', 'provisionProductResponse_httpStatus' - The response's http status code.
newProvisionProductResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ProvisionProductResponse
newProvisionProductResponse :: Int -> ProvisionProductResponse
newProvisionProductResponse Int
pHttpStatus_ =
  ProvisionProductResponse'
    { $sel:recordDetail:ProvisionProductResponse' :: Maybe RecordDetail
recordDetail =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ProvisionProductResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the result of provisioning the product.
provisionProductResponse_recordDetail :: Lens.Lens' ProvisionProductResponse (Prelude.Maybe RecordDetail)
provisionProductResponse_recordDetail :: Lens' ProvisionProductResponse (Maybe RecordDetail)
provisionProductResponse_recordDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProvisionProductResponse' {Maybe RecordDetail
recordDetail :: Maybe RecordDetail
$sel:recordDetail:ProvisionProductResponse' :: ProvisionProductResponse -> Maybe RecordDetail
recordDetail} -> Maybe RecordDetail
recordDetail) (\s :: ProvisionProductResponse
s@ProvisionProductResponse' {} Maybe RecordDetail
a -> ProvisionProductResponse
s {$sel:recordDetail:ProvisionProductResponse' :: Maybe RecordDetail
recordDetail = Maybe RecordDetail
a} :: ProvisionProductResponse)

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

instance Prelude.NFData ProvisionProductResponse where
  rnf :: ProvisionProductResponse -> ()
rnf ProvisionProductResponse' {Int
Maybe RecordDetail
httpStatus :: Int
recordDetail :: Maybe RecordDetail
$sel:httpStatus:ProvisionProductResponse' :: ProvisionProductResponse -> Int
$sel:recordDetail:ProvisionProductResponse' :: ProvisionProductResponse -> Maybe RecordDetail
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RecordDetail
recordDetail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus