module Stratosphere.MSK.Cluster.VpcConnectivityClientAuthenticationProperty (
        module Exports, VpcConnectivityClientAuthenticationProperty(..),
        mkVpcConnectivityClientAuthenticationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.MSK.Cluster.VpcConnectivitySaslProperty as Exports
import {-# SOURCE #-} Stratosphere.MSK.Cluster.VpcConnectivityTlsProperty as Exports
import Stratosphere.ResourceProperties
data VpcConnectivityClientAuthenticationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-msk-cluster-vpcconnectivityclientauthentication.html>
    VpcConnectivityClientAuthenticationProperty {VpcConnectivityClientAuthenticationProperty -> ()
haddock_workaround_ :: (),
                                                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-msk-cluster-vpcconnectivityclientauthentication.html#cfn-msk-cluster-vpcconnectivityclientauthentication-sasl>
                                                 VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivitySaslProperty
sasl :: (Prelude.Maybe VpcConnectivitySaslProperty),
                                                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-msk-cluster-vpcconnectivityclientauthentication.html#cfn-msk-cluster-vpcconnectivityclientauthentication-tls>
                                                 VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivityTlsProperty
tls :: (Prelude.Maybe VpcConnectivityTlsProperty)}
  deriving stock (VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty -> Bool
(VpcConnectivityClientAuthenticationProperty
 -> VpcConnectivityClientAuthenticationProperty -> Bool)
-> (VpcConnectivityClientAuthenticationProperty
    -> VpcConnectivityClientAuthenticationProperty -> Bool)
-> Eq VpcConnectivityClientAuthenticationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty -> Bool
== :: VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty -> Bool
$c/= :: VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty -> Bool
/= :: VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty -> Bool
Prelude.Eq, Int -> VpcConnectivityClientAuthenticationProperty -> ShowS
[VpcConnectivityClientAuthenticationProperty] -> ShowS
VpcConnectivityClientAuthenticationProperty -> String
(Int -> VpcConnectivityClientAuthenticationProperty -> ShowS)
-> (VpcConnectivityClientAuthenticationProperty -> String)
-> ([VpcConnectivityClientAuthenticationProperty] -> ShowS)
-> Show VpcConnectivityClientAuthenticationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VpcConnectivityClientAuthenticationProperty -> ShowS
showsPrec :: Int -> VpcConnectivityClientAuthenticationProperty -> ShowS
$cshow :: VpcConnectivityClientAuthenticationProperty -> String
show :: VpcConnectivityClientAuthenticationProperty -> String
$cshowList :: [VpcConnectivityClientAuthenticationProperty] -> ShowS
showList :: [VpcConnectivityClientAuthenticationProperty] -> ShowS
Prelude.Show)
mkVpcConnectivityClientAuthenticationProperty ::
  VpcConnectivityClientAuthenticationProperty
mkVpcConnectivityClientAuthenticationProperty :: VpcConnectivityClientAuthenticationProperty
mkVpcConnectivityClientAuthenticationProperty
  = VpcConnectivityClientAuthenticationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), sasl :: Maybe VpcConnectivitySaslProperty
sasl = Maybe VpcConnectivitySaslProperty
forall a. Maybe a
Prelude.Nothing,
       tls :: Maybe VpcConnectivityTlsProperty
tls = Maybe VpcConnectivityTlsProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties VpcConnectivityClientAuthenticationProperty where
  toResourceProperties :: VpcConnectivityClientAuthenticationProperty -> ResourceProperties
toResourceProperties
    VpcConnectivityClientAuthenticationProperty {Maybe VpcConnectivitySaslProperty
Maybe VpcConnectivityTlsProperty
()
haddock_workaround_ :: VpcConnectivityClientAuthenticationProperty -> ()
sasl :: VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivitySaslProperty
tls :: VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivityTlsProperty
haddock_workaround_ :: ()
sasl :: Maybe VpcConnectivitySaslProperty
tls :: Maybe VpcConnectivityTlsProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::MSK::Cluster.VpcConnectivityClientAuthentication",
         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 -> VpcConnectivitySaslProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Sasl" (VpcConnectivitySaslProperty -> (Key, Value))
-> Maybe VpcConnectivitySaslProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe VpcConnectivitySaslProperty
sasl,
                            Key -> VpcConnectivityTlsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tls" (VpcConnectivityTlsProperty -> (Key, Value))
-> Maybe VpcConnectivityTlsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe VpcConnectivityTlsProperty
tls])}
instance JSON.ToJSON VpcConnectivityClientAuthenticationProperty where
  toJSON :: VpcConnectivityClientAuthenticationProperty -> Value
toJSON VpcConnectivityClientAuthenticationProperty {Maybe VpcConnectivitySaslProperty
Maybe VpcConnectivityTlsProperty
()
haddock_workaround_ :: VpcConnectivityClientAuthenticationProperty -> ()
sasl :: VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivitySaslProperty
tls :: VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivityTlsProperty
haddock_workaround_ :: ()
sasl :: Maybe VpcConnectivitySaslProperty
tls :: Maybe VpcConnectivityTlsProperty
..}
    = [(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 -> VpcConnectivitySaslProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Sasl" (VpcConnectivitySaslProperty -> (Key, Value))
-> Maybe VpcConnectivitySaslProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe VpcConnectivitySaslProperty
sasl,
               Key -> VpcConnectivityTlsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tls" (VpcConnectivityTlsProperty -> (Key, Value))
-> Maybe VpcConnectivityTlsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe VpcConnectivityTlsProperty
tls]))
instance Property "Sasl" VpcConnectivityClientAuthenticationProperty where
  type PropertyType "Sasl" VpcConnectivityClientAuthenticationProperty = VpcConnectivitySaslProperty
  set :: PropertyType "Sasl" VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty
set PropertyType "Sasl" VpcConnectivityClientAuthenticationProperty
newValue VpcConnectivityClientAuthenticationProperty {Maybe VpcConnectivitySaslProperty
Maybe VpcConnectivityTlsProperty
()
haddock_workaround_ :: VpcConnectivityClientAuthenticationProperty -> ()
sasl :: VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivitySaslProperty
tls :: VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivityTlsProperty
haddock_workaround_ :: ()
sasl :: Maybe VpcConnectivitySaslProperty
tls :: Maybe VpcConnectivityTlsProperty
..}
    = VpcConnectivityClientAuthenticationProperty
        {sasl :: Maybe VpcConnectivitySaslProperty
sasl = VpcConnectivitySaslProperty -> Maybe VpcConnectivitySaslProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Sasl" VpcConnectivityClientAuthenticationProperty
VpcConnectivitySaslProperty
newValue, Maybe VpcConnectivityTlsProperty
()
haddock_workaround_ :: ()
tls :: Maybe VpcConnectivityTlsProperty
haddock_workaround_ :: ()
tls :: Maybe VpcConnectivityTlsProperty
..}
instance Property "Tls" VpcConnectivityClientAuthenticationProperty where
  type PropertyType "Tls" VpcConnectivityClientAuthenticationProperty = VpcConnectivityTlsProperty
  set :: PropertyType "Tls" VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty
-> VpcConnectivityClientAuthenticationProperty
set PropertyType "Tls" VpcConnectivityClientAuthenticationProperty
newValue VpcConnectivityClientAuthenticationProperty {Maybe VpcConnectivitySaslProperty
Maybe VpcConnectivityTlsProperty
()
haddock_workaround_ :: VpcConnectivityClientAuthenticationProperty -> ()
sasl :: VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivitySaslProperty
tls :: VpcConnectivityClientAuthenticationProperty
-> Maybe VpcConnectivityTlsProperty
haddock_workaround_ :: ()
sasl :: Maybe VpcConnectivitySaslProperty
tls :: Maybe VpcConnectivityTlsProperty
..}
    = VpcConnectivityClientAuthenticationProperty
        {tls :: Maybe VpcConnectivityTlsProperty
tls = VpcConnectivityTlsProperty -> Maybe VpcConnectivityTlsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Tls" VpcConnectivityClientAuthenticationProperty
VpcConnectivityTlsProperty
newValue, Maybe VpcConnectivitySaslProperty
()
haddock_workaround_ :: ()
sasl :: Maybe VpcConnectivitySaslProperty
haddock_workaround_ :: ()
sasl :: Maybe VpcConnectivitySaslProperty
..}