{-# 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.Pi.GetDimensionKeyDetails
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get the attributes of the specified dimension group for a DB instance or
-- data source. For example, if you specify a SQL ID,
-- @GetDimensionKeyDetails@ retrieves the full text of the dimension
-- @db.sql.statement@ associated with this ID. This operation is useful
-- because @GetResourceMetrics@ and @DescribeDimensionKeys@ don\'t support
-- retrieval of large SQL statement text.
module Amazonka.Pi.GetDimensionKeyDetails
  ( -- * Creating a Request
    GetDimensionKeyDetails (..),
    newGetDimensionKeyDetails,

    -- * Request Lenses
    getDimensionKeyDetails_requestedDimensions,
    getDimensionKeyDetails_serviceType,
    getDimensionKeyDetails_identifier,
    getDimensionKeyDetails_group,
    getDimensionKeyDetails_groupIdentifier,

    -- * Destructuring the Response
    GetDimensionKeyDetailsResponse (..),
    newGetDimensionKeyDetailsResponse,

    -- * Response Lenses
    getDimensionKeyDetailsResponse_dimensions,
    getDimensionKeyDetailsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Pi.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetDimensionKeyDetails' smart constructor.
data GetDimensionKeyDetails = GetDimensionKeyDetails'
  { -- | A list of dimensions to retrieve the detail data for within the given
    -- dimension group. If you don\'t specify this parameter, Performance
    -- Insights returns all dimension data within the specified dimension
    -- group. Specify dimension names for the following dimension groups:
    --
    -- -   @db.sql@ - Specify either the full dimension name @db.sql.statement@
    --     or the short dimension name @statement@ (Aurora and RDS only).
    --
    -- -   @db.query@ - Specify either the full dimension name
    --     @db.query.statement@ or the short dimension name @statement@
    --     (DocumentDB only).
    GetDimensionKeyDetails -> Maybe (NonEmpty Text)
requestedDimensions :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The Amazon Web Services service for which Performance Insights returns
    -- data. The only valid value is @RDS@.
    GetDimensionKeyDetails -> ServiceType
serviceType :: ServiceType,
    -- | The ID for a data source from which to gather dimension data. This ID
    -- must be immutable and unique within an Amazon Web Services Region. When
    -- a DB instance is the data source, specify its @DbiResourceId@ value. For
    -- example, specify @db-ABCDEFGHIJKLMNOPQRSTU1VW2X@.
    GetDimensionKeyDetails -> Text
identifier :: Prelude.Text,
    -- | The name of the dimension group. Performance Insights searches the
    -- specified group for the dimension group ID. The following group name
    -- values are valid:
    --
    -- -   @db.query@ (Amazon DocumentDB only)
    --
    -- -   @db.sql@ (Amazon RDS and Aurora only)
    GetDimensionKeyDetails -> Text
group' :: Prelude.Text,
    -- | The ID of the dimension group from which to retrieve dimension details.
    -- For dimension group @db.sql@, the group ID is @db.sql.id@. The following
    -- group ID values are valid:
    --
    -- -   @db.sql.id@ for dimension group @db.sql@ (Aurora and RDS only)
    --
    -- -   @db.query.id@ for dimension group @db.query@ (DocumentDB only)
    GetDimensionKeyDetails -> Text
groupIdentifier :: Prelude.Text
  }
  deriving (GetDimensionKeyDetails -> GetDimensionKeyDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDimensionKeyDetails -> GetDimensionKeyDetails -> Bool
$c/= :: GetDimensionKeyDetails -> GetDimensionKeyDetails -> Bool
== :: GetDimensionKeyDetails -> GetDimensionKeyDetails -> Bool
$c== :: GetDimensionKeyDetails -> GetDimensionKeyDetails -> Bool
Prelude.Eq, ReadPrec [GetDimensionKeyDetails]
ReadPrec GetDimensionKeyDetails
Int -> ReadS GetDimensionKeyDetails
ReadS [GetDimensionKeyDetails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDimensionKeyDetails]
$creadListPrec :: ReadPrec [GetDimensionKeyDetails]
readPrec :: ReadPrec GetDimensionKeyDetails
$creadPrec :: ReadPrec GetDimensionKeyDetails
readList :: ReadS [GetDimensionKeyDetails]
$creadList :: ReadS [GetDimensionKeyDetails]
readsPrec :: Int -> ReadS GetDimensionKeyDetails
$creadsPrec :: Int -> ReadS GetDimensionKeyDetails
Prelude.Read, Int -> GetDimensionKeyDetails -> ShowS
[GetDimensionKeyDetails] -> ShowS
GetDimensionKeyDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDimensionKeyDetails] -> ShowS
$cshowList :: [GetDimensionKeyDetails] -> ShowS
show :: GetDimensionKeyDetails -> String
$cshow :: GetDimensionKeyDetails -> String
showsPrec :: Int -> GetDimensionKeyDetails -> ShowS
$cshowsPrec :: Int -> GetDimensionKeyDetails -> ShowS
Prelude.Show, forall x. Rep GetDimensionKeyDetails x -> GetDimensionKeyDetails
forall x. GetDimensionKeyDetails -> Rep GetDimensionKeyDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDimensionKeyDetails x -> GetDimensionKeyDetails
$cfrom :: forall x. GetDimensionKeyDetails -> Rep GetDimensionKeyDetails x
Prelude.Generic)

-- |
-- Create a value of 'GetDimensionKeyDetails' 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:
--
-- 'requestedDimensions', 'getDimensionKeyDetails_requestedDimensions' - A list of dimensions to retrieve the detail data for within the given
-- dimension group. If you don\'t specify this parameter, Performance
-- Insights returns all dimension data within the specified dimension
-- group. Specify dimension names for the following dimension groups:
--
-- -   @db.sql@ - Specify either the full dimension name @db.sql.statement@
--     or the short dimension name @statement@ (Aurora and RDS only).
--
-- -   @db.query@ - Specify either the full dimension name
--     @db.query.statement@ or the short dimension name @statement@
--     (DocumentDB only).
--
-- 'serviceType', 'getDimensionKeyDetails_serviceType' - The Amazon Web Services service for which Performance Insights returns
-- data. The only valid value is @RDS@.
--
-- 'identifier', 'getDimensionKeyDetails_identifier' - The ID for a data source from which to gather dimension data. This ID
-- must be immutable and unique within an Amazon Web Services Region. When
-- a DB instance is the data source, specify its @DbiResourceId@ value. For
-- example, specify @db-ABCDEFGHIJKLMNOPQRSTU1VW2X@.
--
-- 'group'', 'getDimensionKeyDetails_group' - The name of the dimension group. Performance Insights searches the
-- specified group for the dimension group ID. The following group name
-- values are valid:
--
-- -   @db.query@ (Amazon DocumentDB only)
--
-- -   @db.sql@ (Amazon RDS and Aurora only)
--
-- 'groupIdentifier', 'getDimensionKeyDetails_groupIdentifier' - The ID of the dimension group from which to retrieve dimension details.
-- For dimension group @db.sql@, the group ID is @db.sql.id@. The following
-- group ID values are valid:
--
-- -   @db.sql.id@ for dimension group @db.sql@ (Aurora and RDS only)
--
-- -   @db.query.id@ for dimension group @db.query@ (DocumentDB only)
newGetDimensionKeyDetails ::
  -- | 'serviceType'
  ServiceType ->
  -- | 'identifier'
  Prelude.Text ->
  -- | 'group''
  Prelude.Text ->
  -- | 'groupIdentifier'
  Prelude.Text ->
  GetDimensionKeyDetails
newGetDimensionKeyDetails :: ServiceType -> Text -> Text -> Text -> GetDimensionKeyDetails
newGetDimensionKeyDetails
  ServiceType
pServiceType_
  Text
pIdentifier_
  Text
pGroup_
  Text
pGroupIdentifier_ =
    GetDimensionKeyDetails'
      { $sel:requestedDimensions:GetDimensionKeyDetails' :: Maybe (NonEmpty Text)
requestedDimensions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:serviceType:GetDimensionKeyDetails' :: ServiceType
serviceType = ServiceType
pServiceType_,
        $sel:identifier:GetDimensionKeyDetails' :: Text
identifier = Text
pIdentifier_,
        $sel:group':GetDimensionKeyDetails' :: Text
group' = Text
pGroup_,
        $sel:groupIdentifier:GetDimensionKeyDetails' :: Text
groupIdentifier = Text
pGroupIdentifier_
      }

-- | A list of dimensions to retrieve the detail data for within the given
-- dimension group. If you don\'t specify this parameter, Performance
-- Insights returns all dimension data within the specified dimension
-- group. Specify dimension names for the following dimension groups:
--
-- -   @db.sql@ - Specify either the full dimension name @db.sql.statement@
--     or the short dimension name @statement@ (Aurora and RDS only).
--
-- -   @db.query@ - Specify either the full dimension name
--     @db.query.statement@ or the short dimension name @statement@
--     (DocumentDB only).
getDimensionKeyDetails_requestedDimensions :: Lens.Lens' GetDimensionKeyDetails (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getDimensionKeyDetails_requestedDimensions :: Lens' GetDimensionKeyDetails (Maybe (NonEmpty Text))
getDimensionKeyDetails_requestedDimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDimensionKeyDetails' {Maybe (NonEmpty Text)
requestedDimensions :: Maybe (NonEmpty Text)
$sel:requestedDimensions:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Maybe (NonEmpty Text)
requestedDimensions} -> Maybe (NonEmpty Text)
requestedDimensions) (\s :: GetDimensionKeyDetails
s@GetDimensionKeyDetails' {} Maybe (NonEmpty Text)
a -> GetDimensionKeyDetails
s {$sel:requestedDimensions:GetDimensionKeyDetails' :: Maybe (NonEmpty Text)
requestedDimensions = Maybe (NonEmpty Text)
a} :: GetDimensionKeyDetails) 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 Amazon Web Services service for which Performance Insights returns
-- data. The only valid value is @RDS@.
getDimensionKeyDetails_serviceType :: Lens.Lens' GetDimensionKeyDetails ServiceType
getDimensionKeyDetails_serviceType :: Lens' GetDimensionKeyDetails ServiceType
getDimensionKeyDetails_serviceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDimensionKeyDetails' {ServiceType
serviceType :: ServiceType
$sel:serviceType:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> ServiceType
serviceType} -> ServiceType
serviceType) (\s :: GetDimensionKeyDetails
s@GetDimensionKeyDetails' {} ServiceType
a -> GetDimensionKeyDetails
s {$sel:serviceType:GetDimensionKeyDetails' :: ServiceType
serviceType = ServiceType
a} :: GetDimensionKeyDetails)

-- | The ID for a data source from which to gather dimension data. This ID
-- must be immutable and unique within an Amazon Web Services Region. When
-- a DB instance is the data source, specify its @DbiResourceId@ value. For
-- example, specify @db-ABCDEFGHIJKLMNOPQRSTU1VW2X@.
getDimensionKeyDetails_identifier :: Lens.Lens' GetDimensionKeyDetails Prelude.Text
getDimensionKeyDetails_identifier :: Lens' GetDimensionKeyDetails Text
getDimensionKeyDetails_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDimensionKeyDetails' {Text
identifier :: Text
$sel:identifier:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
identifier} -> Text
identifier) (\s :: GetDimensionKeyDetails
s@GetDimensionKeyDetails' {} Text
a -> GetDimensionKeyDetails
s {$sel:identifier:GetDimensionKeyDetails' :: Text
identifier = Text
a} :: GetDimensionKeyDetails)

-- | The name of the dimension group. Performance Insights searches the
-- specified group for the dimension group ID. The following group name
-- values are valid:
--
-- -   @db.query@ (Amazon DocumentDB only)
--
-- -   @db.sql@ (Amazon RDS and Aurora only)
getDimensionKeyDetails_group :: Lens.Lens' GetDimensionKeyDetails Prelude.Text
getDimensionKeyDetails_group :: Lens' GetDimensionKeyDetails Text
getDimensionKeyDetails_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDimensionKeyDetails' {Text
group' :: Text
$sel:group':GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
group'} -> Text
group') (\s :: GetDimensionKeyDetails
s@GetDimensionKeyDetails' {} Text
a -> GetDimensionKeyDetails
s {$sel:group':GetDimensionKeyDetails' :: Text
group' = Text
a} :: GetDimensionKeyDetails)

-- | The ID of the dimension group from which to retrieve dimension details.
-- For dimension group @db.sql@, the group ID is @db.sql.id@. The following
-- group ID values are valid:
--
-- -   @db.sql.id@ for dimension group @db.sql@ (Aurora and RDS only)
--
-- -   @db.query.id@ for dimension group @db.query@ (DocumentDB only)
getDimensionKeyDetails_groupIdentifier :: Lens.Lens' GetDimensionKeyDetails Prelude.Text
getDimensionKeyDetails_groupIdentifier :: Lens' GetDimensionKeyDetails Text
getDimensionKeyDetails_groupIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDimensionKeyDetails' {Text
groupIdentifier :: Text
$sel:groupIdentifier:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
groupIdentifier} -> Text
groupIdentifier) (\s :: GetDimensionKeyDetails
s@GetDimensionKeyDetails' {} Text
a -> GetDimensionKeyDetails
s {$sel:groupIdentifier:GetDimensionKeyDetails' :: Text
groupIdentifier = Text
a} :: GetDimensionKeyDetails)

instance Core.AWSRequest GetDimensionKeyDetails where
  type
    AWSResponse GetDimensionKeyDetails =
      GetDimensionKeyDetailsResponse
  request :: (Service -> Service)
-> GetDimensionKeyDetails -> Request GetDimensionKeyDetails
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 GetDimensionKeyDetails
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDimensionKeyDetails)))
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 [DimensionKeyDetail] -> Int -> GetDimensionKeyDetailsResponse
GetDimensionKeyDetailsResponse'
            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
"Dimensions" 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 GetDimensionKeyDetails where
  hashWithSalt :: Int -> GetDimensionKeyDetails -> Int
hashWithSalt Int
_salt GetDimensionKeyDetails' {Maybe (NonEmpty Text)
Text
ServiceType
groupIdentifier :: Text
group' :: Text
identifier :: Text
serviceType :: ServiceType
requestedDimensions :: Maybe (NonEmpty Text)
$sel:groupIdentifier:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:group':GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:identifier:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:serviceType:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> ServiceType
$sel:requestedDimensions:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
requestedDimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ServiceType
serviceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
group'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
groupIdentifier

instance Prelude.NFData GetDimensionKeyDetails where
  rnf :: GetDimensionKeyDetails -> ()
rnf GetDimensionKeyDetails' {Maybe (NonEmpty Text)
Text
ServiceType
groupIdentifier :: Text
group' :: Text
identifier :: Text
serviceType :: ServiceType
requestedDimensions :: Maybe (NonEmpty Text)
$sel:groupIdentifier:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:group':GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:identifier:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:serviceType:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> ServiceType
$sel:requestedDimensions:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
requestedDimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ServiceType
serviceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
group'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
groupIdentifier

instance Data.ToHeaders GetDimensionKeyDetails where
  toHeaders :: GetDimensionKeyDetails -> 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
"PerformanceInsightsv20180227.GetDimensionKeyDetails" ::
                          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 GetDimensionKeyDetails where
  toJSON :: GetDimensionKeyDetails -> Value
toJSON GetDimensionKeyDetails' {Maybe (NonEmpty Text)
Text
ServiceType
groupIdentifier :: Text
group' :: Text
identifier :: Text
serviceType :: ServiceType
requestedDimensions :: Maybe (NonEmpty Text)
$sel:groupIdentifier:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:group':GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:identifier:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Text
$sel:serviceType:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> ServiceType
$sel:requestedDimensions:GetDimensionKeyDetails' :: GetDimensionKeyDetails -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"RequestedDimensions" 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 (NonEmpty Text)
requestedDimensions,
            forall a. a -> Maybe a
Prelude.Just (Key
"ServiceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ServiceType
serviceType),
            forall a. a -> Maybe a
Prelude.Just (Key
"Identifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identifier),
            forall a. a -> Maybe a
Prelude.Just (Key
"Group" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
group'),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"GroupIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
groupIdentifier)
          ]
      )

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

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

-- | /See:/ 'newGetDimensionKeyDetailsResponse' smart constructor.
data GetDimensionKeyDetailsResponse = GetDimensionKeyDetailsResponse'
  { -- | The details for the requested dimensions.
    GetDimensionKeyDetailsResponse -> Maybe [DimensionKeyDetail]
dimensions :: Prelude.Maybe [DimensionKeyDetail],
    -- | The response's http status code.
    GetDimensionKeyDetailsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDimensionKeyDetailsResponse
-> GetDimensionKeyDetailsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDimensionKeyDetailsResponse
-> GetDimensionKeyDetailsResponse -> Bool
$c/= :: GetDimensionKeyDetailsResponse
-> GetDimensionKeyDetailsResponse -> Bool
== :: GetDimensionKeyDetailsResponse
-> GetDimensionKeyDetailsResponse -> Bool
$c== :: GetDimensionKeyDetailsResponse
-> GetDimensionKeyDetailsResponse -> Bool
Prelude.Eq, ReadPrec [GetDimensionKeyDetailsResponse]
ReadPrec GetDimensionKeyDetailsResponse
Int -> ReadS GetDimensionKeyDetailsResponse
ReadS [GetDimensionKeyDetailsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDimensionKeyDetailsResponse]
$creadListPrec :: ReadPrec [GetDimensionKeyDetailsResponse]
readPrec :: ReadPrec GetDimensionKeyDetailsResponse
$creadPrec :: ReadPrec GetDimensionKeyDetailsResponse
readList :: ReadS [GetDimensionKeyDetailsResponse]
$creadList :: ReadS [GetDimensionKeyDetailsResponse]
readsPrec :: Int -> ReadS GetDimensionKeyDetailsResponse
$creadsPrec :: Int -> ReadS GetDimensionKeyDetailsResponse
Prelude.Read, Int -> GetDimensionKeyDetailsResponse -> ShowS
[GetDimensionKeyDetailsResponse] -> ShowS
GetDimensionKeyDetailsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDimensionKeyDetailsResponse] -> ShowS
$cshowList :: [GetDimensionKeyDetailsResponse] -> ShowS
show :: GetDimensionKeyDetailsResponse -> String
$cshow :: GetDimensionKeyDetailsResponse -> String
showsPrec :: Int -> GetDimensionKeyDetailsResponse -> ShowS
$cshowsPrec :: Int -> GetDimensionKeyDetailsResponse -> ShowS
Prelude.Show, forall x.
Rep GetDimensionKeyDetailsResponse x
-> GetDimensionKeyDetailsResponse
forall x.
GetDimensionKeyDetailsResponse
-> Rep GetDimensionKeyDetailsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDimensionKeyDetailsResponse x
-> GetDimensionKeyDetailsResponse
$cfrom :: forall x.
GetDimensionKeyDetailsResponse
-> Rep GetDimensionKeyDetailsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDimensionKeyDetailsResponse' 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:
--
-- 'dimensions', 'getDimensionKeyDetailsResponse_dimensions' - The details for the requested dimensions.
--
-- 'httpStatus', 'getDimensionKeyDetailsResponse_httpStatus' - The response's http status code.
newGetDimensionKeyDetailsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDimensionKeyDetailsResponse
newGetDimensionKeyDetailsResponse :: Int -> GetDimensionKeyDetailsResponse
newGetDimensionKeyDetailsResponse Int
pHttpStatus_ =
  GetDimensionKeyDetailsResponse'
    { $sel:dimensions:GetDimensionKeyDetailsResponse' :: Maybe [DimensionKeyDetail]
dimensions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDimensionKeyDetailsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The details for the requested dimensions.
getDimensionKeyDetailsResponse_dimensions :: Lens.Lens' GetDimensionKeyDetailsResponse (Prelude.Maybe [DimensionKeyDetail])
getDimensionKeyDetailsResponse_dimensions :: Lens' GetDimensionKeyDetailsResponse (Maybe [DimensionKeyDetail])
getDimensionKeyDetailsResponse_dimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDimensionKeyDetailsResponse' {Maybe [DimensionKeyDetail]
dimensions :: Maybe [DimensionKeyDetail]
$sel:dimensions:GetDimensionKeyDetailsResponse' :: GetDimensionKeyDetailsResponse -> Maybe [DimensionKeyDetail]
dimensions} -> Maybe [DimensionKeyDetail]
dimensions) (\s :: GetDimensionKeyDetailsResponse
s@GetDimensionKeyDetailsResponse' {} Maybe [DimensionKeyDetail]
a -> GetDimensionKeyDetailsResponse
s {$sel:dimensions:GetDimensionKeyDetailsResponse' :: Maybe [DimensionKeyDetail]
dimensions = Maybe [DimensionKeyDetail]
a} :: GetDimensionKeyDetailsResponse) 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.
getDimensionKeyDetailsResponse_httpStatus :: Lens.Lens' GetDimensionKeyDetailsResponse Prelude.Int
getDimensionKeyDetailsResponse_httpStatus :: Lens' GetDimensionKeyDetailsResponse Int
getDimensionKeyDetailsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDimensionKeyDetailsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetDimensionKeyDetailsResponse' :: GetDimensionKeyDetailsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetDimensionKeyDetailsResponse
s@GetDimensionKeyDetailsResponse' {} Int
a -> GetDimensionKeyDetailsResponse
s {$sel:httpStatus:GetDimensionKeyDetailsResponse' :: Int
httpStatus = Int
a} :: GetDimensionKeyDetailsResponse)

instance
  Prelude.NFData
    GetDimensionKeyDetailsResponse
  where
  rnf :: GetDimensionKeyDetailsResponse -> ()
rnf GetDimensionKeyDetailsResponse' {Int
Maybe [DimensionKeyDetail]
httpStatus :: Int
dimensions :: Maybe [DimensionKeyDetail]
$sel:httpStatus:GetDimensionKeyDetailsResponse' :: GetDimensionKeyDetailsResponse -> Int
$sel:dimensions:GetDimensionKeyDetailsResponse' :: GetDimensionKeyDetailsResponse -> Maybe [DimensionKeyDetail]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DimensionKeyDetail]
dimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus