module Stratosphere.AutoScaling.ScalingPolicy.PredictiveScalingCustomizedScalingMetricProperty (
module Exports,
PredictiveScalingCustomizedScalingMetricProperty(..),
mkPredictiveScalingCustomizedScalingMetricProperty
) 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 PredictiveScalingCustomizedScalingMetricProperty
=
PredictiveScalingCustomizedScalingMetricProperty {PredictiveScalingCustomizedScalingMetricProperty -> ()
haddock_workaround_ :: (),
PredictiveScalingCustomizedScalingMetricProperty
-> [MetricDataQueryProperty]
metricDataQueries :: [MetricDataQueryProperty]}
deriving stock (PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty -> Bool
(PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty -> Bool)
-> (PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty -> Bool)
-> Eq PredictiveScalingCustomizedScalingMetricProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty -> Bool
== :: PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty -> Bool
$c/= :: PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty -> Bool
/= :: PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty -> Bool
Prelude.Eq, Int -> PredictiveScalingCustomizedScalingMetricProperty -> ShowS
[PredictiveScalingCustomizedScalingMetricProperty] -> ShowS
PredictiveScalingCustomizedScalingMetricProperty -> String
(Int -> PredictiveScalingCustomizedScalingMetricProperty -> ShowS)
-> (PredictiveScalingCustomizedScalingMetricProperty -> String)
-> ([PredictiveScalingCustomizedScalingMetricProperty] -> ShowS)
-> Show PredictiveScalingCustomizedScalingMetricProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PredictiveScalingCustomizedScalingMetricProperty -> ShowS
showsPrec :: Int -> PredictiveScalingCustomizedScalingMetricProperty -> ShowS
$cshow :: PredictiveScalingCustomizedScalingMetricProperty -> String
show :: PredictiveScalingCustomizedScalingMetricProperty -> String
$cshowList :: [PredictiveScalingCustomizedScalingMetricProperty] -> ShowS
showList :: [PredictiveScalingCustomizedScalingMetricProperty] -> ShowS
Prelude.Show)
mkPredictiveScalingCustomizedScalingMetricProperty ::
[MetricDataQueryProperty]
-> PredictiveScalingCustomizedScalingMetricProperty
mkPredictiveScalingCustomizedScalingMetricProperty :: [MetricDataQueryProperty]
-> PredictiveScalingCustomizedScalingMetricProperty
mkPredictiveScalingCustomizedScalingMetricProperty
[MetricDataQueryProperty]
metricDataQueries
= PredictiveScalingCustomizedScalingMetricProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), metricDataQueries :: [MetricDataQueryProperty]
metricDataQueries = [MetricDataQueryProperty]
metricDataQueries}
instance ToResourceProperties PredictiveScalingCustomizedScalingMetricProperty where
toResourceProperties :: PredictiveScalingCustomizedScalingMetricProperty
-> ResourceProperties
toResourceProperties
PredictiveScalingCustomizedScalingMetricProperty {[MetricDataQueryProperty]
()
haddock_workaround_ :: PredictiveScalingCustomizedScalingMetricProperty -> ()
metricDataQueries :: PredictiveScalingCustomizedScalingMetricProperty
-> [MetricDataQueryProperty]
haddock_workaround_ :: ()
metricDataQueries :: [MetricDataQueryProperty]
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::AutoScaling::ScalingPolicy.PredictiveScalingCustomizedScalingMetric",
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 PredictiveScalingCustomizedScalingMetricProperty where
toJSON :: PredictiveScalingCustomizedScalingMetricProperty -> Value
toJSON PredictiveScalingCustomizedScalingMetricProperty {[MetricDataQueryProperty]
()
haddock_workaround_ :: PredictiveScalingCustomizedScalingMetricProperty -> ()
metricDataQueries :: PredictiveScalingCustomizedScalingMetricProperty
-> [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" PredictiveScalingCustomizedScalingMetricProperty where
type PropertyType "MetricDataQueries" PredictiveScalingCustomizedScalingMetricProperty = [MetricDataQueryProperty]
set :: PropertyType
"MetricDataQueries"
PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty
-> PredictiveScalingCustomizedScalingMetricProperty
set PropertyType
"MetricDataQueries"
PredictiveScalingCustomizedScalingMetricProperty
newValue PredictiveScalingCustomizedScalingMetricProperty {[MetricDataQueryProperty]
()
haddock_workaround_ :: PredictiveScalingCustomizedScalingMetricProperty -> ()
metricDataQueries :: PredictiveScalingCustomizedScalingMetricProperty
-> [MetricDataQueryProperty]
haddock_workaround_ :: ()
metricDataQueries :: [MetricDataQueryProperty]
..}
= PredictiveScalingCustomizedScalingMetricProperty
{metricDataQueries :: [MetricDataQueryProperty]
metricDataQueries = [MetricDataQueryProperty]
PropertyType
"MetricDataQueries"
PredictiveScalingCustomizedScalingMetricProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}