module Stratosphere.Config.ConfigurationRecorder.RecordingStrategyProperty (
        RecordingStrategyProperty(..), mkRecordingStrategyProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data RecordingStrategyProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-config-configurationrecorder-recordingstrategy.html>
    RecordingStrategyProperty {RecordingStrategyProperty -> ()
haddock_workaround_ :: (),
                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-config-configurationrecorder-recordingstrategy.html#cfn-config-configurationrecorder-recordingstrategy-useonly>
                               RecordingStrategyProperty -> Value Text
useOnly :: (Value Prelude.Text)}
  deriving stock (RecordingStrategyProperty -> RecordingStrategyProperty -> Bool
(RecordingStrategyProperty -> RecordingStrategyProperty -> Bool)
-> (RecordingStrategyProperty -> RecordingStrategyProperty -> Bool)
-> Eq RecordingStrategyProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecordingStrategyProperty -> RecordingStrategyProperty -> Bool
== :: RecordingStrategyProperty -> RecordingStrategyProperty -> Bool
$c/= :: RecordingStrategyProperty -> RecordingStrategyProperty -> Bool
/= :: RecordingStrategyProperty -> RecordingStrategyProperty -> Bool
Prelude.Eq, Int -> RecordingStrategyProperty -> ShowS
[RecordingStrategyProperty] -> ShowS
RecordingStrategyProperty -> String
(Int -> RecordingStrategyProperty -> ShowS)
-> (RecordingStrategyProperty -> String)
-> ([RecordingStrategyProperty] -> ShowS)
-> Show RecordingStrategyProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordingStrategyProperty -> ShowS
showsPrec :: Int -> RecordingStrategyProperty -> ShowS
$cshow :: RecordingStrategyProperty -> String
show :: RecordingStrategyProperty -> String
$cshowList :: [RecordingStrategyProperty] -> ShowS
showList :: [RecordingStrategyProperty] -> ShowS
Prelude.Show)
mkRecordingStrategyProperty ::
  Value Prelude.Text -> RecordingStrategyProperty
mkRecordingStrategyProperty :: Value Text -> RecordingStrategyProperty
mkRecordingStrategyProperty Value Text
useOnly
  = RecordingStrategyProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), useOnly :: Value Text
useOnly = Value Text
useOnly}
instance ToResourceProperties RecordingStrategyProperty where
  toResourceProperties :: RecordingStrategyProperty -> ResourceProperties
toResourceProperties RecordingStrategyProperty {()
Value Text
haddock_workaround_ :: RecordingStrategyProperty -> ()
useOnly :: RecordingStrategyProperty -> Value Text
haddock_workaround_ :: ()
useOnly :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Config::ConfigurationRecorder.RecordingStrategy",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"UseOnly" 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
useOnly]}
instance JSON.ToJSON RecordingStrategyProperty where
  toJSON :: RecordingStrategyProperty -> Value
toJSON RecordingStrategyProperty {()
Value Text
haddock_workaround_ :: RecordingStrategyProperty -> ()
useOnly :: RecordingStrategyProperty -> Value Text
haddock_workaround_ :: ()
useOnly :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"UseOnly" 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
useOnly]
instance Property "UseOnly" RecordingStrategyProperty where
  type PropertyType "UseOnly" RecordingStrategyProperty = Value Prelude.Text
  set :: PropertyType "UseOnly" RecordingStrategyProperty
-> RecordingStrategyProperty -> RecordingStrategyProperty
set PropertyType "UseOnly" RecordingStrategyProperty
newValue RecordingStrategyProperty {()
Value Text
haddock_workaround_ :: RecordingStrategyProperty -> ()
useOnly :: RecordingStrategyProperty -> Value Text
haddock_workaround_ :: ()
useOnly :: Value Text
..}
    = RecordingStrategyProperty {useOnly :: Value Text
useOnly = PropertyType "UseOnly" RecordingStrategyProperty
Value Text
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}