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