module Stratosphere.Elasticsearch.Domain.AdvancedSecurityOptionsInputProperty (
        module Exports, AdvancedSecurityOptionsInputProperty(..),
        mkAdvancedSecurityOptionsInputProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Elasticsearch.Domain.MasterUserOptionsProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AdvancedSecurityOptionsInputProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-elasticsearch-domain-advancedsecurityoptionsinput.html>
    AdvancedSecurityOptionsInputProperty {AdvancedSecurityOptionsInputProperty -> ()
haddock_workaround_ :: (),
                                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-elasticsearch-domain-advancedsecurityoptionsinput.html#cfn-elasticsearch-domain-advancedsecurityoptionsinput-anonymousauthenabled>
                                          AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
anonymousAuthEnabled :: (Prelude.Maybe (Value Prelude.Bool)),
                                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-elasticsearch-domain-advancedsecurityoptionsinput.html#cfn-elasticsearch-domain-advancedsecurityoptionsinput-enabled>
                                          AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
enabled :: (Prelude.Maybe (Value Prelude.Bool)),
                                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-elasticsearch-domain-advancedsecurityoptionsinput.html#cfn-elasticsearch-domain-advancedsecurityoptionsinput-internaluserdatabaseenabled>
                                          AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
internalUserDatabaseEnabled :: (Prelude.Maybe (Value Prelude.Bool)),
                                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-elasticsearch-domain-advancedsecurityoptionsinput.html#cfn-elasticsearch-domain-advancedsecurityoptionsinput-masteruseroptions>
                                          AdvancedSecurityOptionsInputProperty
-> Maybe MasterUserOptionsProperty
masterUserOptions :: (Prelude.Maybe MasterUserOptionsProperty)}
  deriving stock (AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty -> Bool
(AdvancedSecurityOptionsInputProperty
 -> AdvancedSecurityOptionsInputProperty -> Bool)
-> (AdvancedSecurityOptionsInputProperty
    -> AdvancedSecurityOptionsInputProperty -> Bool)
-> Eq AdvancedSecurityOptionsInputProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty -> Bool
== :: AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty -> Bool
$c/= :: AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty -> Bool
/= :: AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty -> Bool
Prelude.Eq, Int -> AdvancedSecurityOptionsInputProperty -> ShowS
[AdvancedSecurityOptionsInputProperty] -> ShowS
AdvancedSecurityOptionsInputProperty -> String
(Int -> AdvancedSecurityOptionsInputProperty -> ShowS)
-> (AdvancedSecurityOptionsInputProperty -> String)
-> ([AdvancedSecurityOptionsInputProperty] -> ShowS)
-> Show AdvancedSecurityOptionsInputProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdvancedSecurityOptionsInputProperty -> ShowS
showsPrec :: Int -> AdvancedSecurityOptionsInputProperty -> ShowS
$cshow :: AdvancedSecurityOptionsInputProperty -> String
show :: AdvancedSecurityOptionsInputProperty -> String
$cshowList :: [AdvancedSecurityOptionsInputProperty] -> ShowS
showList :: [AdvancedSecurityOptionsInputProperty] -> ShowS
Prelude.Show)
mkAdvancedSecurityOptionsInputProperty ::
  AdvancedSecurityOptionsInputProperty
mkAdvancedSecurityOptionsInputProperty :: AdvancedSecurityOptionsInputProperty
mkAdvancedSecurityOptionsInputProperty
  = AdvancedSecurityOptionsInputProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), anonymousAuthEnabled :: Maybe (Value Bool)
anonymousAuthEnabled = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       enabled :: Maybe (Value Bool)
enabled = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       internalUserDatabaseEnabled :: Maybe (Value Bool)
internalUserDatabaseEnabled = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       masterUserOptions :: Maybe MasterUserOptionsProperty
masterUserOptions = Maybe MasterUserOptionsProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties AdvancedSecurityOptionsInputProperty where
  toResourceProperties :: AdvancedSecurityOptionsInputProperty -> ResourceProperties
toResourceProperties AdvancedSecurityOptionsInputProperty {Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: AdvancedSecurityOptionsInputProperty -> ()
anonymousAuthEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
enabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
internalUserDatabaseEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
masterUserOptions :: AdvancedSecurityOptionsInputProperty
-> Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Elasticsearch::Domain.AdvancedSecurityOptionsInput",
         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
"AnonymousAuthEnabled" (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)
anonymousAuthEnabled,
                            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
"Enabled" (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)
enabled,
                            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
"InternalUserDatabaseEnabled"
                              (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)
internalUserDatabaseEnabled,
                            Key -> MasterUserOptionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MasterUserOptions" (MasterUserOptionsProperty -> (Key, Value))
-> Maybe MasterUserOptionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MasterUserOptionsProperty
masterUserOptions])}
instance JSON.ToJSON AdvancedSecurityOptionsInputProperty where
  toJSON :: AdvancedSecurityOptionsInputProperty -> Value
toJSON AdvancedSecurityOptionsInputProperty {Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: AdvancedSecurityOptionsInputProperty -> ()
anonymousAuthEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
enabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
internalUserDatabaseEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
masterUserOptions :: AdvancedSecurityOptionsInputProperty
-> Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
    = [(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
"AnonymousAuthEnabled" (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)
anonymousAuthEnabled,
               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
"Enabled" (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)
enabled,
               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
"InternalUserDatabaseEnabled"
                 (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)
internalUserDatabaseEnabled,
               Key -> MasterUserOptionsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MasterUserOptions" (MasterUserOptionsProperty -> (Key, Value))
-> Maybe MasterUserOptionsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MasterUserOptionsProperty
masterUserOptions]))
instance Property "AnonymousAuthEnabled" AdvancedSecurityOptionsInputProperty where
  type PropertyType "AnonymousAuthEnabled" AdvancedSecurityOptionsInputProperty = Value Prelude.Bool
  set :: PropertyType
  "AnonymousAuthEnabled" AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty
set PropertyType
  "AnonymousAuthEnabled" AdvancedSecurityOptionsInputProperty
newValue AdvancedSecurityOptionsInputProperty {Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: AdvancedSecurityOptionsInputProperty -> ()
anonymousAuthEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
enabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
internalUserDatabaseEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
masterUserOptions :: AdvancedSecurityOptionsInputProperty
-> Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
    = AdvancedSecurityOptionsInputProperty
        {anonymousAuthEnabled :: Maybe (Value Bool)
anonymousAuthEnabled = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "AnonymousAuthEnabled" AdvancedSecurityOptionsInputProperty
Value Bool
newValue, Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: ()
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
instance Property "Enabled" AdvancedSecurityOptionsInputProperty where
  type PropertyType "Enabled" AdvancedSecurityOptionsInputProperty = Value Prelude.Bool
  set :: PropertyType "Enabled" AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty
set PropertyType "Enabled" AdvancedSecurityOptionsInputProperty
newValue AdvancedSecurityOptionsInputProperty {Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: AdvancedSecurityOptionsInputProperty -> ()
anonymousAuthEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
enabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
internalUserDatabaseEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
masterUserOptions :: AdvancedSecurityOptionsInputProperty
-> Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
    = AdvancedSecurityOptionsInputProperty
        {enabled :: Maybe (Value Bool)
enabled = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Enabled" AdvancedSecurityOptionsInputProperty
Value Bool
newValue, Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
instance Property "InternalUserDatabaseEnabled" AdvancedSecurityOptionsInputProperty where
  type PropertyType "InternalUserDatabaseEnabled" AdvancedSecurityOptionsInputProperty = Value Prelude.Bool
  set :: PropertyType
  "InternalUserDatabaseEnabled" AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty
set PropertyType
  "InternalUserDatabaseEnabled" AdvancedSecurityOptionsInputProperty
newValue AdvancedSecurityOptionsInputProperty {Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: AdvancedSecurityOptionsInputProperty -> ()
anonymousAuthEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
enabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
internalUserDatabaseEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
masterUserOptions :: AdvancedSecurityOptionsInputProperty
-> Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
    = AdvancedSecurityOptionsInputProperty
        {internalUserDatabaseEnabled :: Maybe (Value Bool)
internalUserDatabaseEnabled = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "InternalUserDatabaseEnabled" AdvancedSecurityOptionsInputProperty
Value Bool
newValue, Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
instance Property "MasterUserOptions" AdvancedSecurityOptionsInputProperty where
  type PropertyType "MasterUserOptions" AdvancedSecurityOptionsInputProperty = MasterUserOptionsProperty
  set :: PropertyType
  "MasterUserOptions" AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty
-> AdvancedSecurityOptionsInputProperty
set PropertyType
  "MasterUserOptions" AdvancedSecurityOptionsInputProperty
newValue AdvancedSecurityOptionsInputProperty {Maybe (Value Bool)
Maybe MasterUserOptionsProperty
()
haddock_workaround_ :: AdvancedSecurityOptionsInputProperty -> ()
anonymousAuthEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
enabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
internalUserDatabaseEnabled :: AdvancedSecurityOptionsInputProperty -> Maybe (Value Bool)
masterUserOptions :: AdvancedSecurityOptionsInputProperty
-> Maybe MasterUserOptionsProperty
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
masterUserOptions :: Maybe MasterUserOptionsProperty
..}
    = AdvancedSecurityOptionsInputProperty
        {masterUserOptions :: Maybe MasterUserOptionsProperty
masterUserOptions = MasterUserOptionsProperty -> Maybe MasterUserOptionsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "MasterUserOptions" AdvancedSecurityOptionsInputProperty
MasterUserOptionsProperty
newValue, Maybe (Value Bool)
()
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
haddock_workaround_ :: ()
anonymousAuthEnabled :: Maybe (Value Bool)
enabled :: Maybe (Value Bool)
internalUserDatabaseEnabled :: Maybe (Value Bool)
..}