{-# 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.GetBucketMetricData
-- 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
-- bucket.
--
-- Metrics report the utilization of a bucket. View and collect metric data
-- regularly to monitor the number of objects stored in a bucket (including
-- object versions) and the storage space used by those objects.
module Amazonka.Lightsail.GetBucketMetricData
  ( -- * Creating a Request
    GetBucketMetricData (..),
    newGetBucketMetricData,

    -- * Request Lenses
    getBucketMetricData_bucketName,
    getBucketMetricData_metricName,
    getBucketMetricData_startTime,
    getBucketMetricData_endTime,
    getBucketMetricData_period,
    getBucketMetricData_statistics,
    getBucketMetricData_unit,

    -- * Destructuring the Response
    GetBucketMetricDataResponse (..),
    newGetBucketMetricDataResponse,

    -- * Response Lenses
    getBucketMetricDataResponse_metricData,
    getBucketMetricDataResponse_metricName,
    getBucketMetricDataResponse_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:/ 'newGetBucketMetricData' smart constructor.
data GetBucketMetricData = GetBucketMetricData'
  { -- | The name of the bucket for which to get metric data.
    GetBucketMetricData -> Text
bucketName :: Prelude.Text,
    -- | The metric for which you want to return information.
    --
    -- Valid bucket metric names are listed below, along with the most useful
    -- statistics to include in your request, and the published unit value.
    --
    -- These bucket metrics are reported once per day.
    --
    -- -   __@BucketSizeBytes@__ - The amount of data in bytes stored in a
    --     bucket. This value is calculated by summing the size of all objects
    --     in the bucket (including object versions), including the size of all
    --     parts for all incomplete multipart uploads to the bucket.
    --
    --     Statistics: The most useful statistic is @Maximum@.
    --
    --     Unit: The published unit is @Bytes@.
    --
    -- -   __@NumberOfObjects@__ - The total number of objects stored in a
    --     bucket. This value is calculated by counting all objects in the
    --     bucket (including object versions) and the total number of parts for
    --     all incomplete multipart uploads to the bucket.
    --
    --     Statistics: The most useful statistic is @Average@.
    --
    --     Unit: The published unit is @Count@.
    GetBucketMetricData -> BucketMetricName
metricName :: BucketMetricName,
    -- | The timestamp indicating the earliest data to be returned.
    GetBucketMetricData -> POSIX
startTime :: Data.POSIX,
    -- | The timestamp indicating the latest data to be returned.
    GetBucketMetricData -> POSIX
endTime :: Data.POSIX,
    -- | The granularity, in seconds, of the returned data points.
    --
    -- Bucket storage metrics are reported once per day. Therefore, you should
    -- specify a period of 86400 seconds, which is the number of seconds in a
    -- day.
    GetBucketMetricData -> Natural
period :: Prelude.Natural,
    -- | 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@ - The sum of all values submitted for the matching metric. 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.
    GetBucketMetricData -> [MetricStatistic]
statistics :: [MetricStatistic],
    -- | 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.
    GetBucketMetricData -> MetricUnit
unit :: MetricUnit
  }
  deriving (GetBucketMetricData -> GetBucketMetricData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBucketMetricData -> GetBucketMetricData -> Bool
$c/= :: GetBucketMetricData -> GetBucketMetricData -> Bool
== :: GetBucketMetricData -> GetBucketMetricData -> Bool
$c== :: GetBucketMetricData -> GetBucketMetricData -> Bool
Prelude.Eq, ReadPrec [GetBucketMetricData]
ReadPrec GetBucketMetricData
Int -> ReadS GetBucketMetricData
ReadS [GetBucketMetricData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBucketMetricData]
$creadListPrec :: ReadPrec [GetBucketMetricData]
readPrec :: ReadPrec GetBucketMetricData
$creadPrec :: ReadPrec GetBucketMetricData
readList :: ReadS [GetBucketMetricData]
$creadList :: ReadS [GetBucketMetricData]
readsPrec :: Int -> ReadS GetBucketMetricData
$creadsPrec :: Int -> ReadS GetBucketMetricData
Prelude.Read, Int -> GetBucketMetricData -> ShowS
[GetBucketMetricData] -> ShowS
GetBucketMetricData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketMetricData] -> ShowS
$cshowList :: [GetBucketMetricData] -> ShowS
show :: GetBucketMetricData -> String
$cshow :: GetBucketMetricData -> String
showsPrec :: Int -> GetBucketMetricData -> ShowS
$cshowsPrec :: Int -> GetBucketMetricData -> ShowS
Prelude.Show, forall x. Rep GetBucketMetricData x -> GetBucketMetricData
forall x. GetBucketMetricData -> Rep GetBucketMetricData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBucketMetricData x -> GetBucketMetricData
$cfrom :: forall x. GetBucketMetricData -> Rep GetBucketMetricData x
Prelude.Generic)

-- |
-- Create a value of 'GetBucketMetricData' 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:
--
-- 'bucketName', 'getBucketMetricData_bucketName' - The name of the bucket for which to get metric data.
--
-- 'metricName', 'getBucketMetricData_metricName' - The metric for which you want to return information.
--
-- Valid bucket metric names are listed below, along with the most useful
-- statistics to include in your request, and the published unit value.
--
-- These bucket metrics are reported once per day.
--
-- -   __@BucketSizeBytes@__ - The amount of data in bytes stored in a
--     bucket. This value is calculated by summing the size of all objects
--     in the bucket (including object versions), including the size of all
--     parts for all incomplete multipart uploads to the bucket.
--
--     Statistics: The most useful statistic is @Maximum@.
--
--     Unit: The published unit is @Bytes@.
--
-- -   __@NumberOfObjects@__ - The total number of objects stored in a
--     bucket. This value is calculated by counting all objects in the
--     bucket (including object versions) and the total number of parts for
--     all incomplete multipart uploads to the bucket.
--
--     Statistics: The most useful statistic is @Average@.
--
--     Unit: The published unit is @Count@.
--
-- 'startTime', 'getBucketMetricData_startTime' - The timestamp indicating the earliest data to be returned.
--
-- 'endTime', 'getBucketMetricData_endTime' - The timestamp indicating the latest data to be returned.
--
-- 'period', 'getBucketMetricData_period' - The granularity, in seconds, of the returned data points.
--
-- Bucket storage metrics are reported once per day. Therefore, you should
-- specify a period of 86400 seconds, which is the number of seconds in a
-- day.
--
-- 'statistics', 'getBucketMetricData_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@ - The sum of all values submitted for the matching metric. 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.
--
-- 'unit', 'getBucketMetricData_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.
newGetBucketMetricData ::
  -- | 'bucketName'
  Prelude.Text ->
  -- | 'metricName'
  BucketMetricName ->
  -- | 'startTime'
  Prelude.UTCTime ->
  -- | 'endTime'
  Prelude.UTCTime ->
  -- | 'period'
  Prelude.Natural ->
  -- | 'unit'
  MetricUnit ->
  GetBucketMetricData
newGetBucketMetricData :: Text
-> BucketMetricName
-> UTCTime
-> UTCTime
-> Natural
-> MetricUnit
-> GetBucketMetricData
newGetBucketMetricData
  Text
pBucketName_
  BucketMetricName
pMetricName_
  UTCTime
pStartTime_
  UTCTime
pEndTime_
  Natural
pPeriod_
  MetricUnit
pUnit_ =
    GetBucketMetricData'
      { $sel:bucketName:GetBucketMetricData' :: Text
bucketName = Text
pBucketName_,
        $sel:metricName:GetBucketMetricData' :: BucketMetricName
metricName = BucketMetricName
pMetricName_,
        $sel:startTime:GetBucketMetricData' :: POSIX
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_,
        $sel:endTime:GetBucketMetricData' :: POSIX
endTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pEndTime_,
        $sel:period:GetBucketMetricData' :: Natural
period = Natural
pPeriod_,
        $sel:statistics:GetBucketMetricData' :: [MetricStatistic]
statistics = forall a. Monoid a => a
Prelude.mempty,
        $sel:unit:GetBucketMetricData' :: MetricUnit
unit = MetricUnit
pUnit_
      }

-- | The name of the bucket for which to get metric data.
getBucketMetricData_bucketName :: Lens.Lens' GetBucketMetricData Prelude.Text
getBucketMetricData_bucketName :: Lens' GetBucketMetricData Text
getBucketMetricData_bucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketMetricData' {Text
bucketName :: Text
$sel:bucketName:GetBucketMetricData' :: GetBucketMetricData -> Text
bucketName} -> Text
bucketName) (\s :: GetBucketMetricData
s@GetBucketMetricData' {} Text
a -> GetBucketMetricData
s {$sel:bucketName:GetBucketMetricData' :: Text
bucketName = Text
a} :: GetBucketMetricData)

-- | The metric for which you want to return information.
--
-- Valid bucket metric names are listed below, along with the most useful
-- statistics to include in your request, and the published unit value.
--
-- These bucket metrics are reported once per day.
--
-- -   __@BucketSizeBytes@__ - The amount of data in bytes stored in a
--     bucket. This value is calculated by summing the size of all objects
--     in the bucket (including object versions), including the size of all
--     parts for all incomplete multipart uploads to the bucket.
--
--     Statistics: The most useful statistic is @Maximum@.
--
--     Unit: The published unit is @Bytes@.
--
-- -   __@NumberOfObjects@__ - The total number of objects stored in a
--     bucket. This value is calculated by counting all objects in the
--     bucket (including object versions) and the total number of parts for
--     all incomplete multipart uploads to the bucket.
--
--     Statistics: The most useful statistic is @Average@.
--
--     Unit: The published unit is @Count@.
getBucketMetricData_metricName :: Lens.Lens' GetBucketMetricData BucketMetricName
getBucketMetricData_metricName :: Lens' GetBucketMetricData BucketMetricName
getBucketMetricData_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketMetricData' {BucketMetricName
metricName :: BucketMetricName
$sel:metricName:GetBucketMetricData' :: GetBucketMetricData -> BucketMetricName
metricName} -> BucketMetricName
metricName) (\s :: GetBucketMetricData
s@GetBucketMetricData' {} BucketMetricName
a -> GetBucketMetricData
s {$sel:metricName:GetBucketMetricData' :: BucketMetricName
metricName = BucketMetricName
a} :: GetBucketMetricData)

-- | The timestamp indicating the earliest data to be returned.
getBucketMetricData_startTime :: Lens.Lens' GetBucketMetricData Prelude.UTCTime
getBucketMetricData_startTime :: Lens' GetBucketMetricData UTCTime
getBucketMetricData_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketMetricData' {POSIX
startTime :: POSIX
$sel:startTime:GetBucketMetricData' :: GetBucketMetricData -> POSIX
startTime} -> POSIX
startTime) (\s :: GetBucketMetricData
s@GetBucketMetricData' {} POSIX
a -> GetBucketMetricData
s {$sel:startTime:GetBucketMetricData' :: POSIX
startTime = POSIX
a} :: GetBucketMetricData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The timestamp indicating the latest data to be returned.
getBucketMetricData_endTime :: Lens.Lens' GetBucketMetricData Prelude.UTCTime
getBucketMetricData_endTime :: Lens' GetBucketMetricData UTCTime
getBucketMetricData_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketMetricData' {POSIX
endTime :: POSIX
$sel:endTime:GetBucketMetricData' :: GetBucketMetricData -> POSIX
endTime} -> POSIX
endTime) (\s :: GetBucketMetricData
s@GetBucketMetricData' {} POSIX
a -> GetBucketMetricData
s {$sel:endTime:GetBucketMetricData' :: POSIX
endTime = POSIX
a} :: GetBucketMetricData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The granularity, in seconds, of the returned data points.
--
-- Bucket storage metrics are reported once per day. Therefore, you should
-- specify a period of 86400 seconds, which is the number of seconds in a
-- day.
getBucketMetricData_period :: Lens.Lens' GetBucketMetricData Prelude.Natural
getBucketMetricData_period :: Lens' GetBucketMetricData Natural
getBucketMetricData_period = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketMetricData' {Natural
period :: Natural
$sel:period:GetBucketMetricData' :: GetBucketMetricData -> Natural
period} -> Natural
period) (\s :: GetBucketMetricData
s@GetBucketMetricData' {} Natural
a -> GetBucketMetricData
s {$sel:period:GetBucketMetricData' :: Natural
period = Natural
a} :: GetBucketMetricData)

-- | 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@ - The sum of all values submitted for the matching metric. 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.
getBucketMetricData_statistics :: Lens.Lens' GetBucketMetricData [MetricStatistic]
getBucketMetricData_statistics :: Lens' GetBucketMetricData [MetricStatistic]
getBucketMetricData_statistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketMetricData' {[MetricStatistic]
statistics :: [MetricStatistic]
$sel:statistics:GetBucketMetricData' :: GetBucketMetricData -> [MetricStatistic]
statistics} -> [MetricStatistic]
statistics) (\s :: GetBucketMetricData
s@GetBucketMetricData' {} [MetricStatistic]
a -> GetBucketMetricData
s {$sel:statistics:GetBucketMetricData' :: [MetricStatistic]
statistics = [MetricStatistic]
a} :: GetBucketMetricData) 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

-- | 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.
getBucketMetricData_unit :: Lens.Lens' GetBucketMetricData MetricUnit
getBucketMetricData_unit :: Lens' GetBucketMetricData MetricUnit
getBucketMetricData_unit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketMetricData' {MetricUnit
unit :: MetricUnit
$sel:unit:GetBucketMetricData' :: GetBucketMetricData -> MetricUnit
unit} -> MetricUnit
unit) (\s :: GetBucketMetricData
s@GetBucketMetricData' {} MetricUnit
a -> GetBucketMetricData
s {$sel:unit:GetBucketMetricData' :: MetricUnit
unit = MetricUnit
a} :: GetBucketMetricData)

instance Core.AWSRequest GetBucketMetricData where
  type
    AWSResponse GetBucketMetricData =
      GetBucketMetricDataResponse
  request :: (Service -> Service)
-> GetBucketMetricData -> Request GetBucketMetricData
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 GetBucketMetricData
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetBucketMetricData)))
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 BucketMetricName -> Int -> GetBucketMetricDataResponse
GetBucketMetricDataResponse'
            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 GetBucketMetricData where
  hashWithSalt :: Int -> GetBucketMetricData -> Int
hashWithSalt Int
_salt GetBucketMetricData' {Natural
[MetricStatistic]
Text
POSIX
BucketMetricName
MetricUnit
unit :: MetricUnit
statistics :: [MetricStatistic]
period :: Natural
endTime :: POSIX
startTime :: POSIX
metricName :: BucketMetricName
bucketName :: Text
$sel:unit:GetBucketMetricData' :: GetBucketMetricData -> MetricUnit
$sel:statistics:GetBucketMetricData' :: GetBucketMetricData -> [MetricStatistic]
$sel:period:GetBucketMetricData' :: GetBucketMetricData -> Natural
$sel:endTime:GetBucketMetricData' :: GetBucketMetricData -> POSIX
$sel:startTime:GetBucketMetricData' :: GetBucketMetricData -> POSIX
$sel:metricName:GetBucketMetricData' :: GetBucketMetricData -> BucketMetricName
$sel:bucketName:GetBucketMetricData' :: GetBucketMetricData -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketMetricName
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` [MetricStatistic]
statistics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MetricUnit
unit

instance Prelude.NFData GetBucketMetricData where
  rnf :: GetBucketMetricData -> ()
rnf GetBucketMetricData' {Natural
[MetricStatistic]
Text
POSIX
BucketMetricName
MetricUnit
unit :: MetricUnit
statistics :: [MetricStatistic]
period :: Natural
endTime :: POSIX
startTime :: POSIX
metricName :: BucketMetricName
bucketName :: Text
$sel:unit:GetBucketMetricData' :: GetBucketMetricData -> MetricUnit
$sel:statistics:GetBucketMetricData' :: GetBucketMetricData -> [MetricStatistic]
$sel:period:GetBucketMetricData' :: GetBucketMetricData -> Natural
$sel:endTime:GetBucketMetricData' :: GetBucketMetricData -> POSIX
$sel:startTime:GetBucketMetricData' :: GetBucketMetricData -> POSIX
$sel:metricName:GetBucketMetricData' :: GetBucketMetricData -> BucketMetricName
$sel:bucketName:GetBucketMetricData' :: GetBucketMetricData -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
bucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BucketMetricName
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 [MetricStatistic]
statistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MetricUnit
unit

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

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

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

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

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

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

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

instance Prelude.NFData GetBucketMetricDataResponse where
  rnf :: GetBucketMetricDataResponse -> ()
rnf GetBucketMetricDataResponse' {Int
Maybe [MetricDatapoint]
Maybe BucketMetricName
httpStatus :: Int
metricName :: Maybe BucketMetricName
metricData :: Maybe [MetricDatapoint]
$sel:httpStatus:GetBucketMetricDataResponse' :: GetBucketMetricDataResponse -> Int
$sel:metricName:GetBucketMetricDataResponse' :: GetBucketMetricDataResponse -> Maybe BucketMetricName
$sel:metricData:GetBucketMetricDataResponse' :: GetBucketMetricDataResponse -> 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 BucketMetricName
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus