{-# 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.CloudWatch.PutMetricData
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Publishes metric data points to Amazon CloudWatch. CloudWatch associates
-- the data points with the specified metric. If the specified metric does
-- not exist, CloudWatch creates the metric. When CloudWatch creates a
-- metric, it can take up to fifteen minutes for the metric to appear in
-- calls to
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_ListMetrics.html ListMetrics>.
--
-- You can publish either individual data points in the @Value@ field, or
-- arrays of values and the number of times each value occurred during the
-- period by using the @Values@ and @Counts@ fields in the @MetricDatum@
-- structure. Using the @Values@ and @Counts@ method enables you to publish
-- up to 150 values per metric with one @PutMetricData@ request, and
-- supports retrieving percentile statistics on this data.
--
-- Each @PutMetricData@ request is limited to 1 MB in size for HTTP POST
-- requests. You can send a payload compressed by gzip. Each request is
-- also limited to no more than 1000 different metrics.
--
-- Although the @Value@ parameter accepts numbers of type @Double@,
-- CloudWatch rejects values that are either too small or too large. Values
-- must be in the range of -2^360 to 2^360. In addition, special values
-- (for example, NaN, +Infinity, -Infinity) are not supported.
--
-- You can use up to 30 dimensions per metric to further clarify what data
-- the metric collects. Each dimension consists of a Name and Value pair.
-- For more information about specifying dimensions, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/publishingMetrics.html Publishing Metrics>
-- in the /Amazon CloudWatch User Guide/.
--
-- You specify the time stamp to be associated with each data point. You
-- can specify time stamps that are as much as two weeks before the current
-- date, and as much as 2 hours after the current day and time.
--
-- Data points with time stamps from 24 hours ago or longer can take at
-- least 48 hours to become available for
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_GetMetricData.html GetMetricData>
-- or
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_GetMetricStatistics.html GetMetricStatistics>
-- from the time they are submitted. Data points with time stamps between 3
-- and 24 hours ago can take as much as 2 hours to become available for for
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_GetMetricData.html GetMetricData>
-- or
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/API_GetMetricStatistics.html GetMetricStatistics>.
--
-- CloudWatch needs raw data points to calculate percentile statistics. If
-- you publish data using a statistic set instead, you can only retrieve
-- percentile statistics for this data if one of the following conditions
-- is true:
--
-- -   The @SampleCount@ value of the statistic set is 1 and @Min@, @Max@,
--     and @Sum@ are all equal.
--
-- -   The @Min@ and @Max@ are equal, and @Sum@ is equal to @Min@
--     multiplied by @SampleCount@.
module Amazonka.CloudWatch.PutMetricData
  ( -- * Creating a Request
    PutMetricData (..),
    newPutMetricData,

    -- * Request Lenses
    putMetricData_namespace,
    putMetricData_metricData,

    -- * Destructuring the Response
    PutMetricDataResponse (..),
    newPutMetricDataResponse,
  )
where

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

-- | /See:/ 'newPutMetricData' smart constructor.
data PutMetricData = PutMetricData'
  { -- | The namespace for the metric data.
    --
    -- To avoid conflicts with Amazon Web Services service namespaces, you
    -- should not specify a namespace that begins with @AWS\/@
    PutMetricData -> Text
namespace :: Prelude.Text,
    -- | The data for the metric. The array can include no more than 1000 metrics
    -- per call.
    PutMetricData -> [MetricDatum]
metricData :: [MetricDatum]
  }
  deriving (PutMetricData -> PutMetricData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutMetricData -> PutMetricData -> Bool
$c/= :: PutMetricData -> PutMetricData -> Bool
== :: PutMetricData -> PutMetricData -> Bool
$c== :: PutMetricData -> PutMetricData -> Bool
Prelude.Eq, ReadPrec [PutMetricData]
ReadPrec PutMetricData
Int -> ReadS PutMetricData
ReadS [PutMetricData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutMetricData]
$creadListPrec :: ReadPrec [PutMetricData]
readPrec :: ReadPrec PutMetricData
$creadPrec :: ReadPrec PutMetricData
readList :: ReadS [PutMetricData]
$creadList :: ReadS [PutMetricData]
readsPrec :: Int -> ReadS PutMetricData
$creadsPrec :: Int -> ReadS PutMetricData
Prelude.Read, Int -> PutMetricData -> ShowS
[PutMetricData] -> ShowS
PutMetricData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutMetricData] -> ShowS
$cshowList :: [PutMetricData] -> ShowS
show :: PutMetricData -> String
$cshow :: PutMetricData -> String
showsPrec :: Int -> PutMetricData -> ShowS
$cshowsPrec :: Int -> PutMetricData -> ShowS
Prelude.Show, forall x. Rep PutMetricData x -> PutMetricData
forall x. PutMetricData -> Rep PutMetricData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutMetricData x -> PutMetricData
$cfrom :: forall x. PutMetricData -> Rep PutMetricData x
Prelude.Generic)

-- |
-- Create a value of 'PutMetricData' 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:
--
-- 'namespace', 'putMetricData_namespace' - The namespace for the metric data.
--
-- To avoid conflicts with Amazon Web Services service namespaces, you
-- should not specify a namespace that begins with @AWS\/@
--
-- 'metricData', 'putMetricData_metricData' - The data for the metric. The array can include no more than 1000 metrics
-- per call.
newPutMetricData ::
  -- | 'namespace'
  Prelude.Text ->
  PutMetricData
newPutMetricData :: Text -> PutMetricData
newPutMetricData Text
pNamespace_ =
  PutMetricData'
    { $sel:namespace:PutMetricData' :: Text
namespace = Text
pNamespace_,
      $sel:metricData:PutMetricData' :: [MetricDatum]
metricData = forall a. Monoid a => a
Prelude.mempty
    }

-- | The namespace for the metric data.
--
-- To avoid conflicts with Amazon Web Services service namespaces, you
-- should not specify a namespace that begins with @AWS\/@
putMetricData_namespace :: Lens.Lens' PutMetricData Prelude.Text
putMetricData_namespace :: Lens' PutMetricData Text
putMetricData_namespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricData' {Text
namespace :: Text
$sel:namespace:PutMetricData' :: PutMetricData -> Text
namespace} -> Text
namespace) (\s :: PutMetricData
s@PutMetricData' {} Text
a -> PutMetricData
s {$sel:namespace:PutMetricData' :: Text
namespace = Text
a} :: PutMetricData)

-- | The data for the metric. The array can include no more than 1000 metrics
-- per call.
putMetricData_metricData :: Lens.Lens' PutMetricData [MetricDatum]
putMetricData_metricData :: Lens' PutMetricData [MetricDatum]
putMetricData_metricData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricData' {[MetricDatum]
metricData :: [MetricDatum]
$sel:metricData:PutMetricData' :: PutMetricData -> [MetricDatum]
metricData} -> [MetricDatum]
metricData) (\s :: PutMetricData
s@PutMetricData' {} [MetricDatum]
a -> PutMetricData
s {$sel:metricData:PutMetricData' :: [MetricDatum]
metricData = [MetricDatum]
a} :: PutMetricData) 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 PutMetricData where
  type
    AWSResponse PutMetricData =
      PutMetricDataResponse
  request :: (Service -> Service) -> PutMetricData -> Request PutMetricData
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutMetricData
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutMetricData)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutMetricDataResponse
PutMetricDataResponse'

instance Prelude.Hashable PutMetricData where
  hashWithSalt :: Int -> PutMetricData -> Int
hashWithSalt Int
_salt PutMetricData' {[MetricDatum]
Text
metricData :: [MetricDatum]
namespace :: Text
$sel:metricData:PutMetricData' :: PutMetricData -> [MetricDatum]
$sel:namespace:PutMetricData' :: PutMetricData -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
namespace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [MetricDatum]
metricData

instance Prelude.NFData PutMetricData where
  rnf :: PutMetricData -> ()
rnf PutMetricData' {[MetricDatum]
Text
metricData :: [MetricDatum]
namespace :: Text
$sel:metricData:PutMetricData' :: PutMetricData -> [MetricDatum]
$sel:namespace:PutMetricData' :: PutMetricData -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
namespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [MetricDatum]
metricData

instance Data.ToHeaders PutMetricData where
  toHeaders :: PutMetricData -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery PutMetricData where
  toQuery :: PutMetricData -> QueryString
toQuery PutMetricData' {[MetricDatum]
Text
metricData :: [MetricDatum]
namespace :: Text
$sel:metricData:PutMetricData' :: PutMetricData -> [MetricDatum]
$sel:namespace:PutMetricData' :: PutMetricData -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PutMetricData" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-08-01" :: Prelude.ByteString),
        ByteString
"Namespace" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
namespace,
        ByteString
"MetricData"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [MetricDatum]
metricData
      ]

-- | /See:/ 'newPutMetricDataResponse' smart constructor.
data PutMetricDataResponse = PutMetricDataResponse'
  {
  }
  deriving (PutMetricDataResponse -> PutMetricDataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutMetricDataResponse -> PutMetricDataResponse -> Bool
$c/= :: PutMetricDataResponse -> PutMetricDataResponse -> Bool
== :: PutMetricDataResponse -> PutMetricDataResponse -> Bool
$c== :: PutMetricDataResponse -> PutMetricDataResponse -> Bool
Prelude.Eq, ReadPrec [PutMetricDataResponse]
ReadPrec PutMetricDataResponse
Int -> ReadS PutMetricDataResponse
ReadS [PutMetricDataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutMetricDataResponse]
$creadListPrec :: ReadPrec [PutMetricDataResponse]
readPrec :: ReadPrec PutMetricDataResponse
$creadPrec :: ReadPrec PutMetricDataResponse
readList :: ReadS [PutMetricDataResponse]
$creadList :: ReadS [PutMetricDataResponse]
readsPrec :: Int -> ReadS PutMetricDataResponse
$creadsPrec :: Int -> ReadS PutMetricDataResponse
Prelude.Read, Int -> PutMetricDataResponse -> ShowS
[PutMetricDataResponse] -> ShowS
PutMetricDataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutMetricDataResponse] -> ShowS
$cshowList :: [PutMetricDataResponse] -> ShowS
show :: PutMetricDataResponse -> String
$cshow :: PutMetricDataResponse -> String
showsPrec :: Int -> PutMetricDataResponse -> ShowS
$cshowsPrec :: Int -> PutMetricDataResponse -> ShowS
Prelude.Show, forall x. Rep PutMetricDataResponse x -> PutMetricDataResponse
forall x. PutMetricDataResponse -> Rep PutMetricDataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutMetricDataResponse x -> PutMetricDataResponse
$cfrom :: forall x. PutMetricDataResponse -> Rep PutMetricDataResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutMetricDataResponse' 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.
newPutMetricDataResponse ::
  PutMetricDataResponse
newPutMetricDataResponse :: PutMetricDataResponse
newPutMetricDataResponse = PutMetricDataResponse
PutMetricDataResponse'

instance Prelude.NFData PutMetricDataResponse where
  rnf :: PutMetricDataResponse -> ()
rnf PutMetricDataResponse
_ = ()