{-# 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.GetProvisionedProductOutputs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This API takes either a @ProvisonedProductId@ or a
-- @ProvisionedProductName@, along with a list of one or more output keys,
-- and responds with the key\/value pairs of those outputs.
module Amazonka.ServiceCatalog.GetProvisionedProductOutputs
  ( -- * Creating a Request
    GetProvisionedProductOutputs (..),
    newGetProvisionedProductOutputs,

    -- * Request Lenses
    getProvisionedProductOutputs_acceptLanguage,
    getProvisionedProductOutputs_outputKeys,
    getProvisionedProductOutputs_pageSize,
    getProvisionedProductOutputs_pageToken,
    getProvisionedProductOutputs_provisionedProductId,
    getProvisionedProductOutputs_provisionedProductName,

    -- * Destructuring the Response
    GetProvisionedProductOutputsResponse (..),
    newGetProvisionedProductOutputsResponse,

    -- * Response Lenses
    getProvisionedProductOutputsResponse_nextPageToken,
    getProvisionedProductOutputsResponse_outputs,
    getProvisionedProductOutputsResponse_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:/ 'newGetProvisionedProductOutputs' smart constructor.
data GetProvisionedProductOutputs = GetProvisionedProductOutputs'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    GetProvisionedProductOutputs -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The list of keys that the API should return with their values. If none
    -- are provided, the API will return all outputs of the provisioned
    -- product.
    GetProvisionedProductOutputs -> Maybe [Text]
outputKeys :: Prelude.Maybe [Prelude.Text],
    -- | The maximum number of items to return with this call.
    GetProvisionedProductOutputs -> Maybe Natural
pageSize :: Prelude.Maybe Prelude.Natural,
    -- | The page token for the next set of results. To retrieve the first set of
    -- results, use null.
    GetProvisionedProductOutputs -> Maybe Text
pageToken :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the provisioned product that you want the outputs
    -- from.
    GetProvisionedProductOutputs -> Maybe Text
provisionedProductId :: Prelude.Maybe Prelude.Text,
    -- | The name of the provisioned product that you want the outputs from.
    GetProvisionedProductOutputs -> Maybe Text
provisionedProductName :: Prelude.Maybe Prelude.Text
  }
  deriving (GetProvisionedProductOutputs
-> GetProvisionedProductOutputs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProvisionedProductOutputs
-> GetProvisionedProductOutputs -> Bool
$c/= :: GetProvisionedProductOutputs
-> GetProvisionedProductOutputs -> Bool
== :: GetProvisionedProductOutputs
-> GetProvisionedProductOutputs -> Bool
$c== :: GetProvisionedProductOutputs
-> GetProvisionedProductOutputs -> Bool
Prelude.Eq, ReadPrec [GetProvisionedProductOutputs]
ReadPrec GetProvisionedProductOutputs
Int -> ReadS GetProvisionedProductOutputs
ReadS [GetProvisionedProductOutputs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProvisionedProductOutputs]
$creadListPrec :: ReadPrec [GetProvisionedProductOutputs]
readPrec :: ReadPrec GetProvisionedProductOutputs
$creadPrec :: ReadPrec GetProvisionedProductOutputs
readList :: ReadS [GetProvisionedProductOutputs]
$creadList :: ReadS [GetProvisionedProductOutputs]
readsPrec :: Int -> ReadS GetProvisionedProductOutputs
$creadsPrec :: Int -> ReadS GetProvisionedProductOutputs
Prelude.Read, Int -> GetProvisionedProductOutputs -> ShowS
[GetProvisionedProductOutputs] -> ShowS
GetProvisionedProductOutputs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProvisionedProductOutputs] -> ShowS
$cshowList :: [GetProvisionedProductOutputs] -> ShowS
show :: GetProvisionedProductOutputs -> String
$cshow :: GetProvisionedProductOutputs -> String
showsPrec :: Int -> GetProvisionedProductOutputs -> ShowS
$cshowsPrec :: Int -> GetProvisionedProductOutputs -> ShowS
Prelude.Show, forall x.
Rep GetProvisionedProductOutputs x -> GetProvisionedProductOutputs
forall x.
GetProvisionedProductOutputs -> Rep GetProvisionedProductOutputs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetProvisionedProductOutputs x -> GetProvisionedProductOutputs
$cfrom :: forall x.
GetProvisionedProductOutputs -> Rep GetProvisionedProductOutputs x
Prelude.Generic)

-- |
-- Create a value of 'GetProvisionedProductOutputs' 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', 'getProvisionedProductOutputs_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'outputKeys', 'getProvisionedProductOutputs_outputKeys' - The list of keys that the API should return with their values. If none
-- are provided, the API will return all outputs of the provisioned
-- product.
--
-- 'pageSize', 'getProvisionedProductOutputs_pageSize' - The maximum number of items to return with this call.
--
-- 'pageToken', 'getProvisionedProductOutputs_pageToken' - The page token for the next set of results. To retrieve the first set of
-- results, use null.
--
-- 'provisionedProductId', 'getProvisionedProductOutputs_provisionedProductId' - The identifier of the provisioned product that you want the outputs
-- from.
--
-- 'provisionedProductName', 'getProvisionedProductOutputs_provisionedProductName' - The name of the provisioned product that you want the outputs from.
newGetProvisionedProductOutputs ::
  GetProvisionedProductOutputs
newGetProvisionedProductOutputs :: GetProvisionedProductOutputs
newGetProvisionedProductOutputs =
  GetProvisionedProductOutputs'
    { $sel:acceptLanguage:GetProvisionedProductOutputs' :: Maybe Text
acceptLanguage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:outputKeys:GetProvisionedProductOutputs' :: Maybe [Text]
outputKeys = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:GetProvisionedProductOutputs' :: Maybe Natural
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:pageToken:GetProvisionedProductOutputs' :: Maybe Text
pageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedProductId:GetProvisionedProductOutputs' :: Maybe Text
provisionedProductId = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedProductName:GetProvisionedProductOutputs' :: Maybe Text
provisionedProductName = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The list of keys that the API should return with their values. If none
-- are provided, the API will return all outputs of the provisioned
-- product.
getProvisionedProductOutputs_outputKeys :: Lens.Lens' GetProvisionedProductOutputs (Prelude.Maybe [Prelude.Text])
getProvisionedProductOutputs_outputKeys :: Lens' GetProvisionedProductOutputs (Maybe [Text])
getProvisionedProductOutputs_outputKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedProductOutputs' {Maybe [Text]
outputKeys :: Maybe [Text]
$sel:outputKeys:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe [Text]
outputKeys} -> Maybe [Text]
outputKeys) (\s :: GetProvisionedProductOutputs
s@GetProvisionedProductOutputs' {} Maybe [Text]
a -> GetProvisionedProductOutputs
s {$sel:outputKeys:GetProvisionedProductOutputs' :: Maybe [Text]
outputKeys = Maybe [Text]
a} :: GetProvisionedProductOutputs) 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 maximum number of items to return with this call.
getProvisionedProductOutputs_pageSize :: Lens.Lens' GetProvisionedProductOutputs (Prelude.Maybe Prelude.Natural)
getProvisionedProductOutputs_pageSize :: Lens' GetProvisionedProductOutputs (Maybe Natural)
getProvisionedProductOutputs_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedProductOutputs' {Maybe Natural
pageSize :: Maybe Natural
$sel:pageSize:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Natural
pageSize} -> Maybe Natural
pageSize) (\s :: GetProvisionedProductOutputs
s@GetProvisionedProductOutputs' {} Maybe Natural
a -> GetProvisionedProductOutputs
s {$sel:pageSize:GetProvisionedProductOutputs' :: Maybe Natural
pageSize = Maybe Natural
a} :: GetProvisionedProductOutputs)

-- | The page token for the next set of results. To retrieve the first set of
-- results, use null.
getProvisionedProductOutputs_pageToken :: Lens.Lens' GetProvisionedProductOutputs (Prelude.Maybe Prelude.Text)
getProvisionedProductOutputs_pageToken :: Lens' GetProvisionedProductOutputs (Maybe Text)
getProvisionedProductOutputs_pageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedProductOutputs' {Maybe Text
pageToken :: Maybe Text
$sel:pageToken:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
pageToken} -> Maybe Text
pageToken) (\s :: GetProvisionedProductOutputs
s@GetProvisionedProductOutputs' {} Maybe Text
a -> GetProvisionedProductOutputs
s {$sel:pageToken:GetProvisionedProductOutputs' :: Maybe Text
pageToken = Maybe Text
a} :: GetProvisionedProductOutputs)

-- | The identifier of the provisioned product that you want the outputs
-- from.
getProvisionedProductOutputs_provisionedProductId :: Lens.Lens' GetProvisionedProductOutputs (Prelude.Maybe Prelude.Text)
getProvisionedProductOutputs_provisionedProductId :: Lens' GetProvisionedProductOutputs (Maybe Text)
getProvisionedProductOutputs_provisionedProductId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedProductOutputs' {Maybe Text
provisionedProductId :: Maybe Text
$sel:provisionedProductId:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
provisionedProductId} -> Maybe Text
provisionedProductId) (\s :: GetProvisionedProductOutputs
s@GetProvisionedProductOutputs' {} Maybe Text
a -> GetProvisionedProductOutputs
s {$sel:provisionedProductId:GetProvisionedProductOutputs' :: Maybe Text
provisionedProductId = Maybe Text
a} :: GetProvisionedProductOutputs)

-- | The name of the provisioned product that you want the outputs from.
getProvisionedProductOutputs_provisionedProductName :: Lens.Lens' GetProvisionedProductOutputs (Prelude.Maybe Prelude.Text)
getProvisionedProductOutputs_provisionedProductName :: Lens' GetProvisionedProductOutputs (Maybe Text)
getProvisionedProductOutputs_provisionedProductName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedProductOutputs' {Maybe Text
provisionedProductName :: Maybe Text
$sel:provisionedProductName:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
provisionedProductName} -> Maybe Text
provisionedProductName) (\s :: GetProvisionedProductOutputs
s@GetProvisionedProductOutputs' {} Maybe Text
a -> GetProvisionedProductOutputs
s {$sel:provisionedProductName:GetProvisionedProductOutputs' :: Maybe Text
provisionedProductName = Maybe Text
a} :: GetProvisionedProductOutputs)

instance Core.AWSRequest GetProvisionedProductOutputs where
  type
    AWSResponse GetProvisionedProductOutputs =
      GetProvisionedProductOutputsResponse
  request :: (Service -> Service)
-> GetProvisionedProductOutputs
-> Request GetProvisionedProductOutputs
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 GetProvisionedProductOutputs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetProvisionedProductOutputs)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe [RecordOutput]
-> Int
-> GetProvisionedProductOutputsResponse
GetProvisionedProductOutputsResponse'
            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
"NextPageToken")
            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
"Outputs" 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
    GetProvisionedProductOutputs
  where
  hashWithSalt :: Int -> GetProvisionedProductOutputs -> Int
hashWithSalt Int
_salt GetProvisionedProductOutputs' {Maybe Natural
Maybe [Text]
Maybe Text
provisionedProductName :: Maybe Text
provisionedProductId :: Maybe Text
pageToken :: Maybe Text
pageSize :: Maybe Natural
outputKeys :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:provisionedProductName:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:provisionedProductId:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:pageToken:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:pageSize:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Natural
$sel:outputKeys:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe [Text]
$sel:acceptLanguage:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> 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]
outputKeys
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pageToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
provisionedProductId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
provisionedProductName

instance Prelude.NFData GetProvisionedProductOutputs where
  rnf :: GetProvisionedProductOutputs -> ()
rnf GetProvisionedProductOutputs' {Maybe Natural
Maybe [Text]
Maybe Text
provisionedProductName :: Maybe Text
provisionedProductId :: Maybe Text
pageToken :: Maybe Text
pageSize :: Maybe Natural
outputKeys :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:provisionedProductName:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:provisionedProductId:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:pageToken:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:pageSize:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Natural
$sel:outputKeys:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe [Text]
$sel:acceptLanguage:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> 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]
outputKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
provisionedProductId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
provisionedProductName

instance Data.ToHeaders GetProvisionedProductOutputs where
  toHeaders :: GetProvisionedProductOutputs -> 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.GetProvisionedProductOutputs" ::
                          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 GetProvisionedProductOutputs where
  toJSON :: GetProvisionedProductOutputs -> Value
toJSON GetProvisionedProductOutputs' {Maybe Natural
Maybe [Text]
Maybe Text
provisionedProductName :: Maybe Text
provisionedProductId :: Maybe Text
pageToken :: Maybe Text
pageSize :: Maybe Natural
outputKeys :: Maybe [Text]
acceptLanguage :: Maybe Text
$sel:provisionedProductName:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:provisionedProductId:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:pageToken:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Text
$sel:pageSize:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe Natural
$sel:outputKeys:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> Maybe [Text]
$sel:acceptLanguage:GetProvisionedProductOutputs' :: GetProvisionedProductOutputs -> 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
"OutputKeys" 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]
outputKeys,
            (Key
"PageSize" 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 Natural
pageSize,
            (Key
"PageToken" 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
pageToken,
            (Key
"ProvisionedProductId" 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
provisionedProductId,
            (Key
"ProvisionedProductName" 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
provisionedProductName
          ]
      )

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

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

-- | /See:/ 'newGetProvisionedProductOutputsResponse' smart constructor.
data GetProvisionedProductOutputsResponse = GetProvisionedProductOutputsResponse'
  { -- | The page token to use to retrieve the next set of results. If there are
    -- no additional results, this value is null.
    GetProvisionedProductOutputsResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the product created as the result of a request. For
    -- example, the output for a CloudFormation-backed product that creates an
    -- S3 bucket would include the S3 bucket URL.
    GetProvisionedProductOutputsResponse -> Maybe [RecordOutput]
outputs :: Prelude.Maybe [RecordOutput],
    -- | The response's http status code.
    GetProvisionedProductOutputsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetProvisionedProductOutputsResponse
-> GetProvisionedProductOutputsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProvisionedProductOutputsResponse
-> GetProvisionedProductOutputsResponse -> Bool
$c/= :: GetProvisionedProductOutputsResponse
-> GetProvisionedProductOutputsResponse -> Bool
== :: GetProvisionedProductOutputsResponse
-> GetProvisionedProductOutputsResponse -> Bool
$c== :: GetProvisionedProductOutputsResponse
-> GetProvisionedProductOutputsResponse -> Bool
Prelude.Eq, ReadPrec [GetProvisionedProductOutputsResponse]
ReadPrec GetProvisionedProductOutputsResponse
Int -> ReadS GetProvisionedProductOutputsResponse
ReadS [GetProvisionedProductOutputsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProvisionedProductOutputsResponse]
$creadListPrec :: ReadPrec [GetProvisionedProductOutputsResponse]
readPrec :: ReadPrec GetProvisionedProductOutputsResponse
$creadPrec :: ReadPrec GetProvisionedProductOutputsResponse
readList :: ReadS [GetProvisionedProductOutputsResponse]
$creadList :: ReadS [GetProvisionedProductOutputsResponse]
readsPrec :: Int -> ReadS GetProvisionedProductOutputsResponse
$creadsPrec :: Int -> ReadS GetProvisionedProductOutputsResponse
Prelude.Read, Int -> GetProvisionedProductOutputsResponse -> ShowS
[GetProvisionedProductOutputsResponse] -> ShowS
GetProvisionedProductOutputsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProvisionedProductOutputsResponse] -> ShowS
$cshowList :: [GetProvisionedProductOutputsResponse] -> ShowS
show :: GetProvisionedProductOutputsResponse -> String
$cshow :: GetProvisionedProductOutputsResponse -> String
showsPrec :: Int -> GetProvisionedProductOutputsResponse -> ShowS
$cshowsPrec :: Int -> GetProvisionedProductOutputsResponse -> ShowS
Prelude.Show, forall x.
Rep GetProvisionedProductOutputsResponse x
-> GetProvisionedProductOutputsResponse
forall x.
GetProvisionedProductOutputsResponse
-> Rep GetProvisionedProductOutputsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetProvisionedProductOutputsResponse x
-> GetProvisionedProductOutputsResponse
$cfrom :: forall x.
GetProvisionedProductOutputsResponse
-> Rep GetProvisionedProductOutputsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetProvisionedProductOutputsResponse' 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:
--
-- 'nextPageToken', 'getProvisionedProductOutputsResponse_nextPageToken' - The page token to use to retrieve the next set of results. If there are
-- no additional results, this value is null.
--
-- 'outputs', 'getProvisionedProductOutputsResponse_outputs' - Information about the product created as the result of a request. For
-- example, the output for a CloudFormation-backed product that creates an
-- S3 bucket would include the S3 bucket URL.
--
-- 'httpStatus', 'getProvisionedProductOutputsResponse_httpStatus' - The response's http status code.
newGetProvisionedProductOutputsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetProvisionedProductOutputsResponse
newGetProvisionedProductOutputsResponse :: Int -> GetProvisionedProductOutputsResponse
newGetProvisionedProductOutputsResponse Int
pHttpStatus_ =
  GetProvisionedProductOutputsResponse'
    { $sel:nextPageToken:GetProvisionedProductOutputsResponse' :: Maybe Text
nextPageToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:outputs:GetProvisionedProductOutputsResponse' :: Maybe [RecordOutput]
outputs = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetProvisionedProductOutputsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The page token to use to retrieve the next set of results. If there are
-- no additional results, this value is null.
getProvisionedProductOutputsResponse_nextPageToken :: Lens.Lens' GetProvisionedProductOutputsResponse (Prelude.Maybe Prelude.Text)
getProvisionedProductOutputsResponse_nextPageToken :: Lens' GetProvisionedProductOutputsResponse (Maybe Text)
getProvisionedProductOutputsResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedProductOutputsResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetProvisionedProductOutputsResponse' :: GetProvisionedProductOutputsResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetProvisionedProductOutputsResponse
s@GetProvisionedProductOutputsResponse' {} Maybe Text
a -> GetProvisionedProductOutputsResponse
s {$sel:nextPageToken:GetProvisionedProductOutputsResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetProvisionedProductOutputsResponse)

-- | Information about the product created as the result of a request. For
-- example, the output for a CloudFormation-backed product that creates an
-- S3 bucket would include the S3 bucket URL.
getProvisionedProductOutputsResponse_outputs :: Lens.Lens' GetProvisionedProductOutputsResponse (Prelude.Maybe [RecordOutput])
getProvisionedProductOutputsResponse_outputs :: Lens' GetProvisionedProductOutputsResponse (Maybe [RecordOutput])
getProvisionedProductOutputsResponse_outputs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedProductOutputsResponse' {Maybe [RecordOutput]
outputs :: Maybe [RecordOutput]
$sel:outputs:GetProvisionedProductOutputsResponse' :: GetProvisionedProductOutputsResponse -> Maybe [RecordOutput]
outputs} -> Maybe [RecordOutput]
outputs) (\s :: GetProvisionedProductOutputsResponse
s@GetProvisionedProductOutputsResponse' {} Maybe [RecordOutput]
a -> GetProvisionedProductOutputsResponse
s {$sel:outputs:GetProvisionedProductOutputsResponse' :: Maybe [RecordOutput]
outputs = Maybe [RecordOutput]
a} :: GetProvisionedProductOutputsResponse) 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.
getProvisionedProductOutputsResponse_httpStatus :: Lens.Lens' GetProvisionedProductOutputsResponse Prelude.Int
getProvisionedProductOutputsResponse_httpStatus :: Lens' GetProvisionedProductOutputsResponse Int
getProvisionedProductOutputsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedProductOutputsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetProvisionedProductOutputsResponse' :: GetProvisionedProductOutputsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetProvisionedProductOutputsResponse
s@GetProvisionedProductOutputsResponse' {} Int
a -> GetProvisionedProductOutputsResponse
s {$sel:httpStatus:GetProvisionedProductOutputsResponse' :: Int
httpStatus = Int
a} :: GetProvisionedProductOutputsResponse)

instance
  Prelude.NFData
    GetProvisionedProductOutputsResponse
  where
  rnf :: GetProvisionedProductOutputsResponse -> ()
rnf GetProvisionedProductOutputsResponse' {Int
Maybe [RecordOutput]
Maybe Text
httpStatus :: Int
outputs :: Maybe [RecordOutput]
nextPageToken :: Maybe Text
$sel:httpStatus:GetProvisionedProductOutputsResponse' :: GetProvisionedProductOutputsResponse -> Int
$sel:outputs:GetProvisionedProductOutputsResponse' :: GetProvisionedProductOutputsResponse -> Maybe [RecordOutput]
$sel:nextPageToken:GetProvisionedProductOutputsResponse' :: GetProvisionedProductOutputsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RecordOutput]
outputs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus