module Stratosphere.KinesisFirehose.DeliveryStream.KinesisStreamSourceConfigurationProperty (
KinesisStreamSourceConfigurationProperty(..),
mkKinesisStreamSourceConfigurationProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data KinesisStreamSourceConfigurationProperty
=
KinesisStreamSourceConfigurationProperty {KinesisStreamSourceConfigurationProperty -> ()
haddock_workaround_ :: (),
KinesisStreamSourceConfigurationProperty -> Value Text
kinesisStreamARN :: (Value Prelude.Text),
KinesisStreamSourceConfigurationProperty -> Value Text
roleARN :: (Value Prelude.Text)}
deriving stock (KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty -> Bool
(KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty -> Bool)
-> (KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty -> Bool)
-> Eq KinesisStreamSourceConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty -> Bool
== :: KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty -> Bool
$c/= :: KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty -> Bool
/= :: KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty -> Bool
Prelude.Eq, Int -> KinesisStreamSourceConfigurationProperty -> ShowS
[KinesisStreamSourceConfigurationProperty] -> ShowS
KinesisStreamSourceConfigurationProperty -> String
(Int -> KinesisStreamSourceConfigurationProperty -> ShowS)
-> (KinesisStreamSourceConfigurationProperty -> String)
-> ([KinesisStreamSourceConfigurationProperty] -> ShowS)
-> Show KinesisStreamSourceConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KinesisStreamSourceConfigurationProperty -> ShowS
showsPrec :: Int -> KinesisStreamSourceConfigurationProperty -> ShowS
$cshow :: KinesisStreamSourceConfigurationProperty -> String
show :: KinesisStreamSourceConfigurationProperty -> String
$cshowList :: [KinesisStreamSourceConfigurationProperty] -> ShowS
showList :: [KinesisStreamSourceConfigurationProperty] -> ShowS
Prelude.Show)
mkKinesisStreamSourceConfigurationProperty ::
Value Prelude.Text
-> Value Prelude.Text -> KinesisStreamSourceConfigurationProperty
mkKinesisStreamSourceConfigurationProperty :: Value Text
-> Value Text -> KinesisStreamSourceConfigurationProperty
mkKinesisStreamSourceConfigurationProperty Value Text
kinesisStreamARN Value Text
roleARN
= KinesisStreamSourceConfigurationProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), kinesisStreamARN :: Value Text
kinesisStreamARN = Value Text
kinesisStreamARN,
roleARN :: Value Text
roleARN = Value Text
roleARN}
instance ToResourceProperties KinesisStreamSourceConfigurationProperty where
toResourceProperties :: KinesisStreamSourceConfigurationProperty -> ResourceProperties
toResourceProperties KinesisStreamSourceConfigurationProperty {()
Value Text
haddock_workaround_ :: KinesisStreamSourceConfigurationProperty -> ()
kinesisStreamARN :: KinesisStreamSourceConfigurationProperty -> Value Text
roleARN :: KinesisStreamSourceConfigurationProperty -> Value Text
haddock_workaround_ :: ()
kinesisStreamARN :: Value Text
roleARN :: Value Text
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::KinesisFirehose::DeliveryStream.KinesisStreamSourceConfiguration",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"KinesisStreamARN" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
kinesisStreamARN,
Key
"RoleARN" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
roleARN]}
instance JSON.ToJSON KinesisStreamSourceConfigurationProperty where
toJSON :: KinesisStreamSourceConfigurationProperty -> Value
toJSON KinesisStreamSourceConfigurationProperty {()
Value Text
haddock_workaround_ :: KinesisStreamSourceConfigurationProperty -> ()
kinesisStreamARN :: KinesisStreamSourceConfigurationProperty -> Value Text
roleARN :: KinesisStreamSourceConfigurationProperty -> Value Text
haddock_workaround_ :: ()
kinesisStreamARN :: Value Text
roleARN :: Value Text
..}
= [(Key, Value)] -> Value
JSON.object
[Key
"KinesisStreamARN" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
kinesisStreamARN,
Key
"RoleARN" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
roleARN]
instance Property "KinesisStreamARN" KinesisStreamSourceConfigurationProperty where
type PropertyType "KinesisStreamARN" KinesisStreamSourceConfigurationProperty = Value Prelude.Text
set :: PropertyType
"KinesisStreamARN" KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty
set PropertyType
"KinesisStreamARN" KinesisStreamSourceConfigurationProperty
newValue KinesisStreamSourceConfigurationProperty {()
Value Text
haddock_workaround_ :: KinesisStreamSourceConfigurationProperty -> ()
kinesisStreamARN :: KinesisStreamSourceConfigurationProperty -> Value Text
roleARN :: KinesisStreamSourceConfigurationProperty -> Value Text
haddock_workaround_ :: ()
kinesisStreamARN :: Value Text
roleARN :: Value Text
..}
= KinesisStreamSourceConfigurationProperty
{kinesisStreamARN :: Value Text
kinesisStreamARN = PropertyType
"KinesisStreamARN" KinesisStreamSourceConfigurationProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
roleARN :: Value Text
haddock_workaround_ :: ()
roleARN :: Value Text
..}
instance Property "RoleARN" KinesisStreamSourceConfigurationProperty where
type PropertyType "RoleARN" KinesisStreamSourceConfigurationProperty = Value Prelude.Text
set :: PropertyType "RoleARN" KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty
-> KinesisStreamSourceConfigurationProperty
set PropertyType "RoleARN" KinesisStreamSourceConfigurationProperty
newValue KinesisStreamSourceConfigurationProperty {()
Value Text
haddock_workaround_ :: KinesisStreamSourceConfigurationProperty -> ()
kinesisStreamARN :: KinesisStreamSourceConfigurationProperty -> Value Text
roleARN :: KinesisStreamSourceConfigurationProperty -> Value Text
haddock_workaround_ :: ()
kinesisStreamARN :: Value Text
roleARN :: Value Text
..}
= KinesisStreamSourceConfigurationProperty {roleARN :: Value Text
roleARN = PropertyType "RoleARN" KinesisStreamSourceConfigurationProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
kinesisStreamARN :: Value Text
haddock_workaround_ :: ()
kinesisStreamARN :: Value Text
..}