module Stratosphere.DataZone.ProjectProfile.AwsAccountProperty (
        AwsAccountProperty(..), mkAwsAccountProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AwsAccountProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-datazone-projectprofile-awsaccount.html>
    AwsAccountProperty {AwsAccountProperty -> ()
haddock_workaround_ :: (),
                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-datazone-projectprofile-awsaccount.html#cfn-datazone-projectprofile-awsaccount-awsaccountid>
                        AwsAccountProperty -> Value Text
awsAccountId :: (Value Prelude.Text)}
  deriving stock (AwsAccountProperty -> AwsAccountProperty -> Bool
(AwsAccountProperty -> AwsAccountProperty -> Bool)
-> (AwsAccountProperty -> AwsAccountProperty -> Bool)
-> Eq AwsAccountProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AwsAccountProperty -> AwsAccountProperty -> Bool
== :: AwsAccountProperty -> AwsAccountProperty -> Bool
$c/= :: AwsAccountProperty -> AwsAccountProperty -> Bool
/= :: AwsAccountProperty -> AwsAccountProperty -> Bool
Prelude.Eq, Int -> AwsAccountProperty -> ShowS
[AwsAccountProperty] -> ShowS
AwsAccountProperty -> String
(Int -> AwsAccountProperty -> ShowS)
-> (AwsAccountProperty -> String)
-> ([AwsAccountProperty] -> ShowS)
-> Show AwsAccountProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AwsAccountProperty -> ShowS
showsPrec :: Int -> AwsAccountProperty -> ShowS
$cshow :: AwsAccountProperty -> String
show :: AwsAccountProperty -> String
$cshowList :: [AwsAccountProperty] -> ShowS
showList :: [AwsAccountProperty] -> ShowS
Prelude.Show)
mkAwsAccountProperty :: Value Prelude.Text -> AwsAccountProperty
mkAwsAccountProperty :: Value Text -> AwsAccountProperty
mkAwsAccountProperty Value Text
awsAccountId
  = AwsAccountProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), awsAccountId :: Value Text
awsAccountId = Value Text
awsAccountId}
instance ToResourceProperties AwsAccountProperty where
  toResourceProperties :: AwsAccountProperty -> ResourceProperties
toResourceProperties AwsAccountProperty {()
Value Text
haddock_workaround_ :: AwsAccountProperty -> ()
awsAccountId :: AwsAccountProperty -> Value Text
haddock_workaround_ :: ()
awsAccountId :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::DataZone::ProjectProfile.AwsAccount",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"AwsAccountId" 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
awsAccountId]}
instance JSON.ToJSON AwsAccountProperty where
  toJSON :: AwsAccountProperty -> Value
toJSON AwsAccountProperty {()
Value Text
haddock_workaround_ :: AwsAccountProperty -> ()
awsAccountId :: AwsAccountProperty -> Value Text
haddock_workaround_ :: ()
awsAccountId :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"AwsAccountId" 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
awsAccountId]
instance Property "AwsAccountId" AwsAccountProperty where
  type PropertyType "AwsAccountId" AwsAccountProperty = Value Prelude.Text
  set :: PropertyType "AwsAccountId" AwsAccountProperty
-> AwsAccountProperty -> AwsAccountProperty
set PropertyType "AwsAccountId" AwsAccountProperty
newValue AwsAccountProperty {()
Value Text
haddock_workaround_ :: AwsAccountProperty -> ()
awsAccountId :: AwsAccountProperty -> Value Text
haddock_workaround_ :: ()
awsAccountId :: Value Text
..}
    = AwsAccountProperty {awsAccountId :: Value Text
awsAccountId = PropertyType "AwsAccountId" AwsAccountProperty
Value Text
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}