{-# 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.ComputeOptimizer.Types.EffectiveRecommendationPreferences
-- 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.ComputeOptimizer.Types.EffectiveRecommendationPreferences where

import Amazonka.ComputeOptimizer.Types.CpuVendorArchitecture
import Amazonka.ComputeOptimizer.Types.EnhancedInfrastructureMetrics
import Amazonka.ComputeOptimizer.Types.ExternalMetricsPreference
import Amazonka.ComputeOptimizer.Types.InferredWorkloadTypesPreference
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

-- | Describes the effective recommendation preferences for a resource.
--
-- /See:/ 'newEffectiveRecommendationPreferences' smart constructor.
data EffectiveRecommendationPreferences = EffectiveRecommendationPreferences'
  { -- | Describes the CPU vendor and architecture for an instance or Auto
    -- Scaling group recommendations.
    --
    -- For example, when you specify @AWS_ARM64@ with:
    --
    -- -   A GetEC2InstanceRecommendations or
    --     GetAutoScalingGroupRecommendations request, Compute Optimizer
    --     returns recommendations that consist of Graviton2 instance types
    --     only.
    --
    -- -   A GetEC2RecommendationProjectedMetrics request, Compute Optimizer
    --     returns projected utilization metrics for Graviton2 instance type
    --     recommendations only.
    --
    -- -   A ExportEC2InstanceRecommendations or
    --     ExportAutoScalingGroupRecommendations request, Compute Optimizer
    --     exports recommendations that consist of Graviton2 instance types
    --     only.
    EffectiveRecommendationPreferences -> Maybe [CpuVendorArchitecture]
cpuVendorArchitectures :: Prelude.Maybe [CpuVendorArchitecture],
    -- | Describes the activation status of the enhanced infrastructure metrics
    -- preference.
    --
    -- A status of @Active@ confirms that the preference is applied in the
    -- latest recommendation refresh, and a status of @Inactive@ confirms that
    -- it\'s not yet applied to recommendations.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/compute-optimizer/latest/ug/enhanced-infrastructure-metrics.html Enhanced infrastructure metrics>
    -- in the /Compute Optimizer User Guide/.
    EffectiveRecommendationPreferences
-> Maybe EnhancedInfrastructureMetrics
enhancedInfrastructureMetrics :: Prelude.Maybe EnhancedInfrastructureMetrics,
    -- | An object that describes the external metrics recommendation preference.
    --
    -- If the preference is applied in the latest recommendation refresh, an
    -- object with a valid @source@ value appears in the response. If the
    -- preference isn\'t applied to the recommendations already, then this
    -- object doesn\'t appear in the response.
    EffectiveRecommendationPreferences
-> Maybe ExternalMetricsPreference
externalMetricsPreference :: Prelude.Maybe ExternalMetricsPreference,
    -- | Describes the activation status of the inferred workload types
    -- preference.
    --
    -- A status of @Active@ confirms that the preference is applied in the
    -- latest recommendation refresh. A status of @Inactive@ confirms that
    -- it\'s not yet applied to recommendations.
    EffectiveRecommendationPreferences
-> Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes :: Prelude.Maybe InferredWorkloadTypesPreference
  }
  deriving (EffectiveRecommendationPreferences
-> EffectiveRecommendationPreferences -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EffectiveRecommendationPreferences
-> EffectiveRecommendationPreferences -> Bool
$c/= :: EffectiveRecommendationPreferences
-> EffectiveRecommendationPreferences -> Bool
== :: EffectiveRecommendationPreferences
-> EffectiveRecommendationPreferences -> Bool
$c== :: EffectiveRecommendationPreferences
-> EffectiveRecommendationPreferences -> Bool
Prelude.Eq, ReadPrec [EffectiveRecommendationPreferences]
ReadPrec EffectiveRecommendationPreferences
Int -> ReadS EffectiveRecommendationPreferences
ReadS [EffectiveRecommendationPreferences]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EffectiveRecommendationPreferences]
$creadListPrec :: ReadPrec [EffectiveRecommendationPreferences]
readPrec :: ReadPrec EffectiveRecommendationPreferences
$creadPrec :: ReadPrec EffectiveRecommendationPreferences
readList :: ReadS [EffectiveRecommendationPreferences]
$creadList :: ReadS [EffectiveRecommendationPreferences]
readsPrec :: Int -> ReadS EffectiveRecommendationPreferences
$creadsPrec :: Int -> ReadS EffectiveRecommendationPreferences
Prelude.Read, Int -> EffectiveRecommendationPreferences -> ShowS
[EffectiveRecommendationPreferences] -> ShowS
EffectiveRecommendationPreferences -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EffectiveRecommendationPreferences] -> ShowS
$cshowList :: [EffectiveRecommendationPreferences] -> ShowS
show :: EffectiveRecommendationPreferences -> String
$cshow :: EffectiveRecommendationPreferences -> String
showsPrec :: Int -> EffectiveRecommendationPreferences -> ShowS
$cshowsPrec :: Int -> EffectiveRecommendationPreferences -> ShowS
Prelude.Show, forall x.
Rep EffectiveRecommendationPreferences x
-> EffectiveRecommendationPreferences
forall x.
EffectiveRecommendationPreferences
-> Rep EffectiveRecommendationPreferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EffectiveRecommendationPreferences x
-> EffectiveRecommendationPreferences
$cfrom :: forall x.
EffectiveRecommendationPreferences
-> Rep EffectiveRecommendationPreferences x
Prelude.Generic)

-- |
-- Create a value of 'EffectiveRecommendationPreferences' 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:
--
-- 'cpuVendorArchitectures', 'effectiveRecommendationPreferences_cpuVendorArchitectures' - Describes the CPU vendor and architecture for an instance or Auto
-- Scaling group recommendations.
--
-- For example, when you specify @AWS_ARM64@ with:
--
-- -   A GetEC2InstanceRecommendations or
--     GetAutoScalingGroupRecommendations request, Compute Optimizer
--     returns recommendations that consist of Graviton2 instance types
--     only.
--
-- -   A GetEC2RecommendationProjectedMetrics request, Compute Optimizer
--     returns projected utilization metrics for Graviton2 instance type
--     recommendations only.
--
-- -   A ExportEC2InstanceRecommendations or
--     ExportAutoScalingGroupRecommendations request, Compute Optimizer
--     exports recommendations that consist of Graviton2 instance types
--     only.
--
-- 'enhancedInfrastructureMetrics', 'effectiveRecommendationPreferences_enhancedInfrastructureMetrics' - Describes the activation status of the enhanced infrastructure metrics
-- preference.
--
-- A status of @Active@ confirms that the preference is applied in the
-- latest recommendation refresh, and a status of @Inactive@ confirms that
-- it\'s not yet applied to recommendations.
--
-- For more information, see
-- <https://docs.aws.amazon.com/compute-optimizer/latest/ug/enhanced-infrastructure-metrics.html Enhanced infrastructure metrics>
-- in the /Compute Optimizer User Guide/.
--
-- 'externalMetricsPreference', 'effectiveRecommendationPreferences_externalMetricsPreference' - An object that describes the external metrics recommendation preference.
--
-- If the preference is applied in the latest recommendation refresh, an
-- object with a valid @source@ value appears in the response. If the
-- preference isn\'t applied to the recommendations already, then this
-- object doesn\'t appear in the response.
--
-- 'inferredWorkloadTypes', 'effectiveRecommendationPreferences_inferredWorkloadTypes' - Describes the activation status of the inferred workload types
-- preference.
--
-- A status of @Active@ confirms that the preference is applied in the
-- latest recommendation refresh. A status of @Inactive@ confirms that
-- it\'s not yet applied to recommendations.
newEffectiveRecommendationPreferences ::
  EffectiveRecommendationPreferences
newEffectiveRecommendationPreferences :: EffectiveRecommendationPreferences
newEffectiveRecommendationPreferences =
  EffectiveRecommendationPreferences'
    { $sel:cpuVendorArchitectures:EffectiveRecommendationPreferences' :: Maybe [CpuVendorArchitecture]
cpuVendorArchitectures =
        forall a. Maybe a
Prelude.Nothing,
      $sel:enhancedInfrastructureMetrics:EffectiveRecommendationPreferences' :: Maybe EnhancedInfrastructureMetrics
enhancedInfrastructureMetrics =
        forall a. Maybe a
Prelude.Nothing,
      $sel:externalMetricsPreference:EffectiveRecommendationPreferences' :: Maybe ExternalMetricsPreference
externalMetricsPreference =
        forall a. Maybe a
Prelude.Nothing,
      $sel:inferredWorkloadTypes:EffectiveRecommendationPreferences' :: Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes = forall a. Maybe a
Prelude.Nothing
    }

-- | Describes the CPU vendor and architecture for an instance or Auto
-- Scaling group recommendations.
--
-- For example, when you specify @AWS_ARM64@ with:
--
-- -   A GetEC2InstanceRecommendations or
--     GetAutoScalingGroupRecommendations request, Compute Optimizer
--     returns recommendations that consist of Graviton2 instance types
--     only.
--
-- -   A GetEC2RecommendationProjectedMetrics request, Compute Optimizer
--     returns projected utilization metrics for Graviton2 instance type
--     recommendations only.
--
-- -   A ExportEC2InstanceRecommendations or
--     ExportAutoScalingGroupRecommendations request, Compute Optimizer
--     exports recommendations that consist of Graviton2 instance types
--     only.
effectiveRecommendationPreferences_cpuVendorArchitectures :: Lens.Lens' EffectiveRecommendationPreferences (Prelude.Maybe [CpuVendorArchitecture])
effectiveRecommendationPreferences_cpuVendorArchitectures :: Lens'
  EffectiveRecommendationPreferences (Maybe [CpuVendorArchitecture])
effectiveRecommendationPreferences_cpuVendorArchitectures = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EffectiveRecommendationPreferences' {Maybe [CpuVendorArchitecture]
cpuVendorArchitectures :: Maybe [CpuVendorArchitecture]
$sel:cpuVendorArchitectures:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences -> Maybe [CpuVendorArchitecture]
cpuVendorArchitectures} -> Maybe [CpuVendorArchitecture]
cpuVendorArchitectures) (\s :: EffectiveRecommendationPreferences
s@EffectiveRecommendationPreferences' {} Maybe [CpuVendorArchitecture]
a -> EffectiveRecommendationPreferences
s {$sel:cpuVendorArchitectures:EffectiveRecommendationPreferences' :: Maybe [CpuVendorArchitecture]
cpuVendorArchitectures = Maybe [CpuVendorArchitecture]
a} :: EffectiveRecommendationPreferences) 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

-- | Describes the activation status of the enhanced infrastructure metrics
-- preference.
--
-- A status of @Active@ confirms that the preference is applied in the
-- latest recommendation refresh, and a status of @Inactive@ confirms that
-- it\'s not yet applied to recommendations.
--
-- For more information, see
-- <https://docs.aws.amazon.com/compute-optimizer/latest/ug/enhanced-infrastructure-metrics.html Enhanced infrastructure metrics>
-- in the /Compute Optimizer User Guide/.
effectiveRecommendationPreferences_enhancedInfrastructureMetrics :: Lens.Lens' EffectiveRecommendationPreferences (Prelude.Maybe EnhancedInfrastructureMetrics)
effectiveRecommendationPreferences_enhancedInfrastructureMetrics :: Lens'
  EffectiveRecommendationPreferences
  (Maybe EnhancedInfrastructureMetrics)
effectiveRecommendationPreferences_enhancedInfrastructureMetrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EffectiveRecommendationPreferences' {Maybe EnhancedInfrastructureMetrics
enhancedInfrastructureMetrics :: Maybe EnhancedInfrastructureMetrics
$sel:enhancedInfrastructureMetrics:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe EnhancedInfrastructureMetrics
enhancedInfrastructureMetrics} -> Maybe EnhancedInfrastructureMetrics
enhancedInfrastructureMetrics) (\s :: EffectiveRecommendationPreferences
s@EffectiveRecommendationPreferences' {} Maybe EnhancedInfrastructureMetrics
a -> EffectiveRecommendationPreferences
s {$sel:enhancedInfrastructureMetrics:EffectiveRecommendationPreferences' :: Maybe EnhancedInfrastructureMetrics
enhancedInfrastructureMetrics = Maybe EnhancedInfrastructureMetrics
a} :: EffectiveRecommendationPreferences)

-- | An object that describes the external metrics recommendation preference.
--
-- If the preference is applied in the latest recommendation refresh, an
-- object with a valid @source@ value appears in the response. If the
-- preference isn\'t applied to the recommendations already, then this
-- object doesn\'t appear in the response.
effectiveRecommendationPreferences_externalMetricsPreference :: Lens.Lens' EffectiveRecommendationPreferences (Prelude.Maybe ExternalMetricsPreference)
effectiveRecommendationPreferences_externalMetricsPreference :: Lens'
  EffectiveRecommendationPreferences
  (Maybe ExternalMetricsPreference)
effectiveRecommendationPreferences_externalMetricsPreference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EffectiveRecommendationPreferences' {Maybe ExternalMetricsPreference
externalMetricsPreference :: Maybe ExternalMetricsPreference
$sel:externalMetricsPreference:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe ExternalMetricsPreference
externalMetricsPreference} -> Maybe ExternalMetricsPreference
externalMetricsPreference) (\s :: EffectiveRecommendationPreferences
s@EffectiveRecommendationPreferences' {} Maybe ExternalMetricsPreference
a -> EffectiveRecommendationPreferences
s {$sel:externalMetricsPreference:EffectiveRecommendationPreferences' :: Maybe ExternalMetricsPreference
externalMetricsPreference = Maybe ExternalMetricsPreference
a} :: EffectiveRecommendationPreferences)

-- | Describes the activation status of the inferred workload types
-- preference.
--
-- A status of @Active@ confirms that the preference is applied in the
-- latest recommendation refresh. A status of @Inactive@ confirms that
-- it\'s not yet applied to recommendations.
effectiveRecommendationPreferences_inferredWorkloadTypes :: Lens.Lens' EffectiveRecommendationPreferences (Prelude.Maybe InferredWorkloadTypesPreference)
effectiveRecommendationPreferences_inferredWorkloadTypes :: Lens'
  EffectiveRecommendationPreferences
  (Maybe InferredWorkloadTypesPreference)
effectiveRecommendationPreferences_inferredWorkloadTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EffectiveRecommendationPreferences' {Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes :: Maybe InferredWorkloadTypesPreference
$sel:inferredWorkloadTypes:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes} -> Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes) (\s :: EffectiveRecommendationPreferences
s@EffectiveRecommendationPreferences' {} Maybe InferredWorkloadTypesPreference
a -> EffectiveRecommendationPreferences
s {$sel:inferredWorkloadTypes:EffectiveRecommendationPreferences' :: Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes = Maybe InferredWorkloadTypesPreference
a} :: EffectiveRecommendationPreferences)

instance
  Data.FromJSON
    EffectiveRecommendationPreferences
  where
  parseJSON :: Value -> Parser EffectiveRecommendationPreferences
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"EffectiveRecommendationPreferences"
      ( \Object
x ->
          Maybe [CpuVendorArchitecture]
-> Maybe EnhancedInfrastructureMetrics
-> Maybe ExternalMetricsPreference
-> Maybe InferredWorkloadTypesPreference
-> EffectiveRecommendationPreferences
EffectiveRecommendationPreferences'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"cpuVendorArchitectures"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"enhancedInfrastructureMetrics")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"externalMetricsPreference")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"inferredWorkloadTypes")
      )

instance
  Prelude.Hashable
    EffectiveRecommendationPreferences
  where
  hashWithSalt :: Int -> EffectiveRecommendationPreferences -> Int
hashWithSalt
    Int
_salt
    EffectiveRecommendationPreferences' {Maybe [CpuVendorArchitecture]
Maybe EnhancedInfrastructureMetrics
Maybe ExternalMetricsPreference
Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes :: Maybe InferredWorkloadTypesPreference
externalMetricsPreference :: Maybe ExternalMetricsPreference
enhancedInfrastructureMetrics :: Maybe EnhancedInfrastructureMetrics
cpuVendorArchitectures :: Maybe [CpuVendorArchitecture]
$sel:inferredWorkloadTypes:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe InferredWorkloadTypesPreference
$sel:externalMetricsPreference:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe ExternalMetricsPreference
$sel:enhancedInfrastructureMetrics:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe EnhancedInfrastructureMetrics
$sel:cpuVendorArchitectures:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences -> Maybe [CpuVendorArchitecture]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CpuVendorArchitecture]
cpuVendorArchitectures
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EnhancedInfrastructureMetrics
enhancedInfrastructureMetrics
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExternalMetricsPreference
externalMetricsPreference
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes

instance
  Prelude.NFData
    EffectiveRecommendationPreferences
  where
  rnf :: EffectiveRecommendationPreferences -> ()
rnf EffectiveRecommendationPreferences' {Maybe [CpuVendorArchitecture]
Maybe EnhancedInfrastructureMetrics
Maybe ExternalMetricsPreference
Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes :: Maybe InferredWorkloadTypesPreference
externalMetricsPreference :: Maybe ExternalMetricsPreference
enhancedInfrastructureMetrics :: Maybe EnhancedInfrastructureMetrics
cpuVendorArchitectures :: Maybe [CpuVendorArchitecture]
$sel:inferredWorkloadTypes:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe InferredWorkloadTypesPreference
$sel:externalMetricsPreference:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe ExternalMetricsPreference
$sel:enhancedInfrastructureMetrics:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences
-> Maybe EnhancedInfrastructureMetrics
$sel:cpuVendorArchitectures:EffectiveRecommendationPreferences' :: EffectiveRecommendationPreferences -> Maybe [CpuVendorArchitecture]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CpuVendorArchitecture]
cpuVendorArchitectures
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EnhancedInfrastructureMetrics
enhancedInfrastructureMetrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExternalMetricsPreference
externalMetricsPreference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InferredWorkloadTypesPreference
inferredWorkloadTypes