module Stratosphere.LookoutMetrics.AnomalyDetector.MetricSourceProperty (
        module Exports, MetricSourceProperty(..), mkMetricSourceProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.LookoutMetrics.AnomalyDetector.AppFlowConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.LookoutMetrics.AnomalyDetector.CloudwatchConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.LookoutMetrics.AnomalyDetector.RDSSourceConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.LookoutMetrics.AnomalyDetector.RedshiftSourceConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.LookoutMetrics.AnomalyDetector.S3SourceConfigProperty as Exports
import Stratosphere.ResourceProperties
data MetricSourceProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lookoutmetrics-anomalydetector-metricsource.html>
    MetricSourceProperty {MetricSourceProperty -> ()
haddock_workaround_ :: (),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lookoutmetrics-anomalydetector-metricsource.html#cfn-lookoutmetrics-anomalydetector-metricsource-appflowconfig>
                          MetricSourceProperty -> Maybe AppFlowConfigProperty
appFlowConfig :: (Prelude.Maybe AppFlowConfigProperty),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lookoutmetrics-anomalydetector-metricsource.html#cfn-lookoutmetrics-anomalydetector-metricsource-cloudwatchconfig>
                          MetricSourceProperty -> Maybe CloudwatchConfigProperty
cloudwatchConfig :: (Prelude.Maybe CloudwatchConfigProperty),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lookoutmetrics-anomalydetector-metricsource.html#cfn-lookoutmetrics-anomalydetector-metricsource-rdssourceconfig>
                          MetricSourceProperty -> Maybe RDSSourceConfigProperty
rDSSourceConfig :: (Prelude.Maybe RDSSourceConfigProperty),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lookoutmetrics-anomalydetector-metricsource.html#cfn-lookoutmetrics-anomalydetector-metricsource-redshiftsourceconfig>
                          MetricSourceProperty -> Maybe RedshiftSourceConfigProperty
redshiftSourceConfig :: (Prelude.Maybe RedshiftSourceConfigProperty),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lookoutmetrics-anomalydetector-metricsource.html#cfn-lookoutmetrics-anomalydetector-metricsource-s3sourceconfig>
                          MetricSourceProperty -> Maybe S3SourceConfigProperty
s3SourceConfig :: (Prelude.Maybe S3SourceConfigProperty)}
  deriving stock (MetricSourceProperty -> MetricSourceProperty -> Bool
(MetricSourceProperty -> MetricSourceProperty -> Bool)
-> (MetricSourceProperty -> MetricSourceProperty -> Bool)
-> Eq MetricSourceProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetricSourceProperty -> MetricSourceProperty -> Bool
== :: MetricSourceProperty -> MetricSourceProperty -> Bool
$c/= :: MetricSourceProperty -> MetricSourceProperty -> Bool
/= :: MetricSourceProperty -> MetricSourceProperty -> Bool
Prelude.Eq, Int -> MetricSourceProperty -> ShowS
[MetricSourceProperty] -> ShowS
MetricSourceProperty -> String
(Int -> MetricSourceProperty -> ShowS)
-> (MetricSourceProperty -> String)
-> ([MetricSourceProperty] -> ShowS)
-> Show MetricSourceProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetricSourceProperty -> ShowS
showsPrec :: Int -> MetricSourceProperty -> ShowS
$cshow :: MetricSourceProperty -> String
show :: MetricSourceProperty -> String
$cshowList :: [MetricSourceProperty] -> ShowS
showList :: [MetricSourceProperty] -> ShowS
Prelude.Show)
mkMetricSourceProperty :: MetricSourceProperty
mkMetricSourceProperty :: MetricSourceProperty
mkMetricSourceProperty
  = MetricSourceProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), appFlowConfig :: Maybe AppFlowConfigProperty
appFlowConfig = Maybe AppFlowConfigProperty
forall a. Maybe a
Prelude.Nothing,
       cloudwatchConfig :: Maybe CloudwatchConfigProperty
cloudwatchConfig = Maybe CloudwatchConfigProperty
forall a. Maybe a
Prelude.Nothing,
       rDSSourceConfig :: Maybe RDSSourceConfigProperty
rDSSourceConfig = Maybe RDSSourceConfigProperty
forall a. Maybe a
Prelude.Nothing,
       redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
redshiftSourceConfig = Maybe RedshiftSourceConfigProperty
forall a. Maybe a
Prelude.Nothing,
       s3SourceConfig :: Maybe S3SourceConfigProperty
s3SourceConfig = Maybe S3SourceConfigProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties MetricSourceProperty where
  toResourceProperties :: MetricSourceProperty -> ResourceProperties
toResourceProperties MetricSourceProperty {Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: MetricSourceProperty -> ()
appFlowConfig :: MetricSourceProperty -> Maybe AppFlowConfigProperty
cloudwatchConfig :: MetricSourceProperty -> Maybe CloudwatchConfigProperty
rDSSourceConfig :: MetricSourceProperty -> Maybe RDSSourceConfigProperty
redshiftSourceConfig :: MetricSourceProperty -> Maybe RedshiftSourceConfigProperty
s3SourceConfig :: MetricSourceProperty -> Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::LookoutMetrics::AnomalyDetector.MetricSource",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> AppFlowConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"AppFlowConfig" (AppFlowConfigProperty -> (Key, Value))
-> Maybe AppFlowConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AppFlowConfigProperty
appFlowConfig,
                            Key -> CloudwatchConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"CloudwatchConfig" (CloudwatchConfigProperty -> (Key, Value))
-> Maybe CloudwatchConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CloudwatchConfigProperty
cloudwatchConfig,
                            Key -> RDSSourceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RDSSourceConfig" (RDSSourceConfigProperty -> (Key, Value))
-> Maybe RDSSourceConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RDSSourceConfigProperty
rDSSourceConfig,
                            Key -> RedshiftSourceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RedshiftSourceConfig" (RedshiftSourceConfigProperty -> (Key, Value))
-> Maybe RedshiftSourceConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RedshiftSourceConfigProperty
redshiftSourceConfig,
                            Key -> S3SourceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"S3SourceConfig" (S3SourceConfigProperty -> (Key, Value))
-> Maybe S3SourceConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe S3SourceConfigProperty
s3SourceConfig])}
instance JSON.ToJSON MetricSourceProperty where
  toJSON :: MetricSourceProperty -> Value
toJSON MetricSourceProperty {Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: MetricSourceProperty -> ()
appFlowConfig :: MetricSourceProperty -> Maybe AppFlowConfigProperty
cloudwatchConfig :: MetricSourceProperty -> Maybe CloudwatchConfigProperty
rDSSourceConfig :: MetricSourceProperty -> Maybe RDSSourceConfigProperty
redshiftSourceConfig :: MetricSourceProperty -> Maybe RedshiftSourceConfigProperty
s3SourceConfig :: MetricSourceProperty -> Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> AppFlowConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"AppFlowConfig" (AppFlowConfigProperty -> (Key, Value))
-> Maybe AppFlowConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AppFlowConfigProperty
appFlowConfig,
               Key -> CloudwatchConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"CloudwatchConfig" (CloudwatchConfigProperty -> (Key, Value))
-> Maybe CloudwatchConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CloudwatchConfigProperty
cloudwatchConfig,
               Key -> RDSSourceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RDSSourceConfig" (RDSSourceConfigProperty -> (Key, Value))
-> Maybe RDSSourceConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RDSSourceConfigProperty
rDSSourceConfig,
               Key -> RedshiftSourceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RedshiftSourceConfig" (RedshiftSourceConfigProperty -> (Key, Value))
-> Maybe RedshiftSourceConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RedshiftSourceConfigProperty
redshiftSourceConfig,
               Key -> S3SourceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"S3SourceConfig" (S3SourceConfigProperty -> (Key, Value))
-> Maybe S3SourceConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe S3SourceConfigProperty
s3SourceConfig]))
instance Property "AppFlowConfig" MetricSourceProperty where
  type PropertyType "AppFlowConfig" MetricSourceProperty = AppFlowConfigProperty
  set :: PropertyType "AppFlowConfig" MetricSourceProperty
-> MetricSourceProperty -> MetricSourceProperty
set PropertyType "AppFlowConfig" MetricSourceProperty
newValue MetricSourceProperty {Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: MetricSourceProperty -> ()
appFlowConfig :: MetricSourceProperty -> Maybe AppFlowConfigProperty
cloudwatchConfig :: MetricSourceProperty -> Maybe CloudwatchConfigProperty
rDSSourceConfig :: MetricSourceProperty -> Maybe RDSSourceConfigProperty
redshiftSourceConfig :: MetricSourceProperty -> Maybe RedshiftSourceConfigProperty
s3SourceConfig :: MetricSourceProperty -> Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
    = MetricSourceProperty {appFlowConfig :: Maybe AppFlowConfigProperty
appFlowConfig = AppFlowConfigProperty -> Maybe AppFlowConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "AppFlowConfig" MetricSourceProperty
AppFlowConfigProperty
newValue, Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: ()
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
instance Property "CloudwatchConfig" MetricSourceProperty where
  type PropertyType "CloudwatchConfig" MetricSourceProperty = CloudwatchConfigProperty
  set :: PropertyType "CloudwatchConfig" MetricSourceProperty
-> MetricSourceProperty -> MetricSourceProperty
set PropertyType "CloudwatchConfig" MetricSourceProperty
newValue MetricSourceProperty {Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: MetricSourceProperty -> ()
appFlowConfig :: MetricSourceProperty -> Maybe AppFlowConfigProperty
cloudwatchConfig :: MetricSourceProperty -> Maybe CloudwatchConfigProperty
rDSSourceConfig :: MetricSourceProperty -> Maybe RDSSourceConfigProperty
redshiftSourceConfig :: MetricSourceProperty -> Maybe RedshiftSourceConfigProperty
s3SourceConfig :: MetricSourceProperty -> Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
    = MetricSourceProperty
        {cloudwatchConfig :: Maybe CloudwatchConfigProperty
cloudwatchConfig = CloudwatchConfigProperty -> Maybe CloudwatchConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "CloudwatchConfig" MetricSourceProperty
CloudwatchConfigProperty
newValue, Maybe AppFlowConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
instance Property "RDSSourceConfig" MetricSourceProperty where
  type PropertyType "RDSSourceConfig" MetricSourceProperty = RDSSourceConfigProperty
  set :: PropertyType "RDSSourceConfig" MetricSourceProperty
-> MetricSourceProperty -> MetricSourceProperty
set PropertyType "RDSSourceConfig" MetricSourceProperty
newValue MetricSourceProperty {Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: MetricSourceProperty -> ()
appFlowConfig :: MetricSourceProperty -> Maybe AppFlowConfigProperty
cloudwatchConfig :: MetricSourceProperty -> Maybe CloudwatchConfigProperty
rDSSourceConfig :: MetricSourceProperty -> Maybe RDSSourceConfigProperty
redshiftSourceConfig :: MetricSourceProperty -> Maybe RedshiftSourceConfigProperty
s3SourceConfig :: MetricSourceProperty -> Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
    = MetricSourceProperty
        {rDSSourceConfig :: Maybe RDSSourceConfigProperty
rDSSourceConfig = RDSSourceConfigProperty -> Maybe RDSSourceConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RDSSourceConfig" MetricSourceProperty
RDSSourceConfigProperty
newValue, Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
()
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
instance Property "RedshiftSourceConfig" MetricSourceProperty where
  type PropertyType "RedshiftSourceConfig" MetricSourceProperty = RedshiftSourceConfigProperty
  set :: PropertyType "RedshiftSourceConfig" MetricSourceProperty
-> MetricSourceProperty -> MetricSourceProperty
set PropertyType "RedshiftSourceConfig" MetricSourceProperty
newValue MetricSourceProperty {Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: MetricSourceProperty -> ()
appFlowConfig :: MetricSourceProperty -> Maybe AppFlowConfigProperty
cloudwatchConfig :: MetricSourceProperty -> Maybe CloudwatchConfigProperty
rDSSourceConfig :: MetricSourceProperty -> Maybe RDSSourceConfigProperty
redshiftSourceConfig :: MetricSourceProperty -> Maybe RedshiftSourceConfigProperty
s3SourceConfig :: MetricSourceProperty -> Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
    = MetricSourceProperty
        {redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
redshiftSourceConfig = RedshiftSourceConfigProperty -> Maybe RedshiftSourceConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RedshiftSourceConfig" MetricSourceProperty
RedshiftSourceConfigProperty
newValue, Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
instance Property "S3SourceConfig" MetricSourceProperty where
  type PropertyType "S3SourceConfig" MetricSourceProperty = S3SourceConfigProperty
  set :: PropertyType "S3SourceConfig" MetricSourceProperty
-> MetricSourceProperty -> MetricSourceProperty
set PropertyType "S3SourceConfig" MetricSourceProperty
newValue MetricSourceProperty {Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe S3SourceConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: MetricSourceProperty -> ()
appFlowConfig :: MetricSourceProperty -> Maybe AppFlowConfigProperty
cloudwatchConfig :: MetricSourceProperty -> Maybe CloudwatchConfigProperty
rDSSourceConfig :: MetricSourceProperty -> Maybe RDSSourceConfigProperty
redshiftSourceConfig :: MetricSourceProperty -> Maybe RedshiftSourceConfigProperty
s3SourceConfig :: MetricSourceProperty -> Maybe S3SourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
s3SourceConfig :: Maybe S3SourceConfigProperty
..}
    = MetricSourceProperty {s3SourceConfig :: Maybe S3SourceConfigProperty
s3SourceConfig = S3SourceConfigProperty -> Maybe S3SourceConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "S3SourceConfig" MetricSourceProperty
S3SourceConfigProperty
newValue, Maybe AppFlowConfigProperty
Maybe CloudwatchConfigProperty
Maybe RedshiftSourceConfigProperty
Maybe RDSSourceConfigProperty
()
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
haddock_workaround_ :: ()
appFlowConfig :: Maybe AppFlowConfigProperty
cloudwatchConfig :: Maybe CloudwatchConfigProperty
rDSSourceConfig :: Maybe RDSSourceConfigProperty
redshiftSourceConfig :: Maybe RedshiftSourceConfigProperty
..}