module Stratosphere.S3.Bucket.DataExportProperty (
module Exports, DataExportProperty(..), mkDataExportProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.S3.Bucket.DestinationProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data DataExportProperty
=
DataExportProperty {DataExportProperty -> ()
haddock_workaround_ :: (),
DataExportProperty -> DestinationProperty
destination :: DestinationProperty,
DataExportProperty -> Value Text
outputSchemaVersion :: (Value Prelude.Text)}
deriving stock (DataExportProperty -> DataExportProperty -> Bool
(DataExportProperty -> DataExportProperty -> Bool)
-> (DataExportProperty -> DataExportProperty -> Bool)
-> Eq DataExportProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataExportProperty -> DataExportProperty -> Bool
== :: DataExportProperty -> DataExportProperty -> Bool
$c/= :: DataExportProperty -> DataExportProperty -> Bool
/= :: DataExportProperty -> DataExportProperty -> Bool
Prelude.Eq, Int -> DataExportProperty -> ShowS
[DataExportProperty] -> ShowS
DataExportProperty -> String
(Int -> DataExportProperty -> ShowS)
-> (DataExportProperty -> String)
-> ([DataExportProperty] -> ShowS)
-> Show DataExportProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataExportProperty -> ShowS
showsPrec :: Int -> DataExportProperty -> ShowS
$cshow :: DataExportProperty -> String
show :: DataExportProperty -> String
$cshowList :: [DataExportProperty] -> ShowS
showList :: [DataExportProperty] -> ShowS
Prelude.Show)
mkDataExportProperty ::
DestinationProperty -> Value Prelude.Text -> DataExportProperty
mkDataExportProperty :: DestinationProperty -> Value Text -> DataExportProperty
mkDataExportProperty DestinationProperty
destination Value Text
outputSchemaVersion
= DataExportProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), destination :: DestinationProperty
destination = DestinationProperty
destination,
outputSchemaVersion :: Value Text
outputSchemaVersion = Value Text
outputSchemaVersion}
instance ToResourceProperties DataExportProperty where
toResourceProperties :: DataExportProperty -> ResourceProperties
toResourceProperties DataExportProperty {()
Value Text
DestinationProperty
haddock_workaround_ :: DataExportProperty -> ()
destination :: DataExportProperty -> DestinationProperty
outputSchemaVersion :: DataExportProperty -> Value Text
haddock_workaround_ :: ()
destination :: DestinationProperty
outputSchemaVersion :: Value Text
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::S3::Bucket.DataExport",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"Destination" Key -> DestinationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= DestinationProperty
destination,
Key
"OutputSchemaVersion" 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
outputSchemaVersion]}
instance JSON.ToJSON DataExportProperty where
toJSON :: DataExportProperty -> Value
toJSON DataExportProperty {()
Value Text
DestinationProperty
haddock_workaround_ :: DataExportProperty -> ()
destination :: DataExportProperty -> DestinationProperty
outputSchemaVersion :: DataExportProperty -> Value Text
haddock_workaround_ :: ()
destination :: DestinationProperty
outputSchemaVersion :: Value Text
..}
= [(Key, Value)] -> Value
JSON.object
[Key
"Destination" Key -> DestinationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= DestinationProperty
destination,
Key
"OutputSchemaVersion" 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
outputSchemaVersion]
instance Property "Destination" DataExportProperty where
type PropertyType "Destination" DataExportProperty = DestinationProperty
set :: PropertyType "Destination" DataExportProperty
-> DataExportProperty -> DataExportProperty
set PropertyType "Destination" DataExportProperty
newValue DataExportProperty {()
Value Text
DestinationProperty
haddock_workaround_ :: DataExportProperty -> ()
destination :: DataExportProperty -> DestinationProperty
outputSchemaVersion :: DataExportProperty -> Value Text
haddock_workaround_ :: ()
destination :: DestinationProperty
outputSchemaVersion :: Value Text
..}
= DataExportProperty {destination :: DestinationProperty
destination = PropertyType "Destination" DataExportProperty
DestinationProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
outputSchemaVersion :: Value Text
haddock_workaround_ :: ()
outputSchemaVersion :: Value Text
..}
instance Property "OutputSchemaVersion" DataExportProperty where
type PropertyType "OutputSchemaVersion" DataExportProperty = Value Prelude.Text
set :: PropertyType "OutputSchemaVersion" DataExportProperty
-> DataExportProperty -> DataExportProperty
set PropertyType "OutputSchemaVersion" DataExportProperty
newValue DataExportProperty {()
Value Text
DestinationProperty
haddock_workaround_ :: DataExportProperty -> ()
destination :: DataExportProperty -> DestinationProperty
outputSchemaVersion :: DataExportProperty -> Value Text
haddock_workaround_ :: ()
destination :: DestinationProperty
outputSchemaVersion :: Value Text
..}
= DataExportProperty {outputSchemaVersion :: Value Text
outputSchemaVersion = PropertyType "OutputSchemaVersion" DataExportProperty
Value Text
newValue, ()
DestinationProperty
haddock_workaround_ :: ()
destination :: DestinationProperty
haddock_workaround_ :: ()
destination :: DestinationProperty
..}