module Stratosphere.AutoScaling.ScalingPolicy.PredictiveScalingCustomizedCapacityMetricProperty (
module Exports,
PredictiveScalingCustomizedCapacityMetricProperty(..),
mkPredictiveScalingCustomizedCapacityMetricProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.AutoScaling.ScalingPolicy.MetricDataQueryProperty as Exports
import Stratosphere.ResourceProperties
data PredictiveScalingCustomizedCapacityMetricProperty
=
PredictiveScalingCustomizedCapacityMetricProperty {PredictiveScalingCustomizedCapacityMetricProperty -> ()
haddock_workaround_ :: (),
PredictiveScalingCustomizedCapacityMetricProperty
-> [MetricDataQueryProperty]
metricDataQueries :: [MetricDataQueryProperty]}
deriving stock (PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty -> Bool
(PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty -> Bool)
-> (PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty -> Bool)
-> Eq PredictiveScalingCustomizedCapacityMetricProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty -> Bool
== :: PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty -> Bool
$c/= :: PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty -> Bool
/= :: PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty -> Bool
Prelude.Eq, Int -> PredictiveScalingCustomizedCapacityMetricProperty -> ShowS
[PredictiveScalingCustomizedCapacityMetricProperty] -> ShowS
PredictiveScalingCustomizedCapacityMetricProperty -> String
(Int -> PredictiveScalingCustomizedCapacityMetricProperty -> ShowS)
-> (PredictiveScalingCustomizedCapacityMetricProperty -> String)
-> ([PredictiveScalingCustomizedCapacityMetricProperty] -> ShowS)
-> Show PredictiveScalingCustomizedCapacityMetricProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PredictiveScalingCustomizedCapacityMetricProperty -> ShowS
showsPrec :: Int -> PredictiveScalingCustomizedCapacityMetricProperty -> ShowS
$cshow :: PredictiveScalingCustomizedCapacityMetricProperty -> String
show :: PredictiveScalingCustomizedCapacityMetricProperty -> String
$cshowList :: [PredictiveScalingCustomizedCapacityMetricProperty] -> ShowS
showList :: [PredictiveScalingCustomizedCapacityMetricProperty] -> ShowS
Prelude.Show)
mkPredictiveScalingCustomizedCapacityMetricProperty ::
[MetricDataQueryProperty]
-> PredictiveScalingCustomizedCapacityMetricProperty
mkPredictiveScalingCustomizedCapacityMetricProperty :: [MetricDataQueryProperty]
-> PredictiveScalingCustomizedCapacityMetricProperty
mkPredictiveScalingCustomizedCapacityMetricProperty
[MetricDataQueryProperty]
metricDataQueries
= PredictiveScalingCustomizedCapacityMetricProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), metricDataQueries :: [MetricDataQueryProperty]
metricDataQueries = [MetricDataQueryProperty]
metricDataQueries}
instance ToResourceProperties PredictiveScalingCustomizedCapacityMetricProperty where
toResourceProperties :: PredictiveScalingCustomizedCapacityMetricProperty
-> ResourceProperties
toResourceProperties
PredictiveScalingCustomizedCapacityMetricProperty {[MetricDataQueryProperty]
()
haddock_workaround_ :: PredictiveScalingCustomizedCapacityMetricProperty -> ()
metricDataQueries :: PredictiveScalingCustomizedCapacityMetricProperty
-> [MetricDataQueryProperty]
haddock_workaround_ :: ()
metricDataQueries :: [MetricDataQueryProperty]
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::AutoScaling::ScalingPolicy.PredictiveScalingCustomizedCapacityMetric",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"MetricDataQueries" Key -> [MetricDataQueryProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [MetricDataQueryProperty]
metricDataQueries]}
instance JSON.ToJSON PredictiveScalingCustomizedCapacityMetricProperty where
toJSON :: PredictiveScalingCustomizedCapacityMetricProperty -> Value
toJSON PredictiveScalingCustomizedCapacityMetricProperty {[MetricDataQueryProperty]
()
haddock_workaround_ :: PredictiveScalingCustomizedCapacityMetricProperty -> ()
metricDataQueries :: PredictiveScalingCustomizedCapacityMetricProperty
-> [MetricDataQueryProperty]
haddock_workaround_ :: ()
metricDataQueries :: [MetricDataQueryProperty]
..}
= [(Key, Value)] -> Value
JSON.object [Key
"MetricDataQueries" Key -> [MetricDataQueryProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [MetricDataQueryProperty]
metricDataQueries]
instance Property "MetricDataQueries" PredictiveScalingCustomizedCapacityMetricProperty where
type PropertyType "MetricDataQueries" PredictiveScalingCustomizedCapacityMetricProperty = [MetricDataQueryProperty]
set :: PropertyType
"MetricDataQueries"
PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty
-> PredictiveScalingCustomizedCapacityMetricProperty
set PropertyType
"MetricDataQueries"
PredictiveScalingCustomizedCapacityMetricProperty
newValue PredictiveScalingCustomizedCapacityMetricProperty {[MetricDataQueryProperty]
()
haddock_workaround_ :: PredictiveScalingCustomizedCapacityMetricProperty -> ()
metricDataQueries :: PredictiveScalingCustomizedCapacityMetricProperty
-> [MetricDataQueryProperty]
haddock_workaround_ :: ()
metricDataQueries :: [MetricDataQueryProperty]
..}
= PredictiveScalingCustomizedCapacityMetricProperty
{metricDataQueries :: [MetricDataQueryProperty]
metricDataQueries = [MetricDataQueryProperty]
PropertyType
"MetricDataQueries"
PredictiveScalingCustomizedCapacityMetricProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}