{-# 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.DescribeRecord
-- 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 request operation.
--
-- Use this operation after calling a request operation (for example,
-- ProvisionProduct, TerminateProvisionedProduct, or
-- UpdateProvisionedProduct).
--
-- If a provisioned product was transferred to a new owner using
-- UpdateProvisionedProductProperties, the new owner will be able to
-- describe all past records for that product. The previous owner will no
-- longer be able to describe the records, but will be able to use
-- ListRecordHistory to see the product\'s history from when he was the
-- owner.
module Amazonka.ServiceCatalog.DescribeRecord
  ( -- * Creating a Request
    DescribeRecord (..),
    newDescribeRecord,

    -- * Request Lenses
    describeRecord_acceptLanguage,
    describeRecord_pageSize,
    describeRecord_pageToken,
    describeRecord_id,

    -- * Destructuring the Response
    DescribeRecordResponse (..),
    newDescribeRecordResponse,

    -- * Response Lenses
    describeRecordResponse_nextPageToken,
    describeRecordResponse_recordDetail,
    describeRecordResponse_recordOutputs,
    describeRecordResponse_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:/ 'newDescribeRecord' smart constructor.
data DescribeRecord = DescribeRecord'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    DescribeRecord -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of items to return with this call.
    DescribeRecord -> 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.
    DescribeRecord -> Maybe Text
pageToken :: Prelude.Maybe Prelude.Text,
    -- | The record identifier of the provisioned product. This identifier is
    -- returned by the request operation.
    DescribeRecord -> Text
id :: Prelude.Text
  }
  deriving (DescribeRecord -> DescribeRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeRecord -> DescribeRecord -> Bool
$c/= :: DescribeRecord -> DescribeRecord -> Bool
== :: DescribeRecord -> DescribeRecord -> Bool
$c== :: DescribeRecord -> DescribeRecord -> Bool
Prelude.Eq, ReadPrec [DescribeRecord]
ReadPrec DescribeRecord
Int -> ReadS DescribeRecord
ReadS [DescribeRecord]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeRecord]
$creadListPrec :: ReadPrec [DescribeRecord]
readPrec :: ReadPrec DescribeRecord
$creadPrec :: ReadPrec DescribeRecord
readList :: ReadS [DescribeRecord]
$creadList :: ReadS [DescribeRecord]
readsPrec :: Int -> ReadS DescribeRecord
$creadsPrec :: Int -> ReadS DescribeRecord
Prelude.Read, Int -> DescribeRecord -> ShowS
[DescribeRecord] -> ShowS
DescribeRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeRecord] -> ShowS
$cshowList :: [DescribeRecord] -> ShowS
show :: DescribeRecord -> String
$cshow :: DescribeRecord -> String
showsPrec :: Int -> DescribeRecord -> ShowS
$cshowsPrec :: Int -> DescribeRecord -> ShowS
Prelude.Show, forall x. Rep DescribeRecord x -> DescribeRecord
forall x. DescribeRecord -> Rep DescribeRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeRecord x -> DescribeRecord
$cfrom :: forall x. DescribeRecord -> Rep DescribeRecord x
Prelude.Generic)

-- |
-- Create a value of 'DescribeRecord' 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', 'describeRecord_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'pageSize', 'describeRecord_pageSize' - The maximum number of items to return with this call.
--
-- 'pageToken', 'describeRecord_pageToken' - The page token for the next set of results. To retrieve the first set of
-- results, use null.
--
-- 'id', 'describeRecord_id' - The record identifier of the provisioned product. This identifier is
-- returned by the request operation.
newDescribeRecord ::
  -- | 'id'
  Prelude.Text ->
  DescribeRecord
newDescribeRecord :: Text -> DescribeRecord
newDescribeRecord Text
pId_ =
  DescribeRecord'
    { $sel:acceptLanguage:DescribeRecord' :: Maybe Text
acceptLanguage = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:DescribeRecord' :: Maybe Natural
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:pageToken:DescribeRecord' :: Maybe Text
pageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:id:DescribeRecord' :: Text
id = Text
pId_
    }

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

-- | The maximum number of items to return with this call.
describeRecord_pageSize :: Lens.Lens' DescribeRecord (Prelude.Maybe Prelude.Natural)
describeRecord_pageSize :: Lens' DescribeRecord (Maybe Natural)
describeRecord_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecord' {Maybe Natural
pageSize :: Maybe Natural
$sel:pageSize:DescribeRecord' :: DescribeRecord -> Maybe Natural
pageSize} -> Maybe Natural
pageSize) (\s :: DescribeRecord
s@DescribeRecord' {} Maybe Natural
a -> DescribeRecord
s {$sel:pageSize:DescribeRecord' :: Maybe Natural
pageSize = Maybe Natural
a} :: DescribeRecord)

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

-- | The record identifier of the provisioned product. This identifier is
-- returned by the request operation.
describeRecord_id :: Lens.Lens' DescribeRecord Prelude.Text
describeRecord_id :: Lens' DescribeRecord Text
describeRecord_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecord' {Text
id :: Text
$sel:id:DescribeRecord' :: DescribeRecord -> Text
id} -> Text
id) (\s :: DescribeRecord
s@DescribeRecord' {} Text
a -> DescribeRecord
s {$sel:id:DescribeRecord' :: Text
id = Text
a} :: DescribeRecord)

instance Core.AWSRequest DescribeRecord where
  type
    AWSResponse DescribeRecord =
      DescribeRecordResponse
  request :: (Service -> Service) -> DescribeRecord -> Request DescribeRecord
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 DescribeRecord
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeRecord)))
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 RecordDetail
-> Maybe [RecordOutput]
-> Int
-> DescribeRecordResponse
DescribeRecordResponse'
            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
"RecordDetail")
            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
"RecordOutputs" 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 DescribeRecord where
  hashWithSalt :: Int -> DescribeRecord -> Int
hashWithSalt Int
_salt DescribeRecord' {Maybe Natural
Maybe Text
Text
id :: Text
pageToken :: Maybe Text
pageSize :: Maybe Natural
acceptLanguage :: Maybe Text
$sel:id:DescribeRecord' :: DescribeRecord -> Text
$sel:pageToken:DescribeRecord' :: DescribeRecord -> Maybe Text
$sel:pageSize:DescribeRecord' :: DescribeRecord -> Maybe Natural
$sel:acceptLanguage:DescribeRecord' :: DescribeRecord -> 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 Natural
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pageToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData DescribeRecord where
  rnf :: DescribeRecord -> ()
rnf DescribeRecord' {Maybe Natural
Maybe Text
Text
id :: Text
pageToken :: Maybe Text
pageSize :: Maybe Natural
acceptLanguage :: Maybe Text
$sel:id:DescribeRecord' :: DescribeRecord -> Text
$sel:pageToken:DescribeRecord' :: DescribeRecord -> Maybe Text
$sel:pageSize:DescribeRecord' :: DescribeRecord -> Maybe Natural
$sel:acceptLanguage:DescribeRecord' :: DescribeRecord -> 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 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 Text
id

instance Data.ToHeaders DescribeRecord where
  toHeaders :: DescribeRecord -> 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.DescribeRecord" ::
                          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 DescribeRecord where
  toJSON :: DescribeRecord -> Value
toJSON DescribeRecord' {Maybe Natural
Maybe Text
Text
id :: Text
pageToken :: Maybe Text
pageSize :: Maybe Natural
acceptLanguage :: Maybe Text
$sel:id:DescribeRecord' :: DescribeRecord -> Text
$sel:pageToken:DescribeRecord' :: DescribeRecord -> Maybe Text
$sel:pageSize:DescribeRecord' :: DescribeRecord -> Maybe Natural
$sel:acceptLanguage:DescribeRecord' :: DescribeRecord -> 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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"Id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )

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

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

-- | /See:/ 'newDescribeRecordResponse' smart constructor.
data DescribeRecordResponse = DescribeRecordResponse'
  { -- | The page token to use to retrieve the next set of results. If there are
    -- no additional results, this value is null.
    DescribeRecordResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the product.
    DescribeRecordResponse -> Maybe RecordDetail
recordDetail :: Prelude.Maybe RecordDetail,
    -- | 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.
    DescribeRecordResponse -> Maybe [RecordOutput]
recordOutputs :: Prelude.Maybe [RecordOutput],
    -- | The response's http status code.
    DescribeRecordResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeRecordResponse -> DescribeRecordResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeRecordResponse -> DescribeRecordResponse -> Bool
$c/= :: DescribeRecordResponse -> DescribeRecordResponse -> Bool
== :: DescribeRecordResponse -> DescribeRecordResponse -> Bool
$c== :: DescribeRecordResponse -> DescribeRecordResponse -> Bool
Prelude.Eq, ReadPrec [DescribeRecordResponse]
ReadPrec DescribeRecordResponse
Int -> ReadS DescribeRecordResponse
ReadS [DescribeRecordResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeRecordResponse]
$creadListPrec :: ReadPrec [DescribeRecordResponse]
readPrec :: ReadPrec DescribeRecordResponse
$creadPrec :: ReadPrec DescribeRecordResponse
readList :: ReadS [DescribeRecordResponse]
$creadList :: ReadS [DescribeRecordResponse]
readsPrec :: Int -> ReadS DescribeRecordResponse
$creadsPrec :: Int -> ReadS DescribeRecordResponse
Prelude.Read, Int -> DescribeRecordResponse -> ShowS
[DescribeRecordResponse] -> ShowS
DescribeRecordResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeRecordResponse] -> ShowS
$cshowList :: [DescribeRecordResponse] -> ShowS
show :: DescribeRecordResponse -> String
$cshow :: DescribeRecordResponse -> String
showsPrec :: Int -> DescribeRecordResponse -> ShowS
$cshowsPrec :: Int -> DescribeRecordResponse -> ShowS
Prelude.Show, forall x. Rep DescribeRecordResponse x -> DescribeRecordResponse
forall x. DescribeRecordResponse -> Rep DescribeRecordResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeRecordResponse x -> DescribeRecordResponse
$cfrom :: forall x. DescribeRecordResponse -> Rep DescribeRecordResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeRecordResponse' 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', 'describeRecordResponse_nextPageToken' - The page token to use to retrieve the next set of results. If there are
-- no additional results, this value is null.
--
-- 'recordDetail', 'describeRecordResponse_recordDetail' - Information about the product.
--
-- 'recordOutputs', 'describeRecordResponse_recordOutputs' - 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', 'describeRecordResponse_httpStatus' - The response's http status code.
newDescribeRecordResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeRecordResponse
newDescribeRecordResponse :: Int -> DescribeRecordResponse
newDescribeRecordResponse Int
pHttpStatus_ =
  DescribeRecordResponse'
    { $sel:nextPageToken:DescribeRecordResponse' :: Maybe Text
nextPageToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:recordDetail:DescribeRecordResponse' :: Maybe RecordDetail
recordDetail = forall a. Maybe a
Prelude.Nothing,
      $sel:recordOutputs:DescribeRecordResponse' :: Maybe [RecordOutput]
recordOutputs = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeRecordResponse' :: 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.
describeRecordResponse_nextPageToken :: Lens.Lens' DescribeRecordResponse (Prelude.Maybe Prelude.Text)
describeRecordResponse_nextPageToken :: Lens' DescribeRecordResponse (Maybe Text)
describeRecordResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecordResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:DescribeRecordResponse' :: DescribeRecordResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: DescribeRecordResponse
s@DescribeRecordResponse' {} Maybe Text
a -> DescribeRecordResponse
s {$sel:nextPageToken:DescribeRecordResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: DescribeRecordResponse)

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

-- | 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.
describeRecordResponse_recordOutputs :: Lens.Lens' DescribeRecordResponse (Prelude.Maybe [RecordOutput])
describeRecordResponse_recordOutputs :: Lens' DescribeRecordResponse (Maybe [RecordOutput])
describeRecordResponse_recordOutputs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecordResponse' {Maybe [RecordOutput]
recordOutputs :: Maybe [RecordOutput]
$sel:recordOutputs:DescribeRecordResponse' :: DescribeRecordResponse -> Maybe [RecordOutput]
recordOutputs} -> Maybe [RecordOutput]
recordOutputs) (\s :: DescribeRecordResponse
s@DescribeRecordResponse' {} Maybe [RecordOutput]
a -> DescribeRecordResponse
s {$sel:recordOutputs:DescribeRecordResponse' :: Maybe [RecordOutput]
recordOutputs = Maybe [RecordOutput]
a} :: DescribeRecordResponse) 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.
describeRecordResponse_httpStatus :: Lens.Lens' DescribeRecordResponse Prelude.Int
describeRecordResponse_httpStatus :: Lens' DescribeRecordResponse Int
describeRecordResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecordResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeRecordResponse' :: DescribeRecordResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeRecordResponse
s@DescribeRecordResponse' {} Int
a -> DescribeRecordResponse
s {$sel:httpStatus:DescribeRecordResponse' :: Int
httpStatus = Int
a} :: DescribeRecordResponse)

instance Prelude.NFData DescribeRecordResponse where
  rnf :: DescribeRecordResponse -> ()
rnf DescribeRecordResponse' {Int
Maybe [RecordOutput]
Maybe Text
Maybe RecordDetail
httpStatus :: Int
recordOutputs :: Maybe [RecordOutput]
recordDetail :: Maybe RecordDetail
nextPageToken :: Maybe Text
$sel:httpStatus:DescribeRecordResponse' :: DescribeRecordResponse -> Int
$sel:recordOutputs:DescribeRecordResponse' :: DescribeRecordResponse -> Maybe [RecordOutput]
$sel:recordDetail:DescribeRecordResponse' :: DescribeRecordResponse -> Maybe RecordDetail
$sel:nextPageToken:DescribeRecordResponse' :: DescribeRecordResponse -> 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 RecordDetail
recordDetail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RecordOutput]
recordOutputs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus