module Stratosphere.QBusiness.Application.AttachmentsConfigurationProperty (
        AttachmentsConfigurationProperty(..),
        mkAttachmentsConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AttachmentsConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-qbusiness-application-attachmentsconfiguration.html>
    AttachmentsConfigurationProperty {AttachmentsConfigurationProperty -> ()
haddock_workaround_ :: (),
                                      -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-qbusiness-application-attachmentsconfiguration.html#cfn-qbusiness-application-attachmentsconfiguration-attachmentscontrolmode>
                                      AttachmentsConfigurationProperty -> Value Text
attachmentsControlMode :: (Value Prelude.Text)}
  deriving stock (AttachmentsConfigurationProperty
-> AttachmentsConfigurationProperty -> Bool
(AttachmentsConfigurationProperty
 -> AttachmentsConfigurationProperty -> Bool)
-> (AttachmentsConfigurationProperty
    -> AttachmentsConfigurationProperty -> Bool)
-> Eq AttachmentsConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttachmentsConfigurationProperty
-> AttachmentsConfigurationProperty -> Bool
== :: AttachmentsConfigurationProperty
-> AttachmentsConfigurationProperty -> Bool
$c/= :: AttachmentsConfigurationProperty
-> AttachmentsConfigurationProperty -> Bool
/= :: AttachmentsConfigurationProperty
-> AttachmentsConfigurationProperty -> Bool
Prelude.Eq, Int -> AttachmentsConfigurationProperty -> ShowS
[AttachmentsConfigurationProperty] -> ShowS
AttachmentsConfigurationProperty -> String
(Int -> AttachmentsConfigurationProperty -> ShowS)
-> (AttachmentsConfigurationProperty -> String)
-> ([AttachmentsConfigurationProperty] -> ShowS)
-> Show AttachmentsConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttachmentsConfigurationProperty -> ShowS
showsPrec :: Int -> AttachmentsConfigurationProperty -> ShowS
$cshow :: AttachmentsConfigurationProperty -> String
show :: AttachmentsConfigurationProperty -> String
$cshowList :: [AttachmentsConfigurationProperty] -> ShowS
showList :: [AttachmentsConfigurationProperty] -> ShowS
Prelude.Show)
mkAttachmentsConfigurationProperty ::
  Value Prelude.Text -> AttachmentsConfigurationProperty
mkAttachmentsConfigurationProperty :: Value Text -> AttachmentsConfigurationProperty
mkAttachmentsConfigurationProperty Value Text
attachmentsControlMode
  = AttachmentsConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (),
       attachmentsControlMode :: Value Text
attachmentsControlMode = Value Text
attachmentsControlMode}
instance ToResourceProperties AttachmentsConfigurationProperty where
  toResourceProperties :: AttachmentsConfigurationProperty -> ResourceProperties
toResourceProperties AttachmentsConfigurationProperty {()
Value Text
haddock_workaround_ :: AttachmentsConfigurationProperty -> ()
attachmentsControlMode :: AttachmentsConfigurationProperty -> Value Text
haddock_workaround_ :: ()
attachmentsControlMode :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::QBusiness::Application.AttachmentsConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"AttachmentsControlMode"
                         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
attachmentsControlMode]}
instance JSON.ToJSON AttachmentsConfigurationProperty where
  toJSON :: AttachmentsConfigurationProperty -> Value
toJSON AttachmentsConfigurationProperty {()
Value Text
haddock_workaround_ :: AttachmentsConfigurationProperty -> ()
attachmentsControlMode :: AttachmentsConfigurationProperty -> Value Text
haddock_workaround_ :: ()
attachmentsControlMode :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"AttachmentsControlMode" 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
attachmentsControlMode]
instance Property "AttachmentsControlMode" AttachmentsConfigurationProperty where
  type PropertyType "AttachmentsControlMode" AttachmentsConfigurationProperty = Value Prelude.Text
  set :: PropertyType
  "AttachmentsControlMode" AttachmentsConfigurationProperty
-> AttachmentsConfigurationProperty
-> AttachmentsConfigurationProperty
set PropertyType
  "AttachmentsControlMode" AttachmentsConfigurationProperty
newValue AttachmentsConfigurationProperty {()
Value Text
haddock_workaround_ :: AttachmentsConfigurationProperty -> ()
attachmentsControlMode :: AttachmentsConfigurationProperty -> Value Text
haddock_workaround_ :: ()
attachmentsControlMode :: Value Text
..}
    = AttachmentsConfigurationProperty
        {attachmentsControlMode :: Value Text
attachmentsControlMode = PropertyType
  "AttachmentsControlMode" AttachmentsConfigurationProperty
Value Text
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}