module Stratosphere.S3.Bucket.AccessControlTranslationProperty (
        AccessControlTranslationProperty(..),
        mkAccessControlTranslationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AccessControlTranslationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-s3-bucket-accesscontroltranslation.html>
    AccessControlTranslationProperty {AccessControlTranslationProperty -> ()
haddock_workaround_ :: (),
                                      -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-s3-bucket-accesscontroltranslation.html#cfn-s3-bucket-accesscontroltranslation-owner>
                                      AccessControlTranslationProperty -> Value Text
owner :: (Value Prelude.Text)}
  deriving stock (AccessControlTranslationProperty
-> AccessControlTranslationProperty -> Bool
(AccessControlTranslationProperty
 -> AccessControlTranslationProperty -> Bool)
-> (AccessControlTranslationProperty
    -> AccessControlTranslationProperty -> Bool)
-> Eq AccessControlTranslationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessControlTranslationProperty
-> AccessControlTranslationProperty -> Bool
== :: AccessControlTranslationProperty
-> AccessControlTranslationProperty -> Bool
$c/= :: AccessControlTranslationProperty
-> AccessControlTranslationProperty -> Bool
/= :: AccessControlTranslationProperty
-> AccessControlTranslationProperty -> Bool
Prelude.Eq, Int -> AccessControlTranslationProperty -> ShowS
[AccessControlTranslationProperty] -> ShowS
AccessControlTranslationProperty -> String
(Int -> AccessControlTranslationProperty -> ShowS)
-> (AccessControlTranslationProperty -> String)
-> ([AccessControlTranslationProperty] -> ShowS)
-> Show AccessControlTranslationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessControlTranslationProperty -> ShowS
showsPrec :: Int -> AccessControlTranslationProperty -> ShowS
$cshow :: AccessControlTranslationProperty -> String
show :: AccessControlTranslationProperty -> String
$cshowList :: [AccessControlTranslationProperty] -> ShowS
showList :: [AccessControlTranslationProperty] -> ShowS
Prelude.Show)
mkAccessControlTranslationProperty ::
  Value Prelude.Text -> AccessControlTranslationProperty
mkAccessControlTranslationProperty :: Value Text -> AccessControlTranslationProperty
mkAccessControlTranslationProperty Value Text
owner
  = AccessControlTranslationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), owner :: Value Text
owner = Value Text
owner}
instance ToResourceProperties AccessControlTranslationProperty where
  toResourceProperties :: AccessControlTranslationProperty -> ResourceProperties
toResourceProperties AccessControlTranslationProperty {()
Value Text
haddock_workaround_ :: AccessControlTranslationProperty -> ()
owner :: AccessControlTranslationProperty -> Value Text
haddock_workaround_ :: ()
owner :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::S3::Bucket.AccessControlTranslation",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False, properties :: Object
properties = [Key
"Owner" 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
owner]}
instance JSON.ToJSON AccessControlTranslationProperty where
  toJSON :: AccessControlTranslationProperty -> Value
toJSON AccessControlTranslationProperty {()
Value Text
haddock_workaround_ :: AccessControlTranslationProperty -> ()
owner :: AccessControlTranslationProperty -> Value Text
haddock_workaround_ :: ()
owner :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Owner" 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
owner]
instance Property "Owner" AccessControlTranslationProperty where
  type PropertyType "Owner" AccessControlTranslationProperty = Value Prelude.Text
  set :: PropertyType "Owner" AccessControlTranslationProperty
-> AccessControlTranslationProperty
-> AccessControlTranslationProperty
set PropertyType "Owner" AccessControlTranslationProperty
newValue AccessControlTranslationProperty {()
Value Text
haddock_workaround_ :: AccessControlTranslationProperty -> ()
owner :: AccessControlTranslationProperty -> Value Text
haddock_workaround_ :: ()
owner :: Value Text
..}
    = AccessControlTranslationProperty {owner :: Value Text
owner = PropertyType "Owner" AccessControlTranslationProperty
Value Text
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}