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