module Stratosphere.EC2.VPNConnection.CloudwatchLogOptionsSpecificationProperty (
        CloudwatchLogOptionsSpecificationProperty(..),
        mkCloudwatchLogOptionsSpecificationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data CloudwatchLogOptionsSpecificationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-ec2-vpnconnection-cloudwatchlogoptionsspecification.html>
    CloudwatchLogOptionsSpecificationProperty {CloudwatchLogOptionsSpecificationProperty -> ()
haddock_workaround_ :: (),
                                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-ec2-vpnconnection-cloudwatchlogoptionsspecification.html#cfn-ec2-vpnconnection-cloudwatchlogoptionsspecification-logenabled>
                                               CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Bool)
logEnabled :: (Prelude.Maybe (Value Prelude.Bool)),
                                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-ec2-vpnconnection-cloudwatchlogoptionsspecification.html#cfn-ec2-vpnconnection-cloudwatchlogoptionsspecification-loggrouparn>
                                               CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
logGroupArn :: (Prelude.Maybe (Value Prelude.Text)),
                                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-ec2-vpnconnection-cloudwatchlogoptionsspecification.html#cfn-ec2-vpnconnection-cloudwatchlogoptionsspecification-logoutputformat>
                                               CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
logOutputFormat :: (Prelude.Maybe (Value Prelude.Text))}
  deriving stock (CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty -> Bool
(CloudwatchLogOptionsSpecificationProperty
 -> CloudwatchLogOptionsSpecificationProperty -> Bool)
-> (CloudwatchLogOptionsSpecificationProperty
    -> CloudwatchLogOptionsSpecificationProperty -> Bool)
-> Eq CloudwatchLogOptionsSpecificationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty -> Bool
== :: CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty -> Bool
$c/= :: CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty -> Bool
/= :: CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty -> Bool
Prelude.Eq, Int -> CloudwatchLogOptionsSpecificationProperty -> ShowS
[CloudwatchLogOptionsSpecificationProperty] -> ShowS
CloudwatchLogOptionsSpecificationProperty -> String
(Int -> CloudwatchLogOptionsSpecificationProperty -> ShowS)
-> (CloudwatchLogOptionsSpecificationProperty -> String)
-> ([CloudwatchLogOptionsSpecificationProperty] -> ShowS)
-> Show CloudwatchLogOptionsSpecificationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloudwatchLogOptionsSpecificationProperty -> ShowS
showsPrec :: Int -> CloudwatchLogOptionsSpecificationProperty -> ShowS
$cshow :: CloudwatchLogOptionsSpecificationProperty -> String
show :: CloudwatchLogOptionsSpecificationProperty -> String
$cshowList :: [CloudwatchLogOptionsSpecificationProperty] -> ShowS
showList :: [CloudwatchLogOptionsSpecificationProperty] -> ShowS
Prelude.Show)
mkCloudwatchLogOptionsSpecificationProperty ::
  CloudwatchLogOptionsSpecificationProperty
mkCloudwatchLogOptionsSpecificationProperty :: CloudwatchLogOptionsSpecificationProperty
mkCloudwatchLogOptionsSpecificationProperty
  = CloudwatchLogOptionsSpecificationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), logEnabled :: Maybe (Value Bool)
logEnabled = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       logGroupArn :: Maybe (Value Text)
logGroupArn = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing, logOutputFormat :: Maybe (Value Text)
logOutputFormat = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties CloudwatchLogOptionsSpecificationProperty where
  toResourceProperties :: CloudwatchLogOptionsSpecificationProperty -> ResourceProperties
toResourceProperties CloudwatchLogOptionsSpecificationProperty {Maybe (Value Bool)
Maybe (Value Text)
()
haddock_workaround_ :: CloudwatchLogOptionsSpecificationProperty -> ()
logEnabled :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Bool)
logGroupArn :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
logOutputFormat :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logGroupArn :: Maybe (Value Text)
logOutputFormat :: Maybe (Value Text)
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::EC2::VPNConnection.CloudwatchLogOptionsSpecification",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"LogEnabled" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
logEnabled,
                            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..=) Key
"LogGroupArn" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
logGroupArn,
                            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..=) Key
"LogOutputFormat" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
logOutputFormat])}
instance JSON.ToJSON CloudwatchLogOptionsSpecificationProperty where
  toJSON :: CloudwatchLogOptionsSpecificationProperty -> Value
toJSON CloudwatchLogOptionsSpecificationProperty {Maybe (Value Bool)
Maybe (Value Text)
()
haddock_workaround_ :: CloudwatchLogOptionsSpecificationProperty -> ()
logEnabled :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Bool)
logGroupArn :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
logOutputFormat :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logGroupArn :: Maybe (Value Text)
logOutputFormat :: Maybe (Value Text)
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"LogEnabled" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
logEnabled,
               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..=) Key
"LogGroupArn" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
logGroupArn,
               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..=) Key
"LogOutputFormat" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
logOutputFormat]))
instance Property "LogEnabled" CloudwatchLogOptionsSpecificationProperty where
  type PropertyType "LogEnabled" CloudwatchLogOptionsSpecificationProperty = Value Prelude.Bool
  set :: PropertyType "LogEnabled" CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty
set PropertyType "LogEnabled" CloudwatchLogOptionsSpecificationProperty
newValue CloudwatchLogOptionsSpecificationProperty {Maybe (Value Bool)
Maybe (Value Text)
()
haddock_workaround_ :: CloudwatchLogOptionsSpecificationProperty -> ()
logEnabled :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Bool)
logGroupArn :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
logOutputFormat :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logGroupArn :: Maybe (Value Text)
logOutputFormat :: Maybe (Value Text)
..}
    = CloudwatchLogOptionsSpecificationProperty
        {logEnabled :: Maybe (Value Bool)
logEnabled = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "LogEnabled" CloudwatchLogOptionsSpecificationProperty
Value Bool
newValue, Maybe (Value Text)
()
haddock_workaround_ :: ()
logGroupArn :: Maybe (Value Text)
logOutputFormat :: Maybe (Value Text)
haddock_workaround_ :: ()
logGroupArn :: Maybe (Value Text)
logOutputFormat :: Maybe (Value Text)
..}
instance Property "LogGroupArn" CloudwatchLogOptionsSpecificationProperty where
  type PropertyType "LogGroupArn" CloudwatchLogOptionsSpecificationProperty = Value Prelude.Text
  set :: PropertyType
  "LogGroupArn" CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty
set PropertyType
  "LogGroupArn" CloudwatchLogOptionsSpecificationProperty
newValue CloudwatchLogOptionsSpecificationProperty {Maybe (Value Bool)
Maybe (Value Text)
()
haddock_workaround_ :: CloudwatchLogOptionsSpecificationProperty -> ()
logEnabled :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Bool)
logGroupArn :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
logOutputFormat :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logGroupArn :: Maybe (Value Text)
logOutputFormat :: Maybe (Value Text)
..}
    = CloudwatchLogOptionsSpecificationProperty
        {logGroupArn :: Maybe (Value Text)
logGroupArn = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "LogGroupArn" CloudwatchLogOptionsSpecificationProperty
Value Text
newValue, Maybe (Value Bool)
Maybe (Value Text)
()
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logOutputFormat :: Maybe (Value Text)
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logOutputFormat :: Maybe (Value Text)
..}
instance Property "LogOutputFormat" CloudwatchLogOptionsSpecificationProperty where
  type PropertyType "LogOutputFormat" CloudwatchLogOptionsSpecificationProperty = Value Prelude.Text
  set :: PropertyType
  "LogOutputFormat" CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty
-> CloudwatchLogOptionsSpecificationProperty
set PropertyType
  "LogOutputFormat" CloudwatchLogOptionsSpecificationProperty
newValue CloudwatchLogOptionsSpecificationProperty {Maybe (Value Bool)
Maybe (Value Text)
()
haddock_workaround_ :: CloudwatchLogOptionsSpecificationProperty -> ()
logEnabled :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Bool)
logGroupArn :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
logOutputFormat :: CloudwatchLogOptionsSpecificationProperty -> Maybe (Value Text)
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logGroupArn :: Maybe (Value Text)
logOutputFormat :: Maybe (Value Text)
..}
    = CloudwatchLogOptionsSpecificationProperty
        {logOutputFormat :: Maybe (Value Text)
logOutputFormat = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "LogOutputFormat" CloudwatchLogOptionsSpecificationProperty
Value Text
newValue, Maybe (Value Bool)
Maybe (Value Text)
()
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logGroupArn :: Maybe (Value Text)
haddock_workaround_ :: ()
logEnabled :: Maybe (Value Bool)
logGroupArn :: Maybe (Value Text)
..}