{-# 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.Lightsail.GetDistributionMetricData
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the data points of a specific metric for an Amazon Lightsail
-- content delivery network (CDN) distribution.
--
-- Metrics report the utilization of your resources, and the error counts
-- generated by them. Monitor and collect metric data regularly to maintain
-- the reliability, availability, and performance of your resources.
module Amazonka.Lightsail.GetDistributionMetricData
  ( -- * Creating a Request
    GetDistributionMetricData (..),
    newGetDistributionMetricData,

    -- * Request Lenses
    getDistributionMetricData_distributionName,
    getDistributionMetricData_metricName,
    getDistributionMetricData_startTime,
    getDistributionMetricData_endTime,
    getDistributionMetricData_period,
    getDistributionMetricData_unit,
    getDistributionMetricData_statistics,

    -- * Destructuring the Response
    GetDistributionMetricDataResponse (..),
    newGetDistributionMetricDataResponse,

    -- * Response Lenses
    getDistributionMetricDataResponse_metricData,
    getDistributionMetricDataResponse_metricName,
    getDistributionMetricDataResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetDistributionMetricData' smart constructor.
data GetDistributionMetricData = GetDistributionMetricData'
  { -- | The name of the distribution for which to get metric data.
    --
    -- Use the @GetDistributions@ action to get a list of distribution names
    -- that you can specify.
    GetDistributionMetricData -> Text
distributionName :: Prelude.Text,
    -- | The metric for which you want to return information.
    --
    -- Valid distribution metric names are listed below, along with the most
    -- useful @statistics@ to include in your request, and the published @unit@
    -- value.
    --
    -- -   __@Requests@__ - The total number of viewer requests received by
    --     your Lightsail distribution, for all HTTP methods, and for both HTTP
    --     and HTTPS requests.
    --
    --     @Statistics@: The most useful statistic is @Sum@.
    --
    --     @Unit@: The published unit is @None@.
    --
    -- -   __@BytesDownloaded@__ - The number of bytes downloaded by viewers
    --     for GET, HEAD, and OPTIONS requests.
    --
    --     @Statistics@: The most useful statistic is @Sum@.
    --
    --     @Unit@: The published unit is @None@.
    --
    -- -   __@BytesUploaded @__ - The number of bytes uploaded to your origin
    --     by your Lightsail distribution, using POST and PUT requests.
    --
    --     @Statistics@: The most useful statistic is @Sum@.
    --
    --     @Unit@: The published unit is @None@.
    --
    -- -   __@TotalErrorRate@__ - The percentage of all viewer requests for
    --     which the response\'s HTTP status code was 4xx or 5xx.
    --
    --     @Statistics@: The most useful statistic is @Average@.
    --
    --     @Unit@: The published unit is @Percent@.
    --
    -- -   __@4xxErrorRate@__ - The percentage of all viewer requests for which
    --     the response\'s HTTP status cod was 4xx. In these cases, the client
    --     or client viewer may have made an error. For example, a status code
    --     of 404 (Not Found) means that the client requested an object that
    --     could not be found.
    --
    --     @Statistics@: The most useful statistic is @Average@.
    --
    --     @Unit@: The published unit is @Percent@.
    --
    -- -   __@5xxErrorRate@__ - The percentage of all viewer requests for which
    --     the response\'s HTTP status code was 5xx. In these cases, the origin
    --     server did not satisfy the requests. For example, a status code of
    --     503 (Service Unavailable) means that the origin server is currently
    --     unavailable.
    --
    --     @Statistics@: The most useful statistic is @Average@.
    --
    --     @Unit@: The published unit is @Percent@.
    GetDistributionMetricData -> DistributionMetricName
metricName :: DistributionMetricName,
    -- | The start of the time interval for which to get metric data.
    --
    -- Constraints:
    --
    -- -   Specified in Coordinated Universal Time (UTC).
    --
    -- -   Specified in the Unix time format.
    --
    --     For example, if you wish to use a start time of October 1, 2018, at
    --     8 PM UTC, specify @1538424000@ as the start time.
    --
    -- You can convert a human-friendly time to Unix time format using a
    -- converter like <https://www.epochconverter.com/ Epoch converter>.
    GetDistributionMetricData -> POSIX
startTime :: Data.POSIX,
    -- | The end of the time interval for which to get metric data.
    --
    -- Constraints:
    --
    -- -   Specified in Coordinated Universal Time (UTC).
    --
    -- -   Specified in the Unix time format.
    --
    --     For example, if you wish to use an end time of October 1, 2018, at 9
    --     PM UTC, specify @1538427600@ as the end time.
    --
    -- You can convert a human-friendly time to Unix time format using a
    -- converter like <https://www.epochconverter.com/ Epoch converter>.
    GetDistributionMetricData -> POSIX
endTime :: Data.POSIX,
    -- | The granularity, in seconds, for the metric data points that will be
    -- returned.
    GetDistributionMetricData -> Natural
period :: Prelude.Natural,
    -- | The unit for the metric data request.
    --
    -- Valid units depend on the metric data being requested. For the valid
    -- units with each available metric, see the @metricName@ parameter.
    GetDistributionMetricData -> MetricUnit
unit :: MetricUnit,
    -- | The statistic for the metric.
    --
    -- The following statistics are available:
    --
    -- -   @Minimum@ - The lowest value observed during the specified period.
    --     Use this value to determine low volumes of activity for your
    --     application.
    --
    -- -   @Maximum@ - The highest value observed during the specified period.
    --     Use this value to determine high volumes of activity for your
    --     application.
    --
    -- -   @Sum@ - All values submitted for the matching metric added together.
    --     You can use this statistic to determine the total volume of a
    --     metric.
    --
    -- -   @Average@ - The value of Sum \/ SampleCount during the specified
    --     period. By comparing this statistic with the Minimum and Maximum
    --     values, you can determine the full scope of a metric and how close
    --     the average use is to the Minimum and Maximum values. This
    --     comparison helps you to know when to increase or decrease your
    --     resources.
    --
    -- -   @SampleCount@ - The count, or number, of data points used for the
    --     statistical calculation.
    GetDistributionMetricData -> [MetricStatistic]
statistics :: [MetricStatistic]
  }
  deriving (GetDistributionMetricData -> GetDistributionMetricData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDistributionMetricData -> GetDistributionMetricData -> Bool
$c/= :: GetDistributionMetricData -> GetDistributionMetricData -> Bool
== :: GetDistributionMetricData -> GetDistributionMetricData -> Bool
$c== :: GetDistributionMetricData -> GetDistributionMetricData -> Bool
Prelude.Eq, ReadPrec [GetDistributionMetricData]
ReadPrec GetDistributionMetricData
Int -> ReadS GetDistributionMetricData
ReadS [GetDistributionMetricData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDistributionMetricData]
$creadListPrec :: ReadPrec [GetDistributionMetricData]
readPrec :: ReadPrec GetDistributionMetricData
$creadPrec :: ReadPrec GetDistributionMetricData
readList :: ReadS [GetDistributionMetricData]
$creadList :: ReadS [GetDistributionMetricData]
readsPrec :: Int -> ReadS GetDistributionMetricData
$creadsPrec :: Int -> ReadS GetDistributionMetricData
Prelude.Read, Int -> GetDistributionMetricData -> ShowS
[GetDistributionMetricData] -> ShowS
GetDistributionMetricData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDistributionMetricData] -> ShowS
$cshowList :: [GetDistributionMetricData] -> ShowS
show :: GetDistributionMetricData -> String
$cshow :: GetDistributionMetricData -> String
showsPrec :: Int -> GetDistributionMetricData -> ShowS
$cshowsPrec :: Int -> GetDistributionMetricData -> ShowS
Prelude.Show, forall x.
Rep GetDistributionMetricData x -> GetDistributionMetricData
forall x.
GetDistributionMetricData -> Rep GetDistributionMetricData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDistributionMetricData x -> GetDistributionMetricData
$cfrom :: forall x.
GetDistributionMetricData -> Rep GetDistributionMetricData x
Prelude.Generic)

-- |
-- Create a value of 'GetDistributionMetricData' 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:
--
-- 'distributionName', 'getDistributionMetricData_distributionName' - The name of the distribution for which to get metric data.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
--
-- 'metricName', 'getDistributionMetricData_metricName' - The metric for which you want to return information.
--
-- Valid distribution metric names are listed below, along with the most
-- useful @statistics@ to include in your request, and the published @unit@
-- value.
--
-- -   __@Requests@__ - The total number of viewer requests received by
--     your Lightsail distribution, for all HTTP methods, and for both HTTP
--     and HTTPS requests.
--
--     @Statistics@: The most useful statistic is @Sum@.
--
--     @Unit@: The published unit is @None@.
--
-- -   __@BytesDownloaded@__ - The number of bytes downloaded by viewers
--     for GET, HEAD, and OPTIONS requests.
--
--     @Statistics@: The most useful statistic is @Sum@.
--
--     @Unit@: The published unit is @None@.
--
-- -   __@BytesUploaded @__ - The number of bytes uploaded to your origin
--     by your Lightsail distribution, using POST and PUT requests.
--
--     @Statistics@: The most useful statistic is @Sum@.
--
--     @Unit@: The published unit is @None@.
--
-- -   __@TotalErrorRate@__ - The percentage of all viewer requests for
--     which the response\'s HTTP status code was 4xx or 5xx.
--
--     @Statistics@: The most useful statistic is @Average@.
--
--     @Unit@: The published unit is @Percent@.
--
-- -   __@4xxErrorRate@__ - The percentage of all viewer requests for which
--     the response\'s HTTP status cod was 4xx. In these cases, the client
--     or client viewer may have made an error. For example, a status code
--     of 404 (Not Found) means that the client requested an object that
--     could not be found.
--
--     @Statistics@: The most useful statistic is @Average@.
--
--     @Unit@: The published unit is @Percent@.
--
-- -   __@5xxErrorRate@__ - The percentage of all viewer requests for which
--     the response\'s HTTP status code was 5xx. In these cases, the origin
--     server did not satisfy the requests. For example, a status code of
--     503 (Service Unavailable) means that the origin server is currently
--     unavailable.
--
--     @Statistics@: The most useful statistic is @Average@.
--
--     @Unit@: The published unit is @Percent@.
--
-- 'startTime', 'getDistributionMetricData_startTime' - The start of the time interval for which to get metric data.
--
-- Constraints:
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Specified in the Unix time format.
--
--     For example, if you wish to use a start time of October 1, 2018, at
--     8 PM UTC, specify @1538424000@ as the start time.
--
-- You can convert a human-friendly time to Unix time format using a
-- converter like <https://www.epochconverter.com/ Epoch converter>.
--
-- 'endTime', 'getDistributionMetricData_endTime' - The end of the time interval for which to get metric data.
--
-- Constraints:
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Specified in the Unix time format.
--
--     For example, if you wish to use an end time of October 1, 2018, at 9
--     PM UTC, specify @1538427600@ as the end time.
--
-- You can convert a human-friendly time to Unix time format using a
-- converter like <https://www.epochconverter.com/ Epoch converter>.
--
-- 'period', 'getDistributionMetricData_period' - The granularity, in seconds, for the metric data points that will be
-- returned.
--
-- 'unit', 'getDistributionMetricData_unit' - The unit for the metric data request.
--
-- Valid units depend on the metric data being requested. For the valid
-- units with each available metric, see the @metricName@ parameter.
--
-- 'statistics', 'getDistributionMetricData_statistics' - The statistic for the metric.
--
-- The following statistics are available:
--
-- -   @Minimum@ - The lowest value observed during the specified period.
--     Use this value to determine low volumes of activity for your
--     application.
--
-- -   @Maximum@ - The highest value observed during the specified period.
--     Use this value to determine high volumes of activity for your
--     application.
--
-- -   @Sum@ - All values submitted for the matching metric added together.
--     You can use this statistic to determine the total volume of a
--     metric.
--
-- -   @Average@ - The value of Sum \/ SampleCount during the specified
--     period. By comparing this statistic with the Minimum and Maximum
--     values, you can determine the full scope of a metric and how close
--     the average use is to the Minimum and Maximum values. This
--     comparison helps you to know when to increase or decrease your
--     resources.
--
-- -   @SampleCount@ - The count, or number, of data points used for the
--     statistical calculation.
newGetDistributionMetricData ::
  -- | 'distributionName'
  Prelude.Text ->
  -- | 'metricName'
  DistributionMetricName ->
  -- | 'startTime'
  Prelude.UTCTime ->
  -- | 'endTime'
  Prelude.UTCTime ->
  -- | 'period'
  Prelude.Natural ->
  -- | 'unit'
  MetricUnit ->
  GetDistributionMetricData
newGetDistributionMetricData :: Text
-> DistributionMetricName
-> UTCTime
-> UTCTime
-> Natural
-> MetricUnit
-> GetDistributionMetricData
newGetDistributionMetricData
  Text
pDistributionName_
  DistributionMetricName
pMetricName_
  UTCTime
pStartTime_
  UTCTime
pEndTime_
  Natural
pPeriod_
  MetricUnit
pUnit_ =
    GetDistributionMetricData'
      { $sel:distributionName:GetDistributionMetricData' :: Text
distributionName =
          Text
pDistributionName_,
        $sel:metricName:GetDistributionMetricData' :: DistributionMetricName
metricName = DistributionMetricName
pMetricName_,
        $sel:startTime:GetDistributionMetricData' :: POSIX
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_,
        $sel:endTime:GetDistributionMetricData' :: POSIX
endTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pEndTime_,
        $sel:period:GetDistributionMetricData' :: Natural
period = Natural
pPeriod_,
        $sel:unit:GetDistributionMetricData' :: MetricUnit
unit = MetricUnit
pUnit_,
        $sel:statistics:GetDistributionMetricData' :: [MetricStatistic]
statistics = forall a. Monoid a => a
Prelude.mempty
      }

-- | The name of the distribution for which to get metric data.
--
-- Use the @GetDistributions@ action to get a list of distribution names
-- that you can specify.
getDistributionMetricData_distributionName :: Lens.Lens' GetDistributionMetricData Prelude.Text
getDistributionMetricData_distributionName :: Lens' GetDistributionMetricData Text
getDistributionMetricData_distributionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricData' {Text
distributionName :: Text
$sel:distributionName:GetDistributionMetricData' :: GetDistributionMetricData -> Text
distributionName} -> Text
distributionName) (\s :: GetDistributionMetricData
s@GetDistributionMetricData' {} Text
a -> GetDistributionMetricData
s {$sel:distributionName:GetDistributionMetricData' :: Text
distributionName = Text
a} :: GetDistributionMetricData)

-- | The metric for which you want to return information.
--
-- Valid distribution metric names are listed below, along with the most
-- useful @statistics@ to include in your request, and the published @unit@
-- value.
--
-- -   __@Requests@__ - The total number of viewer requests received by
--     your Lightsail distribution, for all HTTP methods, and for both HTTP
--     and HTTPS requests.
--
--     @Statistics@: The most useful statistic is @Sum@.
--
--     @Unit@: The published unit is @None@.
--
-- -   __@BytesDownloaded@__ - The number of bytes downloaded by viewers
--     for GET, HEAD, and OPTIONS requests.
--
--     @Statistics@: The most useful statistic is @Sum@.
--
--     @Unit@: The published unit is @None@.
--
-- -   __@BytesUploaded @__ - The number of bytes uploaded to your origin
--     by your Lightsail distribution, using POST and PUT requests.
--
--     @Statistics@: The most useful statistic is @Sum@.
--
--     @Unit@: The published unit is @None@.
--
-- -   __@TotalErrorRate@__ - The percentage of all viewer requests for
--     which the response\'s HTTP status code was 4xx or 5xx.
--
--     @Statistics@: The most useful statistic is @Average@.
--
--     @Unit@: The published unit is @Percent@.
--
-- -   __@4xxErrorRate@__ - The percentage of all viewer requests for which
--     the response\'s HTTP status cod was 4xx. In these cases, the client
--     or client viewer may have made an error. For example, a status code
--     of 404 (Not Found) means that the client requested an object that
--     could not be found.
--
--     @Statistics@: The most useful statistic is @Average@.
--
--     @Unit@: The published unit is @Percent@.
--
-- -   __@5xxErrorRate@__ - The percentage of all viewer requests for which
--     the response\'s HTTP status code was 5xx. In these cases, the origin
--     server did not satisfy the requests. For example, a status code of
--     503 (Service Unavailable) means that the origin server is currently
--     unavailable.
--
--     @Statistics@: The most useful statistic is @Average@.
--
--     @Unit@: The published unit is @Percent@.
getDistributionMetricData_metricName :: Lens.Lens' GetDistributionMetricData DistributionMetricName
getDistributionMetricData_metricName :: Lens' GetDistributionMetricData DistributionMetricName
getDistributionMetricData_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricData' {DistributionMetricName
metricName :: DistributionMetricName
$sel:metricName:GetDistributionMetricData' :: GetDistributionMetricData -> DistributionMetricName
metricName} -> DistributionMetricName
metricName) (\s :: GetDistributionMetricData
s@GetDistributionMetricData' {} DistributionMetricName
a -> GetDistributionMetricData
s {$sel:metricName:GetDistributionMetricData' :: DistributionMetricName
metricName = DistributionMetricName
a} :: GetDistributionMetricData)

-- | The start of the time interval for which to get metric data.
--
-- Constraints:
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Specified in the Unix time format.
--
--     For example, if you wish to use a start time of October 1, 2018, at
--     8 PM UTC, specify @1538424000@ as the start time.
--
-- You can convert a human-friendly time to Unix time format using a
-- converter like <https://www.epochconverter.com/ Epoch converter>.
getDistributionMetricData_startTime :: Lens.Lens' GetDistributionMetricData Prelude.UTCTime
getDistributionMetricData_startTime :: Lens' GetDistributionMetricData UTCTime
getDistributionMetricData_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricData' {POSIX
startTime :: POSIX
$sel:startTime:GetDistributionMetricData' :: GetDistributionMetricData -> POSIX
startTime} -> POSIX
startTime) (\s :: GetDistributionMetricData
s@GetDistributionMetricData' {} POSIX
a -> GetDistributionMetricData
s {$sel:startTime:GetDistributionMetricData' :: POSIX
startTime = POSIX
a} :: GetDistributionMetricData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The end of the time interval for which to get metric data.
--
-- Constraints:
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Specified in the Unix time format.
--
--     For example, if you wish to use an end time of October 1, 2018, at 9
--     PM UTC, specify @1538427600@ as the end time.
--
-- You can convert a human-friendly time to Unix time format using a
-- converter like <https://www.epochconverter.com/ Epoch converter>.
getDistributionMetricData_endTime :: Lens.Lens' GetDistributionMetricData Prelude.UTCTime
getDistributionMetricData_endTime :: Lens' GetDistributionMetricData UTCTime
getDistributionMetricData_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricData' {POSIX
endTime :: POSIX
$sel:endTime:GetDistributionMetricData' :: GetDistributionMetricData -> POSIX
endTime} -> POSIX
endTime) (\s :: GetDistributionMetricData
s@GetDistributionMetricData' {} POSIX
a -> GetDistributionMetricData
s {$sel:endTime:GetDistributionMetricData' :: POSIX
endTime = POSIX
a} :: GetDistributionMetricData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The granularity, in seconds, for the metric data points that will be
-- returned.
getDistributionMetricData_period :: Lens.Lens' GetDistributionMetricData Prelude.Natural
getDistributionMetricData_period :: Lens' GetDistributionMetricData Natural
getDistributionMetricData_period = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricData' {Natural
period :: Natural
$sel:period:GetDistributionMetricData' :: GetDistributionMetricData -> Natural
period} -> Natural
period) (\s :: GetDistributionMetricData
s@GetDistributionMetricData' {} Natural
a -> GetDistributionMetricData
s {$sel:period:GetDistributionMetricData' :: Natural
period = Natural
a} :: GetDistributionMetricData)

-- | The unit for the metric data request.
--
-- Valid units depend on the metric data being requested. For the valid
-- units with each available metric, see the @metricName@ parameter.
getDistributionMetricData_unit :: Lens.Lens' GetDistributionMetricData MetricUnit
getDistributionMetricData_unit :: Lens' GetDistributionMetricData MetricUnit
getDistributionMetricData_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricData' {MetricUnit
unit :: MetricUnit
$sel:unit:GetDistributionMetricData' :: GetDistributionMetricData -> MetricUnit
unit} -> MetricUnit
unit) (\s :: GetDistributionMetricData
s@GetDistributionMetricData' {} MetricUnit
a -> GetDistributionMetricData
s {$sel:unit:GetDistributionMetricData' :: MetricUnit
unit = MetricUnit
a} :: GetDistributionMetricData)

-- | The statistic for the metric.
--
-- The following statistics are available:
--
-- -   @Minimum@ - The lowest value observed during the specified period.
--     Use this value to determine low volumes of activity for your
--     application.
--
-- -   @Maximum@ - The highest value observed during the specified period.
--     Use this value to determine high volumes of activity for your
--     application.
--
-- -   @Sum@ - All values submitted for the matching metric added together.
--     You can use this statistic to determine the total volume of a
--     metric.
--
-- -   @Average@ - The value of Sum \/ SampleCount during the specified
--     period. By comparing this statistic with the Minimum and Maximum
--     values, you can determine the full scope of a metric and how close
--     the average use is to the Minimum and Maximum values. This
--     comparison helps you to know when to increase or decrease your
--     resources.
--
-- -   @SampleCount@ - The count, or number, of data points used for the
--     statistical calculation.
getDistributionMetricData_statistics :: Lens.Lens' GetDistributionMetricData [MetricStatistic]
getDistributionMetricData_statistics :: Lens' GetDistributionMetricData [MetricStatistic]
getDistributionMetricData_statistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricData' {[MetricStatistic]
statistics :: [MetricStatistic]
$sel:statistics:GetDistributionMetricData' :: GetDistributionMetricData -> [MetricStatistic]
statistics} -> [MetricStatistic]
statistics) (\s :: GetDistributionMetricData
s@GetDistributionMetricData' {} [MetricStatistic]
a -> GetDistributionMetricData
s {$sel:statistics:GetDistributionMetricData' :: [MetricStatistic]
statistics = [MetricStatistic]
a} :: GetDistributionMetricData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest GetDistributionMetricData where
  type
    AWSResponse GetDistributionMetricData =
      GetDistributionMetricDataResponse
  request :: (Service -> Service)
-> GetDistributionMetricData -> Request GetDistributionMetricData
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 GetDistributionMetricData
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDistributionMetricData)))
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 [MetricDatapoint]
-> Maybe DistributionMetricName
-> Int
-> GetDistributionMetricDataResponse
GetDistributionMetricDataResponse'
            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
"metricData" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"metricName")
            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 GetDistributionMetricData where
  hashWithSalt :: Int -> GetDistributionMetricData -> Int
hashWithSalt Int
_salt GetDistributionMetricData' {Natural
[MetricStatistic]
Text
POSIX
DistributionMetricName
MetricUnit
statistics :: [MetricStatistic]
unit :: MetricUnit
period :: Natural
endTime :: POSIX
startTime :: POSIX
metricName :: DistributionMetricName
distributionName :: Text
$sel:statistics:GetDistributionMetricData' :: GetDistributionMetricData -> [MetricStatistic]
$sel:unit:GetDistributionMetricData' :: GetDistributionMetricData -> MetricUnit
$sel:period:GetDistributionMetricData' :: GetDistributionMetricData -> Natural
$sel:endTime:GetDistributionMetricData' :: GetDistributionMetricData -> POSIX
$sel:startTime:GetDistributionMetricData' :: GetDistributionMetricData -> POSIX
$sel:metricName:GetDistributionMetricData' :: GetDistributionMetricData -> DistributionMetricName
$sel:distributionName:GetDistributionMetricData' :: GetDistributionMetricData -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
distributionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DistributionMetricName
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
period
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MetricUnit
unit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [MetricStatistic]
statistics

instance Prelude.NFData GetDistributionMetricData where
  rnf :: GetDistributionMetricData -> ()
rnf GetDistributionMetricData' {Natural
[MetricStatistic]
Text
POSIX
DistributionMetricName
MetricUnit
statistics :: [MetricStatistic]
unit :: MetricUnit
period :: Natural
endTime :: POSIX
startTime :: POSIX
metricName :: DistributionMetricName
distributionName :: Text
$sel:statistics:GetDistributionMetricData' :: GetDistributionMetricData -> [MetricStatistic]
$sel:unit:GetDistributionMetricData' :: GetDistributionMetricData -> MetricUnit
$sel:period:GetDistributionMetricData' :: GetDistributionMetricData -> Natural
$sel:endTime:GetDistributionMetricData' :: GetDistributionMetricData -> POSIX
$sel:startTime:GetDistributionMetricData' :: GetDistributionMetricData -> POSIX
$sel:metricName:GetDistributionMetricData' :: GetDistributionMetricData -> DistributionMetricName
$sel:distributionName:GetDistributionMetricData' :: GetDistributionMetricData -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
distributionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DistributionMetricName
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
period
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MetricUnit
unit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [MetricStatistic]
statistics

instance Data.ToHeaders GetDistributionMetricData where
  toHeaders :: GetDistributionMetricData -> 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
"Lightsail_20161128.GetDistributionMetricData" ::
                          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 GetDistributionMetricData where
  toJSON :: GetDistributionMetricData -> Value
toJSON GetDistributionMetricData' {Natural
[MetricStatistic]
Text
POSIX
DistributionMetricName
MetricUnit
statistics :: [MetricStatistic]
unit :: MetricUnit
period :: Natural
endTime :: POSIX
startTime :: POSIX
metricName :: DistributionMetricName
distributionName :: Text
$sel:statistics:GetDistributionMetricData' :: GetDistributionMetricData -> [MetricStatistic]
$sel:unit:GetDistributionMetricData' :: GetDistributionMetricData -> MetricUnit
$sel:period:GetDistributionMetricData' :: GetDistributionMetricData -> Natural
$sel:endTime:GetDistributionMetricData' :: GetDistributionMetricData -> POSIX
$sel:startTime:GetDistributionMetricData' :: GetDistributionMetricData -> POSIX
$sel:metricName:GetDistributionMetricData' :: GetDistributionMetricData -> DistributionMetricName
$sel:distributionName:GetDistributionMetricData' :: GetDistributionMetricData -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"distributionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
distributionName),
            forall a. a -> Maybe a
Prelude.Just (Key
"metricName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DistributionMetricName
metricName),
            forall a. a -> Maybe a
Prelude.Just (Key
"startTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
startTime),
            forall a. a -> Maybe a
Prelude.Just (Key
"endTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
endTime),
            forall a. a -> Maybe a
Prelude.Just (Key
"period" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
period),
            forall a. a -> Maybe a
Prelude.Just (Key
"unit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MetricUnit
unit),
            forall a. a -> Maybe a
Prelude.Just (Key
"statistics" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [MetricStatistic]
statistics)
          ]
      )

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

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

-- | /See:/ 'newGetDistributionMetricDataResponse' smart constructor.
data GetDistributionMetricDataResponse = GetDistributionMetricDataResponse'
  { -- | An array of objects that describe the metric data returned.
    GetDistributionMetricDataResponse -> Maybe [MetricDatapoint]
metricData :: Prelude.Maybe [MetricDatapoint],
    -- | The name of the metric returned.
    GetDistributionMetricDataResponse -> Maybe DistributionMetricName
metricName :: Prelude.Maybe DistributionMetricName,
    -- | The response's http status code.
    GetDistributionMetricDataResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDistributionMetricDataResponse
-> GetDistributionMetricDataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDistributionMetricDataResponse
-> GetDistributionMetricDataResponse -> Bool
$c/= :: GetDistributionMetricDataResponse
-> GetDistributionMetricDataResponse -> Bool
== :: GetDistributionMetricDataResponse
-> GetDistributionMetricDataResponse -> Bool
$c== :: GetDistributionMetricDataResponse
-> GetDistributionMetricDataResponse -> Bool
Prelude.Eq, ReadPrec [GetDistributionMetricDataResponse]
ReadPrec GetDistributionMetricDataResponse
Int -> ReadS GetDistributionMetricDataResponse
ReadS [GetDistributionMetricDataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDistributionMetricDataResponse]
$creadListPrec :: ReadPrec [GetDistributionMetricDataResponse]
readPrec :: ReadPrec GetDistributionMetricDataResponse
$creadPrec :: ReadPrec GetDistributionMetricDataResponse
readList :: ReadS [GetDistributionMetricDataResponse]
$creadList :: ReadS [GetDistributionMetricDataResponse]
readsPrec :: Int -> ReadS GetDistributionMetricDataResponse
$creadsPrec :: Int -> ReadS GetDistributionMetricDataResponse
Prelude.Read, Int -> GetDistributionMetricDataResponse -> ShowS
[GetDistributionMetricDataResponse] -> ShowS
GetDistributionMetricDataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDistributionMetricDataResponse] -> ShowS
$cshowList :: [GetDistributionMetricDataResponse] -> ShowS
show :: GetDistributionMetricDataResponse -> String
$cshow :: GetDistributionMetricDataResponse -> String
showsPrec :: Int -> GetDistributionMetricDataResponse -> ShowS
$cshowsPrec :: Int -> GetDistributionMetricDataResponse -> ShowS
Prelude.Show, forall x.
Rep GetDistributionMetricDataResponse x
-> GetDistributionMetricDataResponse
forall x.
GetDistributionMetricDataResponse
-> Rep GetDistributionMetricDataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDistributionMetricDataResponse x
-> GetDistributionMetricDataResponse
$cfrom :: forall x.
GetDistributionMetricDataResponse
-> Rep GetDistributionMetricDataResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDistributionMetricDataResponse' 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:
--
-- 'metricData', 'getDistributionMetricDataResponse_metricData' - An array of objects that describe the metric data returned.
--
-- 'metricName', 'getDistributionMetricDataResponse_metricName' - The name of the metric returned.
--
-- 'httpStatus', 'getDistributionMetricDataResponse_httpStatus' - The response's http status code.
newGetDistributionMetricDataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDistributionMetricDataResponse
newGetDistributionMetricDataResponse :: Int -> GetDistributionMetricDataResponse
newGetDistributionMetricDataResponse Int
pHttpStatus_ =
  GetDistributionMetricDataResponse'
    { $sel:metricData:GetDistributionMetricDataResponse' :: Maybe [MetricDatapoint]
metricData =
        forall a. Maybe a
Prelude.Nothing,
      $sel:metricName:GetDistributionMetricDataResponse' :: Maybe DistributionMetricName
metricName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDistributionMetricDataResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the metric data returned.
getDistributionMetricDataResponse_metricData :: Lens.Lens' GetDistributionMetricDataResponse (Prelude.Maybe [MetricDatapoint])
getDistributionMetricDataResponse_metricData :: Lens' GetDistributionMetricDataResponse (Maybe [MetricDatapoint])
getDistributionMetricDataResponse_metricData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricDataResponse' {Maybe [MetricDatapoint]
metricData :: Maybe [MetricDatapoint]
$sel:metricData:GetDistributionMetricDataResponse' :: GetDistributionMetricDataResponse -> Maybe [MetricDatapoint]
metricData} -> Maybe [MetricDatapoint]
metricData) (\s :: GetDistributionMetricDataResponse
s@GetDistributionMetricDataResponse' {} Maybe [MetricDatapoint]
a -> GetDistributionMetricDataResponse
s {$sel:metricData:GetDistributionMetricDataResponse' :: Maybe [MetricDatapoint]
metricData = Maybe [MetricDatapoint]
a} :: GetDistributionMetricDataResponse) 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 metric returned.
getDistributionMetricDataResponse_metricName :: Lens.Lens' GetDistributionMetricDataResponse (Prelude.Maybe DistributionMetricName)
getDistributionMetricDataResponse_metricName :: Lens'
  GetDistributionMetricDataResponse (Maybe DistributionMetricName)
getDistributionMetricDataResponse_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricDataResponse' {Maybe DistributionMetricName
metricName :: Maybe DistributionMetricName
$sel:metricName:GetDistributionMetricDataResponse' :: GetDistributionMetricDataResponse -> Maybe DistributionMetricName
metricName} -> Maybe DistributionMetricName
metricName) (\s :: GetDistributionMetricDataResponse
s@GetDistributionMetricDataResponse' {} Maybe DistributionMetricName
a -> GetDistributionMetricDataResponse
s {$sel:metricName:GetDistributionMetricDataResponse' :: Maybe DistributionMetricName
metricName = Maybe DistributionMetricName
a} :: GetDistributionMetricDataResponse)

-- | The response's http status code.
getDistributionMetricDataResponse_httpStatus :: Lens.Lens' GetDistributionMetricDataResponse Prelude.Int
getDistributionMetricDataResponse_httpStatus :: Lens' GetDistributionMetricDataResponse Int
getDistributionMetricDataResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDistributionMetricDataResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetDistributionMetricDataResponse' :: GetDistributionMetricDataResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetDistributionMetricDataResponse
s@GetDistributionMetricDataResponse' {} Int
a -> GetDistributionMetricDataResponse
s {$sel:httpStatus:GetDistributionMetricDataResponse' :: Int
httpStatus = Int
a} :: GetDistributionMetricDataResponse)

instance
  Prelude.NFData
    GetDistributionMetricDataResponse
  where
  rnf :: GetDistributionMetricDataResponse -> ()
rnf GetDistributionMetricDataResponse' {Int
Maybe [MetricDatapoint]
Maybe DistributionMetricName
httpStatus :: Int
metricName :: Maybe DistributionMetricName
metricData :: Maybe [MetricDatapoint]
$sel:httpStatus:GetDistributionMetricDataResponse' :: GetDistributionMetricDataResponse -> Int
$sel:metricName:GetDistributionMetricDataResponse' :: GetDistributionMetricDataResponse -> Maybe DistributionMetricName
$sel:metricData:GetDistributionMetricDataResponse' :: GetDistributionMetricDataResponse -> Maybe [MetricDatapoint]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MetricDatapoint]
metricData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DistributionMetricName
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus