module Stratosphere.GuardDuty.MalwareProtectionPlan (
module Exports, MalwareProtectionPlan(..), mkMalwareProtectionPlan
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.GuardDuty.MalwareProtectionPlan.CFNActionsProperty as Exports
import {-# SOURCE #-} Stratosphere.GuardDuty.MalwareProtectionPlan.CFNProtectedResourceProperty as Exports
import {-# SOURCE #-} Stratosphere.GuardDuty.MalwareProtectionPlan.TagItemProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data MalwareProtectionPlan
=
MalwareProtectionPlan {MalwareProtectionPlan -> ()
haddock_workaround_ :: (),
MalwareProtectionPlan -> Maybe CFNActionsProperty
actions :: (Prelude.Maybe CFNActionsProperty),
MalwareProtectionPlan -> CFNProtectedResourceProperty
protectedResource :: CFNProtectedResourceProperty,
MalwareProtectionPlan -> Value Text
role :: (Value Prelude.Text),
MalwareProtectionPlan -> Maybe [TagItemProperty]
tags :: (Prelude.Maybe [TagItemProperty])}
deriving stock (MalwareProtectionPlan -> MalwareProtectionPlan -> Bool
(MalwareProtectionPlan -> MalwareProtectionPlan -> Bool)
-> (MalwareProtectionPlan -> MalwareProtectionPlan -> Bool)
-> Eq MalwareProtectionPlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MalwareProtectionPlan -> MalwareProtectionPlan -> Bool
== :: MalwareProtectionPlan -> MalwareProtectionPlan -> Bool
$c/= :: MalwareProtectionPlan -> MalwareProtectionPlan -> Bool
/= :: MalwareProtectionPlan -> MalwareProtectionPlan -> Bool
Prelude.Eq, Int -> MalwareProtectionPlan -> ShowS
[MalwareProtectionPlan] -> ShowS
MalwareProtectionPlan -> String
(Int -> MalwareProtectionPlan -> ShowS)
-> (MalwareProtectionPlan -> String)
-> ([MalwareProtectionPlan] -> ShowS)
-> Show MalwareProtectionPlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MalwareProtectionPlan -> ShowS
showsPrec :: Int -> MalwareProtectionPlan -> ShowS
$cshow :: MalwareProtectionPlan -> String
show :: MalwareProtectionPlan -> String
$cshowList :: [MalwareProtectionPlan] -> ShowS
showList :: [MalwareProtectionPlan] -> ShowS
Prelude.Show)
mkMalwareProtectionPlan ::
CFNProtectedResourceProperty
-> Value Prelude.Text -> MalwareProtectionPlan
mkMalwareProtectionPlan :: CFNProtectedResourceProperty -> Value Text -> MalwareProtectionPlan
mkMalwareProtectionPlan CFNProtectedResourceProperty
protectedResource Value Text
role
= MalwareProtectionPlan
{haddock_workaround_ :: ()
haddock_workaround_ = (), protectedResource :: CFNProtectedResourceProperty
protectedResource = CFNProtectedResourceProperty
protectedResource,
role :: Value Text
role = Value Text
role, actions :: Maybe CFNActionsProperty
actions = Maybe CFNActionsProperty
forall a. Maybe a
Prelude.Nothing, tags :: Maybe [TagItemProperty]
tags = Maybe [TagItemProperty]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties MalwareProtectionPlan where
toResourceProperties :: MalwareProtectionPlan -> ResourceProperties
toResourceProperties MalwareProtectionPlan {Maybe [TagItemProperty]
Maybe CFNActionsProperty
()
Value Text
CFNProtectedResourceProperty
haddock_workaround_ :: MalwareProtectionPlan -> ()
actions :: MalwareProtectionPlan -> Maybe CFNActionsProperty
protectedResource :: MalwareProtectionPlan -> CFNProtectedResourceProperty
role :: MalwareProtectionPlan -> Value Text
tags :: MalwareProtectionPlan -> Maybe [TagItemProperty]
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::GuardDuty::MalwareProtectionPlan",
supportsTags :: Bool
supportsTags = Bool
Prelude.True,
properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
[Key
"ProtectedResource" Key -> CFNProtectedResourceProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= CFNProtectedResourceProperty
protectedResource,
Key
"Role" 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
role]
([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
[Key -> CFNActionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Actions" (CFNActionsProperty -> (Key, Value))
-> Maybe CFNActionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CFNActionsProperty
actions,
Key -> [TagItemProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tags" ([TagItemProperty] -> (Key, Value))
-> Maybe [TagItemProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagItemProperty]
tags]))}
instance JSON.ToJSON MalwareProtectionPlan where
toJSON :: MalwareProtectionPlan -> Value
toJSON MalwareProtectionPlan {Maybe [TagItemProperty]
Maybe CFNActionsProperty
()
Value Text
CFNProtectedResourceProperty
haddock_workaround_ :: MalwareProtectionPlan -> ()
actions :: MalwareProtectionPlan -> Maybe CFNActionsProperty
protectedResource :: MalwareProtectionPlan -> CFNProtectedResourceProperty
role :: MalwareProtectionPlan -> Value Text
tags :: MalwareProtectionPlan -> Maybe [TagItemProperty]
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
..}
= [(Key, Value)] -> Value
JSON.object
([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
[Key
"ProtectedResource" Key -> CFNProtectedResourceProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= CFNProtectedResourceProperty
protectedResource,
Key
"Role" 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
role]
([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
[Key -> CFNActionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Actions" (CFNActionsProperty -> (Key, Value))
-> Maybe CFNActionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CFNActionsProperty
actions,
Key -> [TagItemProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tags" ([TagItemProperty] -> (Key, Value))
-> Maybe [TagItemProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagItemProperty]
tags])))
instance Property "Actions" MalwareProtectionPlan where
type PropertyType "Actions" MalwareProtectionPlan = CFNActionsProperty
set :: PropertyType "Actions" MalwareProtectionPlan
-> MalwareProtectionPlan -> MalwareProtectionPlan
set PropertyType "Actions" MalwareProtectionPlan
newValue MalwareProtectionPlan {Maybe [TagItemProperty]
Maybe CFNActionsProperty
()
Value Text
CFNProtectedResourceProperty
haddock_workaround_ :: MalwareProtectionPlan -> ()
actions :: MalwareProtectionPlan -> Maybe CFNActionsProperty
protectedResource :: MalwareProtectionPlan -> CFNProtectedResourceProperty
role :: MalwareProtectionPlan -> Value Text
tags :: MalwareProtectionPlan -> Maybe [TagItemProperty]
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
..}
= MalwareProtectionPlan {actions :: Maybe CFNActionsProperty
actions = CFNActionsProperty -> Maybe CFNActionsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Actions" MalwareProtectionPlan
CFNActionsProperty
newValue, Maybe [TagItemProperty]
()
Value Text
CFNProtectedResourceProperty
haddock_workaround_ :: ()
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
haddock_workaround_ :: ()
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
..}
instance Property "ProtectedResource" MalwareProtectionPlan where
type PropertyType "ProtectedResource" MalwareProtectionPlan = CFNProtectedResourceProperty
set :: PropertyType "ProtectedResource" MalwareProtectionPlan
-> MalwareProtectionPlan -> MalwareProtectionPlan
set PropertyType "ProtectedResource" MalwareProtectionPlan
newValue MalwareProtectionPlan {Maybe [TagItemProperty]
Maybe CFNActionsProperty
()
Value Text
CFNProtectedResourceProperty
haddock_workaround_ :: MalwareProtectionPlan -> ()
actions :: MalwareProtectionPlan -> Maybe CFNActionsProperty
protectedResource :: MalwareProtectionPlan -> CFNProtectedResourceProperty
role :: MalwareProtectionPlan -> Value Text
tags :: MalwareProtectionPlan -> Maybe [TagItemProperty]
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
..}
= MalwareProtectionPlan {protectedResource :: CFNProtectedResourceProperty
protectedResource = PropertyType "ProtectedResource" MalwareProtectionPlan
CFNProtectedResourceProperty
newValue, Maybe [TagItemProperty]
Maybe CFNActionsProperty
()
Value Text
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
..}
instance Property "Role" MalwareProtectionPlan where
type PropertyType "Role" MalwareProtectionPlan = Value Prelude.Text
set :: PropertyType "Role" MalwareProtectionPlan
-> MalwareProtectionPlan -> MalwareProtectionPlan
set PropertyType "Role" MalwareProtectionPlan
newValue MalwareProtectionPlan {Maybe [TagItemProperty]
Maybe CFNActionsProperty
()
Value Text
CFNProtectedResourceProperty
haddock_workaround_ :: MalwareProtectionPlan -> ()
actions :: MalwareProtectionPlan -> Maybe CFNActionsProperty
protectedResource :: MalwareProtectionPlan -> CFNProtectedResourceProperty
role :: MalwareProtectionPlan -> Value Text
tags :: MalwareProtectionPlan -> Maybe [TagItemProperty]
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
..}
= MalwareProtectionPlan {role :: Value Text
role = PropertyType "Role" MalwareProtectionPlan
Value Text
newValue, Maybe [TagItemProperty]
Maybe CFNActionsProperty
()
CFNProtectedResourceProperty
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
tags :: Maybe [TagItemProperty]
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
tags :: Maybe [TagItemProperty]
..}
instance Property "Tags" MalwareProtectionPlan where
type PropertyType "Tags" MalwareProtectionPlan = [TagItemProperty]
set :: PropertyType "Tags" MalwareProtectionPlan
-> MalwareProtectionPlan -> MalwareProtectionPlan
set PropertyType "Tags" MalwareProtectionPlan
newValue MalwareProtectionPlan {Maybe [TagItemProperty]
Maybe CFNActionsProperty
()
Value Text
CFNProtectedResourceProperty
haddock_workaround_ :: MalwareProtectionPlan -> ()
actions :: MalwareProtectionPlan -> Maybe CFNActionsProperty
protectedResource :: MalwareProtectionPlan -> CFNProtectedResourceProperty
role :: MalwareProtectionPlan -> Value Text
tags :: MalwareProtectionPlan -> Maybe [TagItemProperty]
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
tags :: Maybe [TagItemProperty]
..}
= MalwareProtectionPlan {tags :: Maybe [TagItemProperty]
tags = [TagItemProperty] -> Maybe [TagItemProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [TagItemProperty]
PropertyType "Tags" MalwareProtectionPlan
newValue, Maybe CFNActionsProperty
()
Value Text
CFNProtectedResourceProperty
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
haddock_workaround_ :: ()
actions :: Maybe CFNActionsProperty
protectedResource :: CFNProtectedResourceProperty
role :: Value Text
..}