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