{-# 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.CloudWatchLogs.PutMetricFilter
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates or updates a metric filter and associates it with the specified
-- log group. With metric filters, you can configure rules to extract
-- metric data from log events ingested through
-- <https://docs.aws.amazon.com/AmazonCloudWatchLogs/latest/APIReference/API_PutLogEvents.html PutLogEvents>.
--
-- The maximum number of metric filters that can be associated with a log
-- group is 100.
--
-- When you create a metric filter, you can also optionally assign a unit
-- and dimensions to the metric that is created.
--
-- Metrics extracted from log events are charged as custom metrics. To
-- prevent unexpected high charges, do not specify high-cardinality fields
-- such as @IPAddress@ or @requestID@ as dimensions. Each different value
-- found for a dimension is treated as a separate metric and accrues
-- charges as a separate custom metric.
--
-- CloudWatch Logs disables a metric filter if it generates 1,000 different
-- name\/value pairs for your specified dimensions within a certain amount
-- of time. This helps to prevent accidental high charges.
--
-- You can also set up a billing alarm to alert you if your charges are
-- higher than expected. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/monitor_estimated_charges_with_cloudwatch.html Creating a Billing Alarm to Monitor Your Estimated Amazon Web Services Charges>.
module Amazonka.CloudWatchLogs.PutMetricFilter
  ( -- * Creating a Request
    PutMetricFilter (..),
    newPutMetricFilter,

    -- * Request Lenses
    putMetricFilter_logGroupName,
    putMetricFilter_filterName,
    putMetricFilter_filterPattern,
    putMetricFilter_metricTransformations,

    -- * Destructuring the Response
    PutMetricFilterResponse (..),
    newPutMetricFilterResponse,
  )
where

import Amazonka.CloudWatchLogs.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:/ 'newPutMetricFilter' smart constructor.
data PutMetricFilter = PutMetricFilter'
  { -- | The name of the log group.
    PutMetricFilter -> Text
logGroupName :: Prelude.Text,
    -- | A name for the metric filter.
    PutMetricFilter -> Text
filterName :: Prelude.Text,
    -- | A filter pattern for extracting metric data out of ingested log events.
    PutMetricFilter -> Text
filterPattern :: Prelude.Text,
    -- | A collection of information that defines how metric data gets emitted.
    PutMetricFilter -> NonEmpty MetricTransformation
metricTransformations :: Prelude.NonEmpty MetricTransformation
  }
  deriving (PutMetricFilter -> PutMetricFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutMetricFilter -> PutMetricFilter -> Bool
$c/= :: PutMetricFilter -> PutMetricFilter -> Bool
== :: PutMetricFilter -> PutMetricFilter -> Bool
$c== :: PutMetricFilter -> PutMetricFilter -> Bool
Prelude.Eq, ReadPrec [PutMetricFilter]
ReadPrec PutMetricFilter
Int -> ReadS PutMetricFilter
ReadS [PutMetricFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutMetricFilter]
$creadListPrec :: ReadPrec [PutMetricFilter]
readPrec :: ReadPrec PutMetricFilter
$creadPrec :: ReadPrec PutMetricFilter
readList :: ReadS [PutMetricFilter]
$creadList :: ReadS [PutMetricFilter]
readsPrec :: Int -> ReadS PutMetricFilter
$creadsPrec :: Int -> ReadS PutMetricFilter
Prelude.Read, Int -> PutMetricFilter -> ShowS
[PutMetricFilter] -> ShowS
PutMetricFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutMetricFilter] -> ShowS
$cshowList :: [PutMetricFilter] -> ShowS
show :: PutMetricFilter -> String
$cshow :: PutMetricFilter -> String
showsPrec :: Int -> PutMetricFilter -> ShowS
$cshowsPrec :: Int -> PutMetricFilter -> ShowS
Prelude.Show, forall x. Rep PutMetricFilter x -> PutMetricFilter
forall x. PutMetricFilter -> Rep PutMetricFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutMetricFilter x -> PutMetricFilter
$cfrom :: forall x. PutMetricFilter -> Rep PutMetricFilter x
Prelude.Generic)

-- |
-- Create a value of 'PutMetricFilter' 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:
--
-- 'logGroupName', 'putMetricFilter_logGroupName' - The name of the log group.
--
-- 'filterName', 'putMetricFilter_filterName' - A name for the metric filter.
--
-- 'filterPattern', 'putMetricFilter_filterPattern' - A filter pattern for extracting metric data out of ingested log events.
--
-- 'metricTransformations', 'putMetricFilter_metricTransformations' - A collection of information that defines how metric data gets emitted.
newPutMetricFilter ::
  -- | 'logGroupName'
  Prelude.Text ->
  -- | 'filterName'
  Prelude.Text ->
  -- | 'filterPattern'
  Prelude.Text ->
  -- | 'metricTransformations'
  Prelude.NonEmpty MetricTransformation ->
  PutMetricFilter
newPutMetricFilter :: Text
-> Text -> Text -> NonEmpty MetricTransformation -> PutMetricFilter
newPutMetricFilter
  Text
pLogGroupName_
  Text
pFilterName_
  Text
pFilterPattern_
  NonEmpty MetricTransformation
pMetricTransformations_ =
    PutMetricFilter'
      { $sel:logGroupName:PutMetricFilter' :: Text
logGroupName = Text
pLogGroupName_,
        $sel:filterName:PutMetricFilter' :: Text
filterName = Text
pFilterName_,
        $sel:filterPattern:PutMetricFilter' :: Text
filterPattern = Text
pFilterPattern_,
        $sel:metricTransformations:PutMetricFilter' :: NonEmpty MetricTransformation
metricTransformations =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty MetricTransformation
pMetricTransformations_
      }

-- | The name of the log group.
putMetricFilter_logGroupName :: Lens.Lens' PutMetricFilter Prelude.Text
putMetricFilter_logGroupName :: Lens' PutMetricFilter Text
putMetricFilter_logGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricFilter' {Text
logGroupName :: Text
$sel:logGroupName:PutMetricFilter' :: PutMetricFilter -> Text
logGroupName} -> Text
logGroupName) (\s :: PutMetricFilter
s@PutMetricFilter' {} Text
a -> PutMetricFilter
s {$sel:logGroupName:PutMetricFilter' :: Text
logGroupName = Text
a} :: PutMetricFilter)

-- | A name for the metric filter.
putMetricFilter_filterName :: Lens.Lens' PutMetricFilter Prelude.Text
putMetricFilter_filterName :: Lens' PutMetricFilter Text
putMetricFilter_filterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricFilter' {Text
filterName :: Text
$sel:filterName:PutMetricFilter' :: PutMetricFilter -> Text
filterName} -> Text
filterName) (\s :: PutMetricFilter
s@PutMetricFilter' {} Text
a -> PutMetricFilter
s {$sel:filterName:PutMetricFilter' :: Text
filterName = Text
a} :: PutMetricFilter)

-- | A filter pattern for extracting metric data out of ingested log events.
putMetricFilter_filterPattern :: Lens.Lens' PutMetricFilter Prelude.Text
putMetricFilter_filterPattern :: Lens' PutMetricFilter Text
putMetricFilter_filterPattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricFilter' {Text
filterPattern :: Text
$sel:filterPattern:PutMetricFilter' :: PutMetricFilter -> Text
filterPattern} -> Text
filterPattern) (\s :: PutMetricFilter
s@PutMetricFilter' {} Text
a -> PutMetricFilter
s {$sel:filterPattern:PutMetricFilter' :: Text
filterPattern = Text
a} :: PutMetricFilter)

-- | A collection of information that defines how metric data gets emitted.
putMetricFilter_metricTransformations :: Lens.Lens' PutMetricFilter (Prelude.NonEmpty MetricTransformation)
putMetricFilter_metricTransformations :: Lens' PutMetricFilter (NonEmpty MetricTransformation)
putMetricFilter_metricTransformations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMetricFilter' {NonEmpty MetricTransformation
metricTransformations :: NonEmpty MetricTransformation
$sel:metricTransformations:PutMetricFilter' :: PutMetricFilter -> NonEmpty MetricTransformation
metricTransformations} -> NonEmpty MetricTransformation
metricTransformations) (\s :: PutMetricFilter
s@PutMetricFilter' {} NonEmpty MetricTransformation
a -> PutMetricFilter
s {$sel:metricTransformations:PutMetricFilter' :: NonEmpty MetricTransformation
metricTransformations = NonEmpty MetricTransformation
a} :: PutMetricFilter) 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 PutMetricFilter where
  type
    AWSResponse PutMetricFilter =
      PutMetricFilterResponse
  request :: (Service -> Service) -> PutMetricFilter -> Request PutMetricFilter
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 PutMetricFilter
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutMetricFilter)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutMetricFilterResponse
PutMetricFilterResponse'

instance Prelude.Hashable PutMetricFilter where
  hashWithSalt :: Int -> PutMetricFilter -> Int
hashWithSalt Int
_salt PutMetricFilter' {NonEmpty MetricTransformation
Text
metricTransformations :: NonEmpty MetricTransformation
filterPattern :: Text
filterName :: Text
logGroupName :: Text
$sel:metricTransformations:PutMetricFilter' :: PutMetricFilter -> NonEmpty MetricTransformation
$sel:filterPattern:PutMetricFilter' :: PutMetricFilter -> Text
$sel:filterName:PutMetricFilter' :: PutMetricFilter -> Text
$sel:logGroupName:PutMetricFilter' :: PutMetricFilter -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
filterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
filterPattern
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty MetricTransformation
metricTransformations

instance Prelude.NFData PutMetricFilter where
  rnf :: PutMetricFilter -> ()
rnf PutMetricFilter' {NonEmpty MetricTransformation
Text
metricTransformations :: NonEmpty MetricTransformation
filterPattern :: Text
filterName :: Text
logGroupName :: Text
$sel:metricTransformations:PutMetricFilter' :: PutMetricFilter -> NonEmpty MetricTransformation
$sel:filterPattern:PutMetricFilter' :: PutMetricFilter -> Text
$sel:filterName:PutMetricFilter' :: PutMetricFilter -> Text
$sel:logGroupName:PutMetricFilter' :: PutMetricFilter -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
logGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
filterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
filterPattern
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty MetricTransformation
metricTransformations

instance Data.ToHeaders PutMetricFilter where
  toHeaders :: PutMetricFilter -> [Header]
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 -> [Header]
Data.=# ( ByteString
"Logs_20140328.PutMetricFilter" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutMetricFilter where
  toJSON :: PutMetricFilter -> Value
toJSON PutMetricFilter' {NonEmpty MetricTransformation
Text
metricTransformations :: NonEmpty MetricTransformation
filterPattern :: Text
filterName :: Text
logGroupName :: Text
$sel:metricTransformations:PutMetricFilter' :: PutMetricFilter -> NonEmpty MetricTransformation
$sel:filterPattern:PutMetricFilter' :: PutMetricFilter -> Text
$sel:filterName:PutMetricFilter' :: PutMetricFilter -> Text
$sel:logGroupName:PutMetricFilter' :: PutMetricFilter -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"logGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
logGroupName),
            forall a. a -> Maybe a
Prelude.Just (Key
"filterName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
filterName),
            forall a. a -> Maybe a
Prelude.Just (Key
"filterPattern" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
filterPattern),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"metricTransformations"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty MetricTransformation
metricTransformations
              )
          ]
      )

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

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

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

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

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