{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.DevOpsGuru.Types.PerformanceInsightsMetricDimensionGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.DevOpsGuru.Types.PerformanceInsightsMetricDimensionGroup 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

-- | A logical grouping of Performance Insights metrics for a related subject
-- area. For example, the @db.sql@ dimension group consists of the
-- following dimensions: @db.sql.id@, @db.sql.db_id@, @db.sql.statement@,
-- and @db.sql.tokenized_id@.
--
-- Each response element returns a maximum of 500 bytes. For larger
-- elements, such as SQL statements, only the first 500 bytes are returned.
--
-- Amazon RDS Performance Insights enables you to monitor and explore
-- different dimensions of database load based on data captured from a
-- running DB instance. DB load is measured as average active sessions.
-- Performance Insights provides the data to API consumers as a
-- two-dimensional time-series dataset. The time dimension provides DB load
-- data for each time point in the queried time range. Each time point
-- decomposes overall load in relation to the requested dimensions,
-- measured at that time point. Examples include SQL, Wait event, User, and
-- Host.
--
-- -   To learn more about Performance Insights and Amazon Aurora DB
--     instances, go to the
--     <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_PerfInsights.html Amazon Aurora User Guide>.
--
-- -   To learn more about Performance Insights and Amazon RDS DB
--     instances, go to the
--     <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_PerfInsights.html Amazon RDS User Guide>.
--
-- /See:/ 'newPerformanceInsightsMetricDimensionGroup' smart constructor.
data PerformanceInsightsMetricDimensionGroup = PerformanceInsightsMetricDimensionGroup'
  { -- | A list of specific dimensions from a dimension group. If this parameter
    -- is not present, then it signifies that all of the dimensions in the
    -- group were requested or are present in the response.
    --
    -- Valid values for elements in the @Dimensions@ array are:
    --
    -- -   @db.application.name@ - The name of the application that is
    --     connected to the database (only Aurora PostgreSQL and RDS
    --     PostgreSQL)
    --
    -- -   @db.host.id@ - The host ID of the connected client (all engines)
    --
    -- -   @db.host.name@ - The host name of the connected client (all engines)
    --
    -- -   @db.name@ - The name of the database to which the client is
    --     connected (only Aurora PostgreSQL, Amazon RDS PostgreSQL, Aurora
    --     MySQL, Amazon RDS MySQL, and MariaDB)
    --
    -- -   @db.session_type.name@ - The type of the current session (only
    --     Aurora PostgreSQL and RDS PostgreSQL)
    --
    -- -   @db.sql.id@ - The SQL ID generated by Performance Insights (all
    --     engines)
    --
    -- -   @db.sql.db_id@ - The SQL ID generated by the database (all engines)
    --
    -- -   @db.sql.statement@ - The SQL text that is being executed (all
    --     engines)
    --
    -- -   @db.sql.tokenized_id@
    --
    -- -   @db.sql_tokenized.id@ - The SQL digest ID generated by Performance
    --     Insights (all engines)
    --
    -- -   @db.sql_tokenized.db_id@ - SQL digest ID generated by the database
    --     (all engines)
    --
    -- -   @db.sql_tokenized.statement@ - The SQL digest text (all engines)
    --
    -- -   @db.user.id@ - The ID of the user logged in to the database (all
    --     engines)
    --
    -- -   @db.user.name@ - The name of the user logged in to the database (all
    --     engines)
    --
    -- -   @db.wait_event.name@ - The event for which the backend is waiting
    --     (all engines)
    --
    -- -   @db.wait_event.type@ - The type of event for which the backend is
    --     waiting (all engines)
    --
    -- -   @db.wait_event_type.name@ - The name of the event type for which the
    --     backend is waiting (all engines)
    PerformanceInsightsMetricDimensionGroup -> Maybe [Text]
dimensions :: Prelude.Maybe [Prelude.Text],
    -- | The name of the dimension group. Its valid values are:
    --
    -- -   @db@ - The name of the database to which the client is connected
    --     (only Aurora PostgreSQL, Amazon RDS PostgreSQL, Aurora MySQL, Amazon
    --     RDS MySQL, and MariaDB)
    --
    -- -   @db.application@ - The name of the application that is connected to
    --     the database (only Aurora PostgreSQL and RDS PostgreSQL)
    --
    -- -   @db.host@ - The host name of the connected client (all engines)
    --
    -- -   @db.session_type@ - The type of the current session (only Aurora
    --     PostgreSQL and RDS PostgreSQL)
    --
    -- -   @db.sql@ - The SQL that is currently executing (all engines)
    --
    -- -   @db.sql_tokenized@ - The SQL digest (all engines)
    --
    -- -   @db.wait_event@ - The event for which the database backend is
    --     waiting (all engines)
    --
    -- -   @db.wait_event_type@ - The type of event for which the database
    --     backend is waiting (all engines)
    --
    -- -   @db.user@ - The user logged in to the database (all engines)
    PerformanceInsightsMetricDimensionGroup -> Maybe Text
group' :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of items to fetch for this dimension group.
    PerformanceInsightsMetricDimensionGroup -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural
  }
  deriving (PerformanceInsightsMetricDimensionGroup
-> PerformanceInsightsMetricDimensionGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerformanceInsightsMetricDimensionGroup
-> PerformanceInsightsMetricDimensionGroup -> Bool
$c/= :: PerformanceInsightsMetricDimensionGroup
-> PerformanceInsightsMetricDimensionGroup -> Bool
== :: PerformanceInsightsMetricDimensionGroup
-> PerformanceInsightsMetricDimensionGroup -> Bool
$c== :: PerformanceInsightsMetricDimensionGroup
-> PerformanceInsightsMetricDimensionGroup -> Bool
Prelude.Eq, ReadPrec [PerformanceInsightsMetricDimensionGroup]
ReadPrec PerformanceInsightsMetricDimensionGroup
Int -> ReadS PerformanceInsightsMetricDimensionGroup
ReadS [PerformanceInsightsMetricDimensionGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PerformanceInsightsMetricDimensionGroup]
$creadListPrec :: ReadPrec [PerformanceInsightsMetricDimensionGroup]
readPrec :: ReadPrec PerformanceInsightsMetricDimensionGroup
$creadPrec :: ReadPrec PerformanceInsightsMetricDimensionGroup
readList :: ReadS [PerformanceInsightsMetricDimensionGroup]
$creadList :: ReadS [PerformanceInsightsMetricDimensionGroup]
readsPrec :: Int -> ReadS PerformanceInsightsMetricDimensionGroup
$creadsPrec :: Int -> ReadS PerformanceInsightsMetricDimensionGroup
Prelude.Read, Int -> PerformanceInsightsMetricDimensionGroup -> ShowS
[PerformanceInsightsMetricDimensionGroup] -> ShowS
PerformanceInsightsMetricDimensionGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerformanceInsightsMetricDimensionGroup] -> ShowS
$cshowList :: [PerformanceInsightsMetricDimensionGroup] -> ShowS
show :: PerformanceInsightsMetricDimensionGroup -> String
$cshow :: PerformanceInsightsMetricDimensionGroup -> String
showsPrec :: Int -> PerformanceInsightsMetricDimensionGroup -> ShowS
$cshowsPrec :: Int -> PerformanceInsightsMetricDimensionGroup -> ShowS
Prelude.Show, forall x.
Rep PerformanceInsightsMetricDimensionGroup x
-> PerformanceInsightsMetricDimensionGroup
forall x.
PerformanceInsightsMetricDimensionGroup
-> Rep PerformanceInsightsMetricDimensionGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PerformanceInsightsMetricDimensionGroup x
-> PerformanceInsightsMetricDimensionGroup
$cfrom :: forall x.
PerformanceInsightsMetricDimensionGroup
-> Rep PerformanceInsightsMetricDimensionGroup x
Prelude.Generic)

-- |
-- Create a value of 'PerformanceInsightsMetricDimensionGroup' 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', 'performanceInsightsMetricDimensionGroup_dimensions' - A list of specific dimensions from a dimension group. If this parameter
-- is not present, then it signifies that all of the dimensions in the
-- group were requested or are present in the response.
--
-- Valid values for elements in the @Dimensions@ array are:
--
-- -   @db.application.name@ - The name of the application that is
--     connected to the database (only Aurora PostgreSQL and RDS
--     PostgreSQL)
--
-- -   @db.host.id@ - The host ID of the connected client (all engines)
--
-- -   @db.host.name@ - The host name of the connected client (all engines)
--
-- -   @db.name@ - The name of the database to which the client is
--     connected (only Aurora PostgreSQL, Amazon RDS PostgreSQL, Aurora
--     MySQL, Amazon RDS MySQL, and MariaDB)
--
-- -   @db.session_type.name@ - The type of the current session (only
--     Aurora PostgreSQL and RDS PostgreSQL)
--
-- -   @db.sql.id@ - The SQL ID generated by Performance Insights (all
--     engines)
--
-- -   @db.sql.db_id@ - The SQL ID generated by the database (all engines)
--
-- -   @db.sql.statement@ - The SQL text that is being executed (all
--     engines)
--
-- -   @db.sql.tokenized_id@
--
-- -   @db.sql_tokenized.id@ - The SQL digest ID generated by Performance
--     Insights (all engines)
--
-- -   @db.sql_tokenized.db_id@ - SQL digest ID generated by the database
--     (all engines)
--
-- -   @db.sql_tokenized.statement@ - The SQL digest text (all engines)
--
-- -   @db.user.id@ - The ID of the user logged in to the database (all
--     engines)
--
-- -   @db.user.name@ - The name of the user logged in to the database (all
--     engines)
--
-- -   @db.wait_event.name@ - The event for which the backend is waiting
--     (all engines)
--
-- -   @db.wait_event.type@ - The type of event for which the backend is
--     waiting (all engines)
--
-- -   @db.wait_event_type.name@ - The name of the event type for which the
--     backend is waiting (all engines)
--
-- 'group'', 'performanceInsightsMetricDimensionGroup_group' - The name of the dimension group. Its valid values are:
--
-- -   @db@ - The name of the database to which the client is connected
--     (only Aurora PostgreSQL, Amazon RDS PostgreSQL, Aurora MySQL, Amazon
--     RDS MySQL, and MariaDB)
--
-- -   @db.application@ - The name of the application that is connected to
--     the database (only Aurora PostgreSQL and RDS PostgreSQL)
--
-- -   @db.host@ - The host name of the connected client (all engines)
--
-- -   @db.session_type@ - The type of the current session (only Aurora
--     PostgreSQL and RDS PostgreSQL)
--
-- -   @db.sql@ - The SQL that is currently executing (all engines)
--
-- -   @db.sql_tokenized@ - The SQL digest (all engines)
--
-- -   @db.wait_event@ - The event for which the database backend is
--     waiting (all engines)
--
-- -   @db.wait_event_type@ - The type of event for which the database
--     backend is waiting (all engines)
--
-- -   @db.user@ - The user logged in to the database (all engines)
--
-- 'limit', 'performanceInsightsMetricDimensionGroup_limit' - The maximum number of items to fetch for this dimension group.
newPerformanceInsightsMetricDimensionGroup ::
  PerformanceInsightsMetricDimensionGroup
newPerformanceInsightsMetricDimensionGroup :: PerformanceInsightsMetricDimensionGroup
newPerformanceInsightsMetricDimensionGroup =
  PerformanceInsightsMetricDimensionGroup'
    { $sel:dimensions:PerformanceInsightsMetricDimensionGroup' :: Maybe [Text]
dimensions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:group':PerformanceInsightsMetricDimensionGroup' :: Maybe Text
group' = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:PerformanceInsightsMetricDimensionGroup' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing
    }

-- | A list of specific dimensions from a dimension group. If this parameter
-- is not present, then it signifies that all of the dimensions in the
-- group were requested or are present in the response.
--
-- Valid values for elements in the @Dimensions@ array are:
--
-- -   @db.application.name@ - The name of the application that is
--     connected to the database (only Aurora PostgreSQL and RDS
--     PostgreSQL)
--
-- -   @db.host.id@ - The host ID of the connected client (all engines)
--
-- -   @db.host.name@ - The host name of the connected client (all engines)
--
-- -   @db.name@ - The name of the database to which the client is
--     connected (only Aurora PostgreSQL, Amazon RDS PostgreSQL, Aurora
--     MySQL, Amazon RDS MySQL, and MariaDB)
--
-- -   @db.session_type.name@ - The type of the current session (only
--     Aurora PostgreSQL and RDS PostgreSQL)
--
-- -   @db.sql.id@ - The SQL ID generated by Performance Insights (all
--     engines)
--
-- -   @db.sql.db_id@ - The SQL ID generated by the database (all engines)
--
-- -   @db.sql.statement@ - The SQL text that is being executed (all
--     engines)
--
-- -   @db.sql.tokenized_id@
--
-- -   @db.sql_tokenized.id@ - The SQL digest ID generated by Performance
--     Insights (all engines)
--
-- -   @db.sql_tokenized.db_id@ - SQL digest ID generated by the database
--     (all engines)
--
-- -   @db.sql_tokenized.statement@ - The SQL digest text (all engines)
--
-- -   @db.user.id@ - The ID of the user logged in to the database (all
--     engines)
--
-- -   @db.user.name@ - The name of the user logged in to the database (all
--     engines)
--
-- -   @db.wait_event.name@ - The event for which the backend is waiting
--     (all engines)
--
-- -   @db.wait_event.type@ - The type of event for which the backend is
--     waiting (all engines)
--
-- -   @db.wait_event_type.name@ - The name of the event type for which the
--     backend is waiting (all engines)
performanceInsightsMetricDimensionGroup_dimensions :: Lens.Lens' PerformanceInsightsMetricDimensionGroup (Prelude.Maybe [Prelude.Text])
performanceInsightsMetricDimensionGroup_dimensions :: Lens' PerformanceInsightsMetricDimensionGroup (Maybe [Text])
performanceInsightsMetricDimensionGroup_dimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PerformanceInsightsMetricDimensionGroup' {Maybe [Text]
dimensions :: Maybe [Text]
$sel:dimensions:PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe [Text]
dimensions} -> Maybe [Text]
dimensions) (\s :: PerformanceInsightsMetricDimensionGroup
s@PerformanceInsightsMetricDimensionGroup' {} Maybe [Text]
a -> PerformanceInsightsMetricDimensionGroup
s {$sel:dimensions:PerformanceInsightsMetricDimensionGroup' :: Maybe [Text]
dimensions = Maybe [Text]
a} :: PerformanceInsightsMetricDimensionGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the dimension group. Its valid values are:
--
-- -   @db@ - The name of the database to which the client is connected
--     (only Aurora PostgreSQL, Amazon RDS PostgreSQL, Aurora MySQL, Amazon
--     RDS MySQL, and MariaDB)
--
-- -   @db.application@ - The name of the application that is connected to
--     the database (only Aurora PostgreSQL and RDS PostgreSQL)
--
-- -   @db.host@ - The host name of the connected client (all engines)
--
-- -   @db.session_type@ - The type of the current session (only Aurora
--     PostgreSQL and RDS PostgreSQL)
--
-- -   @db.sql@ - The SQL that is currently executing (all engines)
--
-- -   @db.sql_tokenized@ - The SQL digest (all engines)
--
-- -   @db.wait_event@ - The event for which the database backend is
--     waiting (all engines)
--
-- -   @db.wait_event_type@ - The type of event for which the database
--     backend is waiting (all engines)
--
-- -   @db.user@ - The user logged in to the database (all engines)
performanceInsightsMetricDimensionGroup_group :: Lens.Lens' PerformanceInsightsMetricDimensionGroup (Prelude.Maybe Prelude.Text)
performanceInsightsMetricDimensionGroup_group :: Lens' PerformanceInsightsMetricDimensionGroup (Maybe Text)
performanceInsightsMetricDimensionGroup_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PerformanceInsightsMetricDimensionGroup' {Maybe Text
group' :: Maybe Text
$sel:group':PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe Text
group'} -> Maybe Text
group') (\s :: PerformanceInsightsMetricDimensionGroup
s@PerformanceInsightsMetricDimensionGroup' {} Maybe Text
a -> PerformanceInsightsMetricDimensionGroup
s {$sel:group':PerformanceInsightsMetricDimensionGroup' :: Maybe Text
group' = Maybe Text
a} :: PerformanceInsightsMetricDimensionGroup)

-- | The maximum number of items to fetch for this dimension group.
performanceInsightsMetricDimensionGroup_limit :: Lens.Lens' PerformanceInsightsMetricDimensionGroup (Prelude.Maybe Prelude.Natural)
performanceInsightsMetricDimensionGroup_limit :: Lens' PerformanceInsightsMetricDimensionGroup (Maybe Natural)
performanceInsightsMetricDimensionGroup_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PerformanceInsightsMetricDimensionGroup' {Maybe Natural
limit :: Maybe Natural
$sel:limit:PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: PerformanceInsightsMetricDimensionGroup
s@PerformanceInsightsMetricDimensionGroup' {} Maybe Natural
a -> PerformanceInsightsMetricDimensionGroup
s {$sel:limit:PerformanceInsightsMetricDimensionGroup' :: Maybe Natural
limit = Maybe Natural
a} :: PerformanceInsightsMetricDimensionGroup)

instance
  Data.FromJSON
    PerformanceInsightsMetricDimensionGroup
  where
  parseJSON :: Value -> Parser PerformanceInsightsMetricDimensionGroup
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"PerformanceInsightsMetricDimensionGroup"
      ( \Object
x ->
          Maybe [Text]
-> Maybe Text
-> Maybe Natural
-> PerformanceInsightsMetricDimensionGroup
PerformanceInsightsMetricDimensionGroup'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Dimensions" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"Group")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Limit")
      )

instance
  Prelude.Hashable
    PerformanceInsightsMetricDimensionGroup
  where
  hashWithSalt :: Int -> PerformanceInsightsMetricDimensionGroup -> Int
hashWithSalt
    Int
_salt
    PerformanceInsightsMetricDimensionGroup' {Maybe Natural
Maybe [Text]
Maybe Text
limit :: Maybe Natural
group' :: Maybe Text
dimensions :: Maybe [Text]
$sel:limit:PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe Natural
$sel:group':PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe Text
$sel:dimensions:PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe [Text]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
dimensions
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
group'
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit

instance
  Prelude.NFData
    PerformanceInsightsMetricDimensionGroup
  where
  rnf :: PerformanceInsightsMetricDimensionGroup -> ()
rnf PerformanceInsightsMetricDimensionGroup' {Maybe Natural
Maybe [Text]
Maybe Text
limit :: Maybe Natural
group' :: Maybe Text
dimensions :: Maybe [Text]
$sel:limit:PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe Natural
$sel:group':PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe Text
$sel:dimensions:PerformanceInsightsMetricDimensionGroup' :: PerformanceInsightsMetricDimensionGroup -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
dimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
group'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit