{-# 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.DescribeProduct
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about the specified product.
module Amazonka.ServiceCatalog.DescribeProduct
  ( -- * Creating a Request
    DescribeProduct (..),
    newDescribeProduct,

    -- * Request Lenses
    describeProduct_acceptLanguage,
    describeProduct_id,
    describeProduct_name,

    -- * Destructuring the Response
    DescribeProductResponse (..),
    newDescribeProductResponse,

    -- * Response Lenses
    describeProductResponse_budgets,
    describeProductResponse_launchPaths,
    describeProductResponse_productViewSummary,
    describeProductResponse_provisioningArtifacts,
    describeProductResponse_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:/ 'newDescribeProduct' smart constructor.
data DescribeProduct = DescribeProduct'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    DescribeProduct -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The product identifier.
    DescribeProduct -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The product name.
    DescribeProduct -> Maybe Text
name :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeProduct -> DescribeProduct -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeProduct -> DescribeProduct -> Bool
$c/= :: DescribeProduct -> DescribeProduct -> Bool
== :: DescribeProduct -> DescribeProduct -> Bool
$c== :: DescribeProduct -> DescribeProduct -> Bool
Prelude.Eq, ReadPrec [DescribeProduct]
ReadPrec DescribeProduct
Int -> ReadS DescribeProduct
ReadS [DescribeProduct]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeProduct]
$creadListPrec :: ReadPrec [DescribeProduct]
readPrec :: ReadPrec DescribeProduct
$creadPrec :: ReadPrec DescribeProduct
readList :: ReadS [DescribeProduct]
$creadList :: ReadS [DescribeProduct]
readsPrec :: Int -> ReadS DescribeProduct
$creadsPrec :: Int -> ReadS DescribeProduct
Prelude.Read, Int -> DescribeProduct -> ShowS
[DescribeProduct] -> ShowS
DescribeProduct -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeProduct] -> ShowS
$cshowList :: [DescribeProduct] -> ShowS
show :: DescribeProduct -> String
$cshow :: DescribeProduct -> String
showsPrec :: Int -> DescribeProduct -> ShowS
$cshowsPrec :: Int -> DescribeProduct -> ShowS
Prelude.Show, forall x. Rep DescribeProduct x -> DescribeProduct
forall x. DescribeProduct -> Rep DescribeProduct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeProduct x -> DescribeProduct
$cfrom :: forall x. DescribeProduct -> Rep DescribeProduct x
Prelude.Generic)

-- |
-- Create a value of 'DescribeProduct' 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', 'describeProduct_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'id', 'describeProduct_id' - The product identifier.
--
-- 'name', 'describeProduct_name' - The product name.
newDescribeProduct ::
  DescribeProduct
newDescribeProduct :: DescribeProduct
newDescribeProduct =
  DescribeProduct'
    { $sel:acceptLanguage:DescribeProduct' :: Maybe Text
acceptLanguage = forall a. Maybe a
Prelude.Nothing,
      $sel:id:DescribeProduct' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeProduct' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing
    }

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

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

-- | The product name.
describeProduct_name :: Lens.Lens' DescribeProduct (Prelude.Maybe Prelude.Text)
describeProduct_name :: Lens' DescribeProduct (Maybe Text)
describeProduct_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProduct' {Maybe Text
name :: Maybe Text
$sel:name:DescribeProduct' :: DescribeProduct -> Maybe Text
name} -> Maybe Text
name) (\s :: DescribeProduct
s@DescribeProduct' {} Maybe Text
a -> DescribeProduct
s {$sel:name:DescribeProduct' :: Maybe Text
name = Maybe Text
a} :: DescribeProduct)

instance Core.AWSRequest DescribeProduct where
  type
    AWSResponse DescribeProduct =
      DescribeProductResponse
  request :: (Service -> Service) -> DescribeProduct -> Request DescribeProduct
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 DescribeProduct
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeProduct)))
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 [BudgetDetail]
-> Maybe [LaunchPath]
-> Maybe ProductViewSummary
-> Maybe [ProvisioningArtifact]
-> Int
-> DescribeProductResponse
DescribeProductResponse'
            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
"Budgets" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LaunchPaths" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ProductViewSummary")
            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
"ProvisioningArtifacts"
                            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 DescribeProduct where
  hashWithSalt :: Int -> DescribeProduct -> Int
hashWithSalt Int
_salt DescribeProduct' {Maybe Text
name :: Maybe Text
id :: Maybe Text
acceptLanguage :: Maybe Text
$sel:name:DescribeProduct' :: DescribeProduct -> Maybe Text
$sel:id:DescribeProduct' :: DescribeProduct -> Maybe Text
$sel:acceptLanguage:DescribeProduct' :: DescribeProduct -> 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
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name

instance Prelude.NFData DescribeProduct where
  rnf :: DescribeProduct -> ()
rnf DescribeProduct' {Maybe Text
name :: Maybe Text
id :: Maybe Text
acceptLanguage :: Maybe Text
$sel:name:DescribeProduct' :: DescribeProduct -> Maybe Text
$sel:id:DescribeProduct' :: DescribeProduct -> Maybe Text
$sel:acceptLanguage:DescribeProduct' :: DescribeProduct -> 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
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name

instance Data.ToHeaders DescribeProduct where
  toHeaders :: DescribeProduct -> 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.DescribeProduct" ::
                          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 DescribeProduct where
  toJSON :: DescribeProduct -> Value
toJSON DescribeProduct' {Maybe Text
name :: Maybe Text
id :: Maybe Text
acceptLanguage :: Maybe Text
$sel:name:DescribeProduct' :: DescribeProduct -> Maybe Text
$sel:id:DescribeProduct' :: DescribeProduct -> Maybe Text
$sel:acceptLanguage:DescribeProduct' :: DescribeProduct -> 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
"Id" 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
id,
            (Key
"Name" 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
name
          ]
      )

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

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

-- | /See:/ 'newDescribeProductResponse' smart constructor.
data DescribeProductResponse = DescribeProductResponse'
  { -- | Information about the associated budgets.
    DescribeProductResponse -> Maybe [BudgetDetail]
budgets :: Prelude.Maybe [BudgetDetail],
    -- | Information about the associated launch paths.
    DescribeProductResponse -> Maybe [LaunchPath]
launchPaths :: Prelude.Maybe [LaunchPath],
    -- | Summary information about the product view.
    DescribeProductResponse -> Maybe ProductViewSummary
productViewSummary :: Prelude.Maybe ProductViewSummary,
    -- | Information about the provisioning artifacts for the specified product.
    DescribeProductResponse -> Maybe [ProvisioningArtifact]
provisioningArtifacts :: Prelude.Maybe [ProvisioningArtifact],
    -- | The response's http status code.
    DescribeProductResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeProductResponse -> DescribeProductResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeProductResponse -> DescribeProductResponse -> Bool
$c/= :: DescribeProductResponse -> DescribeProductResponse -> Bool
== :: DescribeProductResponse -> DescribeProductResponse -> Bool
$c== :: DescribeProductResponse -> DescribeProductResponse -> Bool
Prelude.Eq, ReadPrec [DescribeProductResponse]
ReadPrec DescribeProductResponse
Int -> ReadS DescribeProductResponse
ReadS [DescribeProductResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeProductResponse]
$creadListPrec :: ReadPrec [DescribeProductResponse]
readPrec :: ReadPrec DescribeProductResponse
$creadPrec :: ReadPrec DescribeProductResponse
readList :: ReadS [DescribeProductResponse]
$creadList :: ReadS [DescribeProductResponse]
readsPrec :: Int -> ReadS DescribeProductResponse
$creadsPrec :: Int -> ReadS DescribeProductResponse
Prelude.Read, Int -> DescribeProductResponse -> ShowS
[DescribeProductResponse] -> ShowS
DescribeProductResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeProductResponse] -> ShowS
$cshowList :: [DescribeProductResponse] -> ShowS
show :: DescribeProductResponse -> String
$cshow :: DescribeProductResponse -> String
showsPrec :: Int -> DescribeProductResponse -> ShowS
$cshowsPrec :: Int -> DescribeProductResponse -> ShowS
Prelude.Show, forall x. Rep DescribeProductResponse x -> DescribeProductResponse
forall x. DescribeProductResponse -> Rep DescribeProductResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeProductResponse x -> DescribeProductResponse
$cfrom :: forall x. DescribeProductResponse -> Rep DescribeProductResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeProductResponse' 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:
--
-- 'budgets', 'describeProductResponse_budgets' - Information about the associated budgets.
--
-- 'launchPaths', 'describeProductResponse_launchPaths' - Information about the associated launch paths.
--
-- 'productViewSummary', 'describeProductResponse_productViewSummary' - Summary information about the product view.
--
-- 'provisioningArtifacts', 'describeProductResponse_provisioningArtifacts' - Information about the provisioning artifacts for the specified product.
--
-- 'httpStatus', 'describeProductResponse_httpStatus' - The response's http status code.
newDescribeProductResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeProductResponse
newDescribeProductResponse :: Int -> DescribeProductResponse
newDescribeProductResponse Int
pHttpStatus_ =
  DescribeProductResponse'
    { $sel:budgets:DescribeProductResponse' :: Maybe [BudgetDetail]
budgets = forall a. Maybe a
Prelude.Nothing,
      $sel:launchPaths:DescribeProductResponse' :: Maybe [LaunchPath]
launchPaths = forall a. Maybe a
Prelude.Nothing,
      $sel:productViewSummary:DescribeProductResponse' :: Maybe ProductViewSummary
productViewSummary = forall a. Maybe a
Prelude.Nothing,
      $sel:provisioningArtifacts:DescribeProductResponse' :: Maybe [ProvisioningArtifact]
provisioningArtifacts = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeProductResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | Information about the associated launch paths.
describeProductResponse_launchPaths :: Lens.Lens' DescribeProductResponse (Prelude.Maybe [LaunchPath])
describeProductResponse_launchPaths :: Lens' DescribeProductResponse (Maybe [LaunchPath])
describeProductResponse_launchPaths = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProductResponse' {Maybe [LaunchPath]
launchPaths :: Maybe [LaunchPath]
$sel:launchPaths:DescribeProductResponse' :: DescribeProductResponse -> Maybe [LaunchPath]
launchPaths} -> Maybe [LaunchPath]
launchPaths) (\s :: DescribeProductResponse
s@DescribeProductResponse' {} Maybe [LaunchPath]
a -> DescribeProductResponse
s {$sel:launchPaths:DescribeProductResponse' :: Maybe [LaunchPath]
launchPaths = Maybe [LaunchPath]
a} :: DescribeProductResponse) 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

-- | Summary information about the product view.
describeProductResponse_productViewSummary :: Lens.Lens' DescribeProductResponse (Prelude.Maybe ProductViewSummary)
describeProductResponse_productViewSummary :: Lens' DescribeProductResponse (Maybe ProductViewSummary)
describeProductResponse_productViewSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProductResponse' {Maybe ProductViewSummary
productViewSummary :: Maybe ProductViewSummary
$sel:productViewSummary:DescribeProductResponse' :: DescribeProductResponse -> Maybe ProductViewSummary
productViewSummary} -> Maybe ProductViewSummary
productViewSummary) (\s :: DescribeProductResponse
s@DescribeProductResponse' {} Maybe ProductViewSummary
a -> DescribeProductResponse
s {$sel:productViewSummary:DescribeProductResponse' :: Maybe ProductViewSummary
productViewSummary = Maybe ProductViewSummary
a} :: DescribeProductResponse)

-- | Information about the provisioning artifacts for the specified product.
describeProductResponse_provisioningArtifacts :: Lens.Lens' DescribeProductResponse (Prelude.Maybe [ProvisioningArtifact])
describeProductResponse_provisioningArtifacts :: Lens' DescribeProductResponse (Maybe [ProvisioningArtifact])
describeProductResponse_provisioningArtifacts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProductResponse' {Maybe [ProvisioningArtifact]
provisioningArtifacts :: Maybe [ProvisioningArtifact]
$sel:provisioningArtifacts:DescribeProductResponse' :: DescribeProductResponse -> Maybe [ProvisioningArtifact]
provisioningArtifacts} -> Maybe [ProvisioningArtifact]
provisioningArtifacts) (\s :: DescribeProductResponse
s@DescribeProductResponse' {} Maybe [ProvisioningArtifact]
a -> DescribeProductResponse
s {$sel:provisioningArtifacts:DescribeProductResponse' :: Maybe [ProvisioningArtifact]
provisioningArtifacts = Maybe [ProvisioningArtifact]
a} :: DescribeProductResponse) 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.
describeProductResponse_httpStatus :: Lens.Lens' DescribeProductResponse Prelude.Int
describeProductResponse_httpStatus :: Lens' DescribeProductResponse Int
describeProductResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProductResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeProductResponse' :: DescribeProductResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeProductResponse
s@DescribeProductResponse' {} Int
a -> DescribeProductResponse
s {$sel:httpStatus:DescribeProductResponse' :: Int
httpStatus = Int
a} :: DescribeProductResponse)

instance Prelude.NFData DescribeProductResponse where
  rnf :: DescribeProductResponse -> ()
rnf DescribeProductResponse' {Int
Maybe [BudgetDetail]
Maybe [LaunchPath]
Maybe [ProvisioningArtifact]
Maybe ProductViewSummary
httpStatus :: Int
provisioningArtifacts :: Maybe [ProvisioningArtifact]
productViewSummary :: Maybe ProductViewSummary
launchPaths :: Maybe [LaunchPath]
budgets :: Maybe [BudgetDetail]
$sel:httpStatus:DescribeProductResponse' :: DescribeProductResponse -> Int
$sel:provisioningArtifacts:DescribeProductResponse' :: DescribeProductResponse -> Maybe [ProvisioningArtifact]
$sel:productViewSummary:DescribeProductResponse' :: DescribeProductResponse -> Maybe ProductViewSummary
$sel:launchPaths:DescribeProductResponse' :: DescribeProductResponse -> Maybe [LaunchPath]
$sel:budgets:DescribeProductResponse' :: DescribeProductResponse -> Maybe [BudgetDetail]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BudgetDetail]
budgets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LaunchPath]
launchPaths
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProductViewSummary
productViewSummary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ProvisioningArtifact]
provisioningArtifacts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus