{-# 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.CreateProduct
-- 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 product.
--
-- A delegated admin is authorized to invoke this command.
--
-- The user or role that performs this operation must have the
-- @cloudformation:GetTemplate@ IAM policy permission. This policy
-- permission is required when using the @ImportFromPhysicalId@ template
-- source in the information data section.
module Amazonka.ServiceCatalog.CreateProduct
  ( -- * Creating a Request
    CreateProduct (..),
    newCreateProduct,

    -- * Request Lenses
    createProduct_acceptLanguage,
    createProduct_description,
    createProduct_distributor,
    createProduct_provisioningArtifactParameters,
    createProduct_sourceConnection,
    createProduct_supportDescription,
    createProduct_supportEmail,
    createProduct_supportUrl,
    createProduct_tags,
    createProduct_name,
    createProduct_owner,
    createProduct_productType,
    createProduct_idempotencyToken,

    -- * Destructuring the Response
    CreateProductResponse (..),
    newCreateProductResponse,

    -- * Response Lenses
    createProductResponse_productViewDetail,
    createProductResponse_provisioningArtifactDetail,
    createProductResponse_tags,
    createProductResponse_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:/ 'newCreateProduct' smart constructor.
data CreateProduct = CreateProduct'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    CreateProduct -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The description of the product.
    CreateProduct -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The distributor of the product.
    CreateProduct -> Maybe Text
distributor :: Prelude.Maybe Prelude.Text,
    -- | The configuration of the provisioning artifact.
    CreateProduct -> Maybe ProvisioningArtifactProperties
provisioningArtifactParameters :: Prelude.Maybe ProvisioningArtifactProperties,
    -- | Specifies connection details for the created product and syncs the
    -- product to the connection source artifact. This automatically manages
    -- the product\'s artifacts based on changes to the source. The
    -- @SourceConnection@ parameter consists of the following sub-fields.
    --
    -- -   @Type@
    --
    -- -   @ConnectionParamters@
    CreateProduct -> Maybe SourceConnection
sourceConnection :: Prelude.Maybe SourceConnection,
    -- | The support information about the product.
    CreateProduct -> Maybe Text
supportDescription :: Prelude.Maybe Prelude.Text,
    -- | The contact email for product support.
    CreateProduct -> Maybe Text
supportEmail :: Prelude.Maybe Prelude.Text,
    -- | The contact URL for product support.
    --
    -- @^https?:\\\/\\\/\/ @\/ is the pattern used to validate SupportUrl.
    CreateProduct -> Maybe Text
supportUrl :: Prelude.Maybe Prelude.Text,
    -- | One or more tags.
    CreateProduct -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the product.
    CreateProduct -> Text
name :: Prelude.Text,
    -- | The owner of the product.
    CreateProduct -> Text
owner :: Prelude.Text,
    -- | The type of product.
    CreateProduct -> ProductType
productType :: ProductType,
    -- | 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.
    CreateProduct -> Text
idempotencyToken :: Prelude.Text
  }
  deriving (CreateProduct -> CreateProduct -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProduct -> CreateProduct -> Bool
$c/= :: CreateProduct -> CreateProduct -> Bool
== :: CreateProduct -> CreateProduct -> Bool
$c== :: CreateProduct -> CreateProduct -> Bool
Prelude.Eq, ReadPrec [CreateProduct]
ReadPrec CreateProduct
Int -> ReadS CreateProduct
ReadS [CreateProduct]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateProduct]
$creadListPrec :: ReadPrec [CreateProduct]
readPrec :: ReadPrec CreateProduct
$creadPrec :: ReadPrec CreateProduct
readList :: ReadS [CreateProduct]
$creadList :: ReadS [CreateProduct]
readsPrec :: Int -> ReadS CreateProduct
$creadsPrec :: Int -> ReadS CreateProduct
Prelude.Read, Int -> CreateProduct -> ShowS
[CreateProduct] -> ShowS
CreateProduct -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProduct] -> ShowS
$cshowList :: [CreateProduct] -> ShowS
show :: CreateProduct -> String
$cshow :: CreateProduct -> String
showsPrec :: Int -> CreateProduct -> ShowS
$cshowsPrec :: Int -> CreateProduct -> ShowS
Prelude.Show, forall x. Rep CreateProduct x -> CreateProduct
forall x. CreateProduct -> Rep CreateProduct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateProduct x -> CreateProduct
$cfrom :: forall x. CreateProduct -> Rep CreateProduct x
Prelude.Generic)

-- |
-- Create a value of 'CreateProduct' 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', 'createProduct_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'description', 'createProduct_description' - The description of the product.
--
-- 'distributor', 'createProduct_distributor' - The distributor of the product.
--
-- 'provisioningArtifactParameters', 'createProduct_provisioningArtifactParameters' - The configuration of the provisioning artifact.
--
-- 'sourceConnection', 'createProduct_sourceConnection' - Specifies connection details for the created product and syncs the
-- product to the connection source artifact. This automatically manages
-- the product\'s artifacts based on changes to the source. The
-- @SourceConnection@ parameter consists of the following sub-fields.
--
-- -   @Type@
--
-- -   @ConnectionParamters@
--
-- 'supportDescription', 'createProduct_supportDescription' - The support information about the product.
--
-- 'supportEmail', 'createProduct_supportEmail' - The contact email for product support.
--
-- 'supportUrl', 'createProduct_supportUrl' - The contact URL for product support.
--
-- @^https?:\\\/\\\/\/ @\/ is the pattern used to validate SupportUrl.
--
-- 'tags', 'createProduct_tags' - One or more tags.
--
-- 'name', 'createProduct_name' - The name of the product.
--
-- 'owner', 'createProduct_owner' - The owner of the product.
--
-- 'productType', 'createProduct_productType' - The type of product.
--
-- 'idempotencyToken', 'createProduct_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.
newCreateProduct ::
  -- | 'name'
  Prelude.Text ->
  -- | 'owner'
  Prelude.Text ->
  -- | 'productType'
  ProductType ->
  -- | 'idempotencyToken'
  Prelude.Text ->
  CreateProduct
newCreateProduct :: Text -> Text -> ProductType -> Text -> CreateProduct
newCreateProduct
  Text
pName_
  Text
pOwner_
  ProductType
pProductType_
  Text
pIdempotencyToken_ =
    CreateProduct'
      { $sel:acceptLanguage:CreateProduct' :: Maybe Text
acceptLanguage = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateProduct' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:distributor:CreateProduct' :: Maybe Text
distributor = forall a. Maybe a
Prelude.Nothing,
        $sel:provisioningArtifactParameters:CreateProduct' :: Maybe ProvisioningArtifactProperties
provisioningArtifactParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceConnection:CreateProduct' :: Maybe SourceConnection
sourceConnection = forall a. Maybe a
Prelude.Nothing,
        $sel:supportDescription:CreateProduct' :: Maybe Text
supportDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:supportEmail:CreateProduct' :: Maybe Text
supportEmail = forall a. Maybe a
Prelude.Nothing,
        $sel:supportUrl:CreateProduct' :: Maybe Text
supportUrl = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateProduct' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateProduct' :: Text
name = Text
pName_,
        $sel:owner:CreateProduct' :: Text
owner = Text
pOwner_,
        $sel:productType:CreateProduct' :: ProductType
productType = ProductType
pProductType_,
        $sel:idempotencyToken:CreateProduct' :: Text
idempotencyToken = Text
pIdempotencyToken_
      }

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

-- | The description of the product.
createProduct_description :: Lens.Lens' CreateProduct (Prelude.Maybe Prelude.Text)
createProduct_description :: Lens' CreateProduct (Maybe Text)
createProduct_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Maybe Text
description :: Maybe Text
$sel:description:CreateProduct' :: CreateProduct -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateProduct
s@CreateProduct' {} Maybe Text
a -> CreateProduct
s {$sel:description:CreateProduct' :: Maybe Text
description = Maybe Text
a} :: CreateProduct)

-- | The distributor of the product.
createProduct_distributor :: Lens.Lens' CreateProduct (Prelude.Maybe Prelude.Text)
createProduct_distributor :: Lens' CreateProduct (Maybe Text)
createProduct_distributor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Maybe Text
distributor :: Maybe Text
$sel:distributor:CreateProduct' :: CreateProduct -> Maybe Text
distributor} -> Maybe Text
distributor) (\s :: CreateProduct
s@CreateProduct' {} Maybe Text
a -> CreateProduct
s {$sel:distributor:CreateProduct' :: Maybe Text
distributor = Maybe Text
a} :: CreateProduct)

-- | The configuration of the provisioning artifact.
createProduct_provisioningArtifactParameters :: Lens.Lens' CreateProduct (Prelude.Maybe ProvisioningArtifactProperties)
createProduct_provisioningArtifactParameters :: Lens' CreateProduct (Maybe ProvisioningArtifactProperties)
createProduct_provisioningArtifactParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Maybe ProvisioningArtifactProperties
provisioningArtifactParameters :: Maybe ProvisioningArtifactProperties
$sel:provisioningArtifactParameters:CreateProduct' :: CreateProduct -> Maybe ProvisioningArtifactProperties
provisioningArtifactParameters} -> Maybe ProvisioningArtifactProperties
provisioningArtifactParameters) (\s :: CreateProduct
s@CreateProduct' {} Maybe ProvisioningArtifactProperties
a -> CreateProduct
s {$sel:provisioningArtifactParameters:CreateProduct' :: Maybe ProvisioningArtifactProperties
provisioningArtifactParameters = Maybe ProvisioningArtifactProperties
a} :: CreateProduct)

-- | Specifies connection details for the created product and syncs the
-- product to the connection source artifact. This automatically manages
-- the product\'s artifacts based on changes to the source. The
-- @SourceConnection@ parameter consists of the following sub-fields.
--
-- -   @Type@
--
-- -   @ConnectionParamters@
createProduct_sourceConnection :: Lens.Lens' CreateProduct (Prelude.Maybe SourceConnection)
createProduct_sourceConnection :: Lens' CreateProduct (Maybe SourceConnection)
createProduct_sourceConnection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Maybe SourceConnection
sourceConnection :: Maybe SourceConnection
$sel:sourceConnection:CreateProduct' :: CreateProduct -> Maybe SourceConnection
sourceConnection} -> Maybe SourceConnection
sourceConnection) (\s :: CreateProduct
s@CreateProduct' {} Maybe SourceConnection
a -> CreateProduct
s {$sel:sourceConnection:CreateProduct' :: Maybe SourceConnection
sourceConnection = Maybe SourceConnection
a} :: CreateProduct)

-- | The support information about the product.
createProduct_supportDescription :: Lens.Lens' CreateProduct (Prelude.Maybe Prelude.Text)
createProduct_supportDescription :: Lens' CreateProduct (Maybe Text)
createProduct_supportDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Maybe Text
supportDescription :: Maybe Text
$sel:supportDescription:CreateProduct' :: CreateProduct -> Maybe Text
supportDescription} -> Maybe Text
supportDescription) (\s :: CreateProduct
s@CreateProduct' {} Maybe Text
a -> CreateProduct
s {$sel:supportDescription:CreateProduct' :: Maybe Text
supportDescription = Maybe Text
a} :: CreateProduct)

-- | The contact email for product support.
createProduct_supportEmail :: Lens.Lens' CreateProduct (Prelude.Maybe Prelude.Text)
createProduct_supportEmail :: Lens' CreateProduct (Maybe Text)
createProduct_supportEmail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Maybe Text
supportEmail :: Maybe Text
$sel:supportEmail:CreateProduct' :: CreateProduct -> Maybe Text
supportEmail} -> Maybe Text
supportEmail) (\s :: CreateProduct
s@CreateProduct' {} Maybe Text
a -> CreateProduct
s {$sel:supportEmail:CreateProduct' :: Maybe Text
supportEmail = Maybe Text
a} :: CreateProduct)

-- | The contact URL for product support.
--
-- @^https?:\\\/\\\/\/ @\/ is the pattern used to validate SupportUrl.
createProduct_supportUrl :: Lens.Lens' CreateProduct (Prelude.Maybe Prelude.Text)
createProduct_supportUrl :: Lens' CreateProduct (Maybe Text)
createProduct_supportUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Maybe Text
supportUrl :: Maybe Text
$sel:supportUrl:CreateProduct' :: CreateProduct -> Maybe Text
supportUrl} -> Maybe Text
supportUrl) (\s :: CreateProduct
s@CreateProduct' {} Maybe Text
a -> CreateProduct
s {$sel:supportUrl:CreateProduct' :: Maybe Text
supportUrl = Maybe Text
a} :: CreateProduct)

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

-- | The owner of the product.
createProduct_owner :: Lens.Lens' CreateProduct Prelude.Text
createProduct_owner :: Lens' CreateProduct Text
createProduct_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Text
owner :: Text
$sel:owner:CreateProduct' :: CreateProduct -> Text
owner} -> Text
owner) (\s :: CreateProduct
s@CreateProduct' {} Text
a -> CreateProduct
s {$sel:owner:CreateProduct' :: Text
owner = Text
a} :: CreateProduct)

-- | The type of product.
createProduct_productType :: Lens.Lens' CreateProduct ProductType
createProduct_productType :: Lens' CreateProduct ProductType
createProduct_productType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {ProductType
productType :: ProductType
$sel:productType:CreateProduct' :: CreateProduct -> ProductType
productType} -> ProductType
productType) (\s :: CreateProduct
s@CreateProduct' {} ProductType
a -> CreateProduct
s {$sel:productType:CreateProduct' :: ProductType
productType = ProductType
a} :: CreateProduct)

-- | 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.
createProduct_idempotencyToken :: Lens.Lens' CreateProduct Prelude.Text
createProduct_idempotencyToken :: Lens' CreateProduct Text
createProduct_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProduct' {Text
idempotencyToken :: Text
$sel:idempotencyToken:CreateProduct' :: CreateProduct -> Text
idempotencyToken} -> Text
idempotencyToken) (\s :: CreateProduct
s@CreateProduct' {} Text
a -> CreateProduct
s {$sel:idempotencyToken:CreateProduct' :: Text
idempotencyToken = Text
a} :: CreateProduct)

instance Core.AWSRequest CreateProduct where
  type
    AWSResponse CreateProduct =
      CreateProductResponse
  request :: (Service -> Service) -> CreateProduct -> Request CreateProduct
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 CreateProduct
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateProduct)))
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 ProductViewDetail
-> Maybe ProvisioningArtifactDetail
-> Maybe [Tag]
-> Int
-> CreateProductResponse
CreateProductResponse'
            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
"ProductViewDetail")
            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
"ProvisioningArtifactDetail")
            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
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateProduct where
  hashWithSalt :: Int -> CreateProduct -> Int
hashWithSalt Int
_salt CreateProduct' {Maybe [Tag]
Maybe Text
Maybe ProvisioningArtifactProperties
Maybe SourceConnection
Text
ProductType
idempotencyToken :: Text
productType :: ProductType
owner :: Text
name :: Text
tags :: Maybe [Tag]
supportUrl :: Maybe Text
supportEmail :: Maybe Text
supportDescription :: Maybe Text
sourceConnection :: Maybe SourceConnection
provisioningArtifactParameters :: Maybe ProvisioningArtifactProperties
distributor :: Maybe Text
description :: Maybe Text
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateProduct' :: CreateProduct -> Text
$sel:productType:CreateProduct' :: CreateProduct -> ProductType
$sel:owner:CreateProduct' :: CreateProduct -> Text
$sel:name:CreateProduct' :: CreateProduct -> Text
$sel:tags:CreateProduct' :: CreateProduct -> Maybe [Tag]
$sel:supportUrl:CreateProduct' :: CreateProduct -> Maybe Text
$sel:supportEmail:CreateProduct' :: CreateProduct -> Maybe Text
$sel:supportDescription:CreateProduct' :: CreateProduct -> Maybe Text
$sel:sourceConnection:CreateProduct' :: CreateProduct -> Maybe SourceConnection
$sel:provisioningArtifactParameters:CreateProduct' :: CreateProduct -> Maybe ProvisioningArtifactProperties
$sel:distributor:CreateProduct' :: CreateProduct -> Maybe Text
$sel:description:CreateProduct' :: CreateProduct -> Maybe Text
$sel:acceptLanguage:CreateProduct' :: CreateProduct -> 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
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
distributor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProvisioningArtifactProperties
provisioningArtifactParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceConnection
sourceConnection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
supportDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
supportEmail
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
supportUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
owner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ProductType
productType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
idempotencyToken

instance Prelude.NFData CreateProduct where
  rnf :: CreateProduct -> ()
rnf CreateProduct' {Maybe [Tag]
Maybe Text
Maybe ProvisioningArtifactProperties
Maybe SourceConnection
Text
ProductType
idempotencyToken :: Text
productType :: ProductType
owner :: Text
name :: Text
tags :: Maybe [Tag]
supportUrl :: Maybe Text
supportEmail :: Maybe Text
supportDescription :: Maybe Text
sourceConnection :: Maybe SourceConnection
provisioningArtifactParameters :: Maybe ProvisioningArtifactProperties
distributor :: Maybe Text
description :: Maybe Text
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateProduct' :: CreateProduct -> Text
$sel:productType:CreateProduct' :: CreateProduct -> ProductType
$sel:owner:CreateProduct' :: CreateProduct -> Text
$sel:name:CreateProduct' :: CreateProduct -> Text
$sel:tags:CreateProduct' :: CreateProduct -> Maybe [Tag]
$sel:supportUrl:CreateProduct' :: CreateProduct -> Maybe Text
$sel:supportEmail:CreateProduct' :: CreateProduct -> Maybe Text
$sel:supportDescription:CreateProduct' :: CreateProduct -> Maybe Text
$sel:sourceConnection:CreateProduct' :: CreateProduct -> Maybe SourceConnection
$sel:provisioningArtifactParameters:CreateProduct' :: CreateProduct -> Maybe ProvisioningArtifactProperties
$sel:distributor:CreateProduct' :: CreateProduct -> Maybe Text
$sel:description:CreateProduct' :: CreateProduct -> Maybe Text
$sel:acceptLanguage:CreateProduct' :: CreateProduct -> 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
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
distributor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProvisioningArtifactProperties
provisioningArtifactParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourceConnection
sourceConnection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
supportDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
supportEmail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
supportUrl
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
owner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProductType
productType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
idempotencyToken

instance Data.ToHeaders CreateProduct where
  toHeaders :: CreateProduct -> 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.CreateProduct" ::
                          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 CreateProduct where
  toJSON :: CreateProduct -> Value
toJSON CreateProduct' {Maybe [Tag]
Maybe Text
Maybe ProvisioningArtifactProperties
Maybe SourceConnection
Text
ProductType
idempotencyToken :: Text
productType :: ProductType
owner :: Text
name :: Text
tags :: Maybe [Tag]
supportUrl :: Maybe Text
supportEmail :: Maybe Text
supportDescription :: Maybe Text
sourceConnection :: Maybe SourceConnection
provisioningArtifactParameters :: Maybe ProvisioningArtifactProperties
distributor :: Maybe Text
description :: Maybe Text
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateProduct' :: CreateProduct -> Text
$sel:productType:CreateProduct' :: CreateProduct -> ProductType
$sel:owner:CreateProduct' :: CreateProduct -> Text
$sel:name:CreateProduct' :: CreateProduct -> Text
$sel:tags:CreateProduct' :: CreateProduct -> Maybe [Tag]
$sel:supportUrl:CreateProduct' :: CreateProduct -> Maybe Text
$sel:supportEmail:CreateProduct' :: CreateProduct -> Maybe Text
$sel:supportDescription:CreateProduct' :: CreateProduct -> Maybe Text
$sel:sourceConnection:CreateProduct' :: CreateProduct -> Maybe SourceConnection
$sel:provisioningArtifactParameters:CreateProduct' :: CreateProduct -> Maybe ProvisioningArtifactProperties
$sel:distributor:CreateProduct' :: CreateProduct -> Maybe Text
$sel:description:CreateProduct' :: CreateProduct -> Maybe Text
$sel:acceptLanguage:CreateProduct' :: CreateProduct -> 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
"Description" 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
description,
            (Key
"Distributor" 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
distributor,
            (Key
"ProvisioningArtifactParameters" 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 ProvisioningArtifactProperties
provisioningArtifactParameters,
            (Key
"SourceConnection" 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 SourceConnection
sourceConnection,
            (Key
"SupportDescription" 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
supportDescription,
            (Key
"SupportEmail" 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
supportEmail,
            (Key
"SupportUrl" 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
supportUrl,
            (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
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Owner" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
owner),
            forall a. a -> Maybe a
Prelude.Just (Key
"ProductType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ProductType
productType),
            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 CreateProduct where
  toPath :: CreateProduct -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCreateProductResponse' smart constructor.
data CreateProductResponse = CreateProductResponse'
  { -- | Information about the product view.
    CreateProductResponse -> Maybe ProductViewDetail
productViewDetail :: Prelude.Maybe ProductViewDetail,
    -- | Information about the provisioning artifact.
    CreateProductResponse -> Maybe ProvisioningArtifactDetail
provisioningArtifactDetail :: Prelude.Maybe ProvisioningArtifactDetail,
    -- | Information about the tags associated with the product.
    CreateProductResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    CreateProductResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateProductResponse -> CreateProductResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProductResponse -> CreateProductResponse -> Bool
$c/= :: CreateProductResponse -> CreateProductResponse -> Bool
== :: CreateProductResponse -> CreateProductResponse -> Bool
$c== :: CreateProductResponse -> CreateProductResponse -> Bool
Prelude.Eq, ReadPrec [CreateProductResponse]
ReadPrec CreateProductResponse
Int -> ReadS CreateProductResponse
ReadS [CreateProductResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateProductResponse]
$creadListPrec :: ReadPrec [CreateProductResponse]
readPrec :: ReadPrec CreateProductResponse
$creadPrec :: ReadPrec CreateProductResponse
readList :: ReadS [CreateProductResponse]
$creadList :: ReadS [CreateProductResponse]
readsPrec :: Int -> ReadS CreateProductResponse
$creadsPrec :: Int -> ReadS CreateProductResponse
Prelude.Read, Int -> CreateProductResponse -> ShowS
[CreateProductResponse] -> ShowS
CreateProductResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProductResponse] -> ShowS
$cshowList :: [CreateProductResponse] -> ShowS
show :: CreateProductResponse -> String
$cshow :: CreateProductResponse -> String
showsPrec :: Int -> CreateProductResponse -> ShowS
$cshowsPrec :: Int -> CreateProductResponse -> ShowS
Prelude.Show, forall x. Rep CreateProductResponse x -> CreateProductResponse
forall x. CreateProductResponse -> Rep CreateProductResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateProductResponse x -> CreateProductResponse
$cfrom :: forall x. CreateProductResponse -> Rep CreateProductResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateProductResponse' 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:
--
-- 'productViewDetail', 'createProductResponse_productViewDetail' - Information about the product view.
--
-- 'provisioningArtifactDetail', 'createProductResponse_provisioningArtifactDetail' - Information about the provisioning artifact.
--
-- 'tags', 'createProductResponse_tags' - Information about the tags associated with the product.
--
-- 'httpStatus', 'createProductResponse_httpStatus' - The response's http status code.
newCreateProductResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateProductResponse
newCreateProductResponse :: Int -> CreateProductResponse
newCreateProductResponse Int
pHttpStatus_ =
  CreateProductResponse'
    { $sel:productViewDetail:CreateProductResponse' :: Maybe ProductViewDetail
productViewDetail =
        forall a. Maybe a
Prelude.Nothing,
      $sel:provisioningArtifactDetail:CreateProductResponse' :: Maybe ProvisioningArtifactDetail
provisioningArtifactDetail = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateProductResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateProductResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the product view.
createProductResponse_productViewDetail :: Lens.Lens' CreateProductResponse (Prelude.Maybe ProductViewDetail)
createProductResponse_productViewDetail :: Lens' CreateProductResponse (Maybe ProductViewDetail)
createProductResponse_productViewDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProductResponse' {Maybe ProductViewDetail
productViewDetail :: Maybe ProductViewDetail
$sel:productViewDetail:CreateProductResponse' :: CreateProductResponse -> Maybe ProductViewDetail
productViewDetail} -> Maybe ProductViewDetail
productViewDetail) (\s :: CreateProductResponse
s@CreateProductResponse' {} Maybe ProductViewDetail
a -> CreateProductResponse
s {$sel:productViewDetail:CreateProductResponse' :: Maybe ProductViewDetail
productViewDetail = Maybe ProductViewDetail
a} :: CreateProductResponse)

-- | Information about the provisioning artifact.
createProductResponse_provisioningArtifactDetail :: Lens.Lens' CreateProductResponse (Prelude.Maybe ProvisioningArtifactDetail)
createProductResponse_provisioningArtifactDetail :: Lens' CreateProductResponse (Maybe ProvisioningArtifactDetail)
createProductResponse_provisioningArtifactDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProductResponse' {Maybe ProvisioningArtifactDetail
provisioningArtifactDetail :: Maybe ProvisioningArtifactDetail
$sel:provisioningArtifactDetail:CreateProductResponse' :: CreateProductResponse -> Maybe ProvisioningArtifactDetail
provisioningArtifactDetail} -> Maybe ProvisioningArtifactDetail
provisioningArtifactDetail) (\s :: CreateProductResponse
s@CreateProductResponse' {} Maybe ProvisioningArtifactDetail
a -> CreateProductResponse
s {$sel:provisioningArtifactDetail:CreateProductResponse' :: Maybe ProvisioningArtifactDetail
provisioningArtifactDetail = Maybe ProvisioningArtifactDetail
a} :: CreateProductResponse)

-- | Information about the tags associated with the product.
createProductResponse_tags :: Lens.Lens' CreateProductResponse (Prelude.Maybe [Tag])
createProductResponse_tags :: Lens' CreateProductResponse (Maybe [Tag])
createProductResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProductResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateProductResponse' :: CreateProductResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateProductResponse
s@CreateProductResponse' {} Maybe [Tag]
a -> CreateProductResponse
s {$sel:tags:CreateProductResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateProductResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData CreateProductResponse where
  rnf :: CreateProductResponse -> ()
rnf CreateProductResponse' {Int
Maybe [Tag]
Maybe ProvisioningArtifactDetail
Maybe ProductViewDetail
httpStatus :: Int
tags :: Maybe [Tag]
provisioningArtifactDetail :: Maybe ProvisioningArtifactDetail
productViewDetail :: Maybe ProductViewDetail
$sel:httpStatus:CreateProductResponse' :: CreateProductResponse -> Int
$sel:tags:CreateProductResponse' :: CreateProductResponse -> Maybe [Tag]
$sel:provisioningArtifactDetail:CreateProductResponse' :: CreateProductResponse -> Maybe ProvisioningArtifactDetail
$sel:productViewDetail:CreateProductResponse' :: CreateProductResponse -> Maybe ProductViewDetail
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ProductViewDetail
productViewDetail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProvisioningArtifactDetail
provisioningArtifactDetail
      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 Int
httpStatus