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

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

-- |
-- Module      : Amazonka.S3.Types.Metrics
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.S3.Types.Metrics where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.S3.Internal
import Amazonka.S3.Types.MetricsStatus
import Amazonka.S3.Types.ReplicationTimeValue

-- | A container specifying replication metrics-related settings enabling
-- replication metrics and events.
--
-- /See:/ 'newMetrics' smart constructor.
data Metrics = Metrics'
  { -- | A container specifying the time threshold for emitting the
    -- @s3:Replication:OperationMissedThreshold@ event.
    Metrics -> Maybe ReplicationTimeValue
eventThreshold :: Prelude.Maybe ReplicationTimeValue,
    -- | Specifies whether the replication metrics are enabled.
    Metrics -> MetricsStatus
status :: MetricsStatus
  }
  deriving (Metrics -> Metrics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metrics -> Metrics -> Bool
$c/= :: Metrics -> Metrics -> Bool
== :: Metrics -> Metrics -> Bool
$c== :: Metrics -> Metrics -> Bool
Prelude.Eq, ReadPrec [Metrics]
ReadPrec Metrics
Int -> ReadS Metrics
ReadS [Metrics]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Metrics]
$creadListPrec :: ReadPrec [Metrics]
readPrec :: ReadPrec Metrics
$creadPrec :: ReadPrec Metrics
readList :: ReadS [Metrics]
$creadList :: ReadS [Metrics]
readsPrec :: Int -> ReadS Metrics
$creadsPrec :: Int -> ReadS Metrics
Prelude.Read, Int -> Metrics -> ShowS
[Metrics] -> ShowS
Metrics -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metrics] -> ShowS
$cshowList :: [Metrics] -> ShowS
show :: Metrics -> String
$cshow :: Metrics -> String
showsPrec :: Int -> Metrics -> ShowS
$cshowsPrec :: Int -> Metrics -> ShowS
Prelude.Show, forall x. Rep Metrics x -> Metrics
forall x. Metrics -> Rep Metrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Metrics x -> Metrics
$cfrom :: forall x. Metrics -> Rep Metrics x
Prelude.Generic)

-- |
-- Create a value of 'Metrics' 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:
--
-- 'eventThreshold', 'metrics_eventThreshold' - A container specifying the time threshold for emitting the
-- @s3:Replication:OperationMissedThreshold@ event.
--
-- 'status', 'metrics_status' - Specifies whether the replication metrics are enabled.
newMetrics ::
  -- | 'status'
  MetricsStatus ->
  Metrics
newMetrics :: MetricsStatus -> Metrics
newMetrics MetricsStatus
pStatus_ =
  Metrics'
    { $sel:eventThreshold:Metrics' :: Maybe ReplicationTimeValue
eventThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Metrics' :: MetricsStatus
status = MetricsStatus
pStatus_
    }

-- | A container specifying the time threshold for emitting the
-- @s3:Replication:OperationMissedThreshold@ event.
metrics_eventThreshold :: Lens.Lens' Metrics (Prelude.Maybe ReplicationTimeValue)
metrics_eventThreshold :: Lens' Metrics (Maybe ReplicationTimeValue)
metrics_eventThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Metrics' {Maybe ReplicationTimeValue
eventThreshold :: Maybe ReplicationTimeValue
$sel:eventThreshold:Metrics' :: Metrics -> Maybe ReplicationTimeValue
eventThreshold} -> Maybe ReplicationTimeValue
eventThreshold) (\s :: Metrics
s@Metrics' {} Maybe ReplicationTimeValue
a -> Metrics
s {$sel:eventThreshold:Metrics' :: Maybe ReplicationTimeValue
eventThreshold = Maybe ReplicationTimeValue
a} :: Metrics)

-- | Specifies whether the replication metrics are enabled.
metrics_status :: Lens.Lens' Metrics MetricsStatus
metrics_status :: Lens' Metrics MetricsStatus
metrics_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Metrics' {MetricsStatus
status :: MetricsStatus
$sel:status:Metrics' :: Metrics -> MetricsStatus
status} -> MetricsStatus
status) (\s :: Metrics
s@Metrics' {} MetricsStatus
a -> Metrics
s {$sel:status:Metrics' :: MetricsStatus
status = MetricsStatus
a} :: Metrics)

instance Data.FromXML Metrics where
  parseXML :: [Node] -> Either String Metrics
parseXML [Node]
x =
    Maybe ReplicationTimeValue -> MetricsStatus -> Metrics
Metrics'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"EventThreshold")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Status")

instance Prelude.Hashable Metrics where
  hashWithSalt :: Int -> Metrics -> Int
hashWithSalt Int
_salt Metrics' {Maybe ReplicationTimeValue
MetricsStatus
status :: MetricsStatus
eventThreshold :: Maybe ReplicationTimeValue
$sel:status:Metrics' :: Metrics -> MetricsStatus
$sel:eventThreshold:Metrics' :: Metrics -> Maybe ReplicationTimeValue
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReplicationTimeValue
eventThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MetricsStatus
status

instance Prelude.NFData Metrics where
  rnf :: Metrics -> ()
rnf Metrics' {Maybe ReplicationTimeValue
MetricsStatus
status :: MetricsStatus
eventThreshold :: Maybe ReplicationTimeValue
$sel:status:Metrics' :: Metrics -> MetricsStatus
$sel:eventThreshold:Metrics' :: Metrics -> Maybe ReplicationTimeValue
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplicationTimeValue
eventThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MetricsStatus
status

instance Data.ToXML Metrics where
  toXML :: Metrics -> XML
toXML Metrics' {Maybe ReplicationTimeValue
MetricsStatus
status :: MetricsStatus
eventThreshold :: Maybe ReplicationTimeValue
$sel:status:Metrics' :: Metrics -> MetricsStatus
$sel:eventThreshold:Metrics' :: Metrics -> Maybe ReplicationTimeValue
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"EventThreshold" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe ReplicationTimeValue
eventThreshold,
        Name
"Status" forall a. ToXML a => Name -> a -> XML
Data.@= MetricsStatus
status
      ]